AI05-0025 specifies that a formal package is illegal if it includes a named box
initialization for an overloaded formal subprogram. This is an extension of an
existing rule for instantiations.
Compiling proc1.adb in Ada2005 mode must yield the following:
proc1.adb:10:05: instantiation abandoned
proc1.adb:10:49: named association not allowed for overloaded formal
proc1.adb:15:09: instantiation abandoned
proc1.adb:16:35: named association not allowed for overloaded formal
proc1.adb:33:09: instantiation abandoned
proc1.adb:34:35: named association not allowed for overloaded formal
proc1.adb:40:09: instantiation abandoned
proc1.adb:41:35: named association not allowed for overloaded formal
---
procedure Proc1 is
generic
type T1 is private;
type T2 is private;
with function "=" (Left, Right : T1) return Boolean is <>;
with function "=" (Left, Right : T2) return Boolean is <>;
package GP1 is
end GP1;
package Inst1 is new GP1 (Integer, Integer, "=" => ">="); -- ERROR
generic
type T1 is private;
type T2 is private;
with package The_Pak1 is new GP1
(T1 => T1, T2 => T2, "=" => <>, "=" => <>); -- ERROR
package GP2 is end GP2;
package P is
type T0 is tagged null record;
function Func (X, Y : T0) return Boolean;
end;
use P;
package body P is
function Func (X, Y : T0) return Boolean is begin return False; end;
end P;
generic
type T1 is new T0 with private;
type T2 is new T0 with private;
with package The_Pak1 is new GP1
(T1 => T1, T2 => T2, "=" => Func, "=" => Func); -- ERROR
package GP3 is end GP3;
generic
type T1 is new T0 with private;
type T2 is new T0 with private;
with package The_Pak1 is new GP1
(T1 => T1, T2 => T2, others => <>); -- ERROR
package GP4 is end GP4;
generic
type T1 is new T0 with private;
type T2 is new T0 with private;
with package The_Pak1 is new GP1 ( T1, T2, Func, Func); -- OK
package GP5 is end GP5;
begin
null;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-04 Ed Schonberg <schonb...@adacore.com>
* sem_ch12.adb (Analyze_Associations): New routine
Check_Overloaded_Formal_Subprogram to reject a formal package when
there is a named association or a box initialisation for an overloaded
formal subprogram of the corresponding generic.
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb (revision 177361)
+++ sem_ch12.adb (working copy)
@@ -888,7 +888,6 @@
Actual : Node_Id;
Formal : Node_Id;
Next_Formal : Node_Id;
- Temp_Formal : Node_Id;
Analyzed_Formal : Node_Id;
Match : Node_Id;
Named : Node_Id;
@@ -910,9 +909,16 @@
Num_Actuals : Int := 0;
Others_Present : Boolean := False;
+ Others_Choice : Node_Id := Empty;
-- In Ada 2005, indicates partial parametrization of a formal
-- package. As usual an other association must be last in the list.
+ procedure Check_Overloaded_Formal_Subprogram (Formal : Entity_Id);
+ -- Apply RM 12.3 (9): if a formal subprogram is overloaded, the instance
+ -- cannot have a named association for it. AI05-0025 extends this rule
+ -- to formals of formal packages by AI05-0025, and it also applies to
+ -- box-initialized formals.
+
function Matching_Actual
(F : Entity_Id;
A_F : Entity_Id) return Node_Id;
@@ -946,6 +952,40 @@
-- anonymous types, the presence a formal equality will introduce an
-- implicit declaration for the corresponding inequality.
+ ----------------------------------------
+ -- Check_Overloaded_Formal_Subprogram --
+ ----------------------------------------
+
+ procedure Check_Overloaded_Formal_Subprogram (Formal : Entity_Id) is
+ Temp_Formal : Entity_Id;
+
+ begin
+ Temp_Formal := First (Formals);
+ while Present (Temp_Formal) loop
+ if Nkind (Temp_Formal) in N_Formal_Subprogram_Declaration
+ and then Temp_Formal /= Formal
+ and then
+ Chars (Defining_Unit_Name (Specification (Formal))) =
+ Chars (Defining_Unit_Name (Specification (Temp_Formal)))
+ then
+ if Present (Found_Assoc) then
+ Error_Msg_N
+ ("named association not allowed for overloaded formal",
+ Found_Assoc);
+
+ else
+ Error_Msg_N
+ ("named association not allowed for overloaded formal",
+ Others_Choice);
+ end if;
+
+ Abandon_Instantiation (Instantiation_Node);
+ end if;
+
+ Next (Temp_Formal);
+ end loop;
+ end Check_Overloaded_Formal_Subprogram;
+
---------------------
-- Matching_Actual --
---------------------
@@ -1131,6 +1171,7 @@
while Present (Actual) loop
if Nkind (Actual) = N_Others_Choice then
Others_Present := True;
+ Others_Choice := Actual;
if Present (Next (Actual)) then
Error_Msg_N ("others must be last association", Actual);
@@ -1293,24 +1334,7 @@
and then Is_Named_Assoc
and then Comes_From_Source (Found_Assoc)
then
- Temp_Formal := First (Formals);
- while Present (Temp_Formal) loop
- if Nkind (Temp_Formal) in
- N_Formal_Subprogram_Declaration
- and then Temp_Formal /= Formal
- and then
- Chars (Selector_Name (Found_Assoc)) =
- Chars (Defining_Unit_Name
- (Specification (Temp_Formal)))
- then
- Error_Msg_N
- ("name not allowed for overloaded formal",
- Found_Assoc);
- Abandon_Instantiation (Instantiation_Node);
- end if;
-
- Next (Temp_Formal);
- end loop;
+ Check_Overloaded_Formal_Subprogram (Formal);
end if;
-- If there is no corresponding actual, this may be case of
@@ -1321,6 +1345,10 @@
and then Partial_Parametrization
then
Process_Default (Formal);
+ if Nkind (I_Node) = N_Formal_Package_Declaration then
+ Check_Overloaded_Formal_Subprogram (Formal);
+ end if;
+
else
Append_To (Assoc,
Instantiate_Formal_Subprogram
