diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1acadb7e970807f99690c4eabbaccfbf17e8eb83..71be8748ea8a00d934e11cfa1b2a212b13d1738a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,50 @@
+2011-08-02 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch4.adb: Minor reformatting.
+
+2011-08-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch5.adb (Analyze_Loop_Statement): If the iteration scheme is an
+ Ada2012 iterator, the loop will be rewritten during expansion into a
+ while loop with a cursor and an element declaration. Do not analyze the
+ body in this case, because if the container is for indefinite types the
+ actual subtype of the elements will only be determined when the cursor
+ declaration is analyzed.
+
+2011-08-02 Arnaud Charlet <charlet@adacore.com>
+
+ * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ignore
+ size/alignment related attributes in CodePeer_Mode.
+
+2011-08-02 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch3.adb (Check_Ops_From_Incomplete_Type): Remove call to
+ Prepend_Element, since this can result in the operation getting the
+ wrong slot in the full type's dispatch table if the full type has
+ inherited operations. The incomplete type's operation will get added
+ to the proper position in the full type's primitives
+ list later in Sem_Disp.Check_Operation_From_Incomplete_Type.
+ (Process_Incomplete_Dependents): Add Is_Primitive test when checking for
+ dispatching operations, since there are cases where nonprimitive
+ subprograms can get added to the list of incomplete dependents (such
+ as subprograms in nested packages).
+ * sem_ch6.adb (Process_Formals): First, remove test for being in a
+ private part when determining whether to add a primitive with a
+ parameter of a tagged incomplete type to the Private_Dependents list.
+ Such primitives can also occur in the visible part, and should not have
+ been excluded from being private dependents.
+ * sem_ch7.adb (Uninstall_Declarations): When checking the rule of
+ RM05-3.10.1(9.3/2), test that a subprogram in the Private_Dependents
+ list of a Taft-amendment incomplete type is a primitive before issuing
+ an error that the full type must appear in the same unit. There are
+ cases where nonprimitives can be in the list (such as subprograms in
+ nested packages).
+ * sem_disp.adb (Derives_From): Use correct condition for checking that
+ a formal's type is derived from the type of the corresponding formal in
+ the parent subprogram (the condition was completely wrong). Add
+ checking that was missing for controlling result types being derived
+ from the result type of the parent operation.
+
2011-08-02 Yannick Moy <moy@adacore.com>
* errout.adb (First_Node): minor renaming
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 09d9e75f59682dfc9028de36dcc7f2dea8b38328..85e9d572ba49438b317cc28b5c93fdaeb356d10f 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -6923,10 +6923,9 @@ package body Exp_Ch4 is
Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
end if;
- -- For navigation purposes, the inequality is treated as an
+ -- For navigation purposes, we want to treat the inequality as an
-- implicit reference to the corresponding equality. Preserve the
- -- Comes_From_ source flag so that the proper Xref entry is
- -- generated.
+ -- Comes_From_ source flag to generate proper Xref entries.
Preserve_Comes_From_Source (Neg, N);
Preserve_Comes_From_Source (Right_Opnd (Neg), N);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index a1af56f5aec2dedfcecab1b0967c9825de9836a8..7d2e64c64e49530c9a9285095bc3cb183f97adaa 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1567,9 +1567,10 @@ package body Sem_Ch13 is
Set_Analyzed (N, True);
end if;
- -- Process Ignore_Rep_Clauses option
+ -- Process Ignore_Rep_Clauses option (we also ignore rep clauses in
+ -- CodePeer mode, since they are not relevant in that context).
- if Ignore_Rep_Clauses then
+ if Ignore_Rep_Clauses or CodePeer_Mode then
case Id is
-- The following should be ignored. They do not affect legality
@@ -1584,26 +1585,36 @@ package body Sem_Ch13 is
Attribute_Machine_Radix |
Attribute_Object_Size |
Attribute_Size |
- Attribute_Small |
Attribute_Stream_Size |
Attribute_Value_Size =>
-
Rewrite (N, Make_Null_Statement (Sloc (N)));
return;
+ -- We do not want too ignore 'Small in CodePeer_Mode, since it
+ -- has an impact on the exact computations performed.
+
+ -- Perhaps 'Small should also not be ignored by
+ -- Ignore_Rep_Clauses ???
+
+ when Attribute_Small =>
+ if Ignore_Rep_Clauses then
+ Rewrite (N, Make_Null_Statement (Sloc (N)));
+ return;
+ end if;
+
-- The following should not be ignored, because in the first place
-- they are reasonably portable, and should not cause problems in
-- compiling code from another target, and also they do affect
-- legality, e.g. failing to provide a stream attribute for a
-- type may make a program illegal.
- when Attribute_External_Tag |
- Attribute_Input |
- Attribute_Output |
- Attribute_Read |
- Attribute_Storage_Pool |
- Attribute_Storage_Size |
- Attribute_Write =>
+ when Attribute_External_Tag |
+ Attribute_Input |
+ Attribute_Output |
+ Attribute_Read |
+ Attribute_Storage_Pool |
+ Attribute_Storage_Size |
+ Attribute_Write =>
null;
-- Other cases are errors ("attribute& cannot be set with
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 0571ab24eb84866dd1ff9b2e4db1cf62ab3554ed..458505211fe9b307c7627d2e670645ebfac3dd1f 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2190,9 +2190,12 @@ package body Sem_Ch3 is
or else In_Package_Body (Current_Scope));
procedure Check_Ops_From_Incomplete_Type;
- -- If there is a tagged incomplete partial view of the type, transfer
- -- its operations to the full view, and indicate that the type of the
- -- controlling parameter (s) is this full view.
+ -- If there is a tagged incomplete partial view of the type, traverse
+ -- the primitives of the incomplete view and change the type of any
+ -- controlling formals and result to indicate the full view. The
+ -- primitives will be added to the full type's primitive operations
+ -- list later in Sem_Disp.Check_Operation_From_Incomplete_Type (which
+ -- is called from Process_Incomplete_Dependents).
------------------------------------
-- Check_Ops_From_Incomplete_Type --
@@ -2212,7 +2215,6 @@ package body Sem_Ch3 is
Elmt := First_Elmt (Primitive_Operations (Prev));
while Present (Elmt) loop
Op := Node (Elmt);
- Prepend_Elmt (Op, Primitive_Operations (T));
Formal := First_Formal (Op);
while Present (Formal) loop
@@ -17844,17 +17846,17 @@ package body Sem_Ch3 is
elsif Is_Overloadable (Priv_Dep) then
- -- A protected operation is never dispatching: only its
- -- wrapper operation (which has convention Ada) is.
+ -- If a subprogram in the incomplete dependents list is primitive
+ -- for a tagged full type then mark it as a dispatching operation,
+ -- check whether it overrides an inherited subprogram, and check
+ -- restrictions on its controlling formals. Note that a protected
+ -- operation is never dispatching: only its wrapper operation
+ -- (which has convention Ada) is.
if Is_Tagged_Type (Full_T)
+ and then Is_Primitive (Priv_Dep)
and then Convention (Priv_Dep) /= Convention_Protected
then
-
- -- Subprogram has an access parameter whose designated type
- -- was incomplete. Reexamine declaration now, because it may
- -- be a primitive operation of the full type.
-
Check_Operation_From_Incomplete_Type (Priv_Dep, Inc_T);
Set_Is_Dispatching_Operation (Priv_Dep);
Check_Controlling_Formals (Full_T, Priv_Dep);
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 7dd2e89c799c995c441d1e6094da0212d5e1f2a1..177987c2310d205bf307aea5b113096f897661ba 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2387,7 +2387,33 @@ package body Sem_Ch5 is
Kill_Current_Values;
Push_Scope (Ent);
Analyze_Iteration_Scheme (Iter);
- Analyze_Statements (Statements (Loop_Statement));
+
+ -- Analyze the statements of the body except in the case of an Ada 2012
+ -- iterator with the expander active. In this case the expander will do
+ -- a rewrite of the loop into a while loop. We will then analyze the
+ -- loop body when we analyze this while loop.
+
+ -- We need to do this delay because if the container is for indefinite
+ -- types the actual subtype of the components will only be determined
+ -- when the cursor declaration is analyzed.
+
+ -- If the expander is not active, then we want to analyze the loop body
+ -- now even in the Ada 2012 iterator case, since the rewriting will not
+ -- be done.
+
+ if No (Iter)
+ or else No (Iterator_Specification (Iter))
+ or else not Expander_Active
+ then
+ Analyze_Statements (Statements (Loop_Statement));
+ end if;
+
+ -- Finish up processing for the loop. We kill all current values, since
+ -- in general we don't know if the statements in the loop have been
+ -- executed. We could do a bit better than this with a loop that we
+ -- know will execute at least once, but it's not worth the trouble and
+ -- the front end is not in the business of flow tracing.
+
Process_End_Label (Loop_Statement, 'e', Ent);
End_Scope;
Kill_Current_Values;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 186664673f295a97fcfa49c47b4ec889276f9c1c..34278978c4335483d5b21bda01c5963855657818 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8655,7 +8655,6 @@ package body Sem_Ch6 is
if Is_Tagged_Type (Formal_Type) then
if Ekind (Scope (Current_Scope)) = E_Package
- and then In_Private_Part (Scope (Current_Scope))
and then not From_With_Type (Formal_Type)
and then not Is_Class_Wide_Type (Formal_Type)
then
@@ -8666,6 +8665,14 @@ package body Sem_Ch6 is
Append_Elmt
(Current_Scope,
Private_Dependents (Base_Type (Formal_Type)));
+
+ -- Freezing is delayed to ensure that Register_Prim
+ -- will get called for this operation, which is needed
+ -- in cases where static dispatch tables aren't built.
+ -- (Note that the same is done for controlling access
+ -- parameter cases in function Access_Definition.)
+
+ Set_Has_Delayed_Freeze (Current_Scope);
end if;
end if;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index caf2a73d04b21dc4137014065e4c595a2dabdfce..46d63dc7ab44dedace04c7ce8e2c3168a3d6412c 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -2463,7 +2463,11 @@ package body Sem_Ch7 is
while Present (Elmt) loop
Subp := Node (Elmt);
- if Is_Overloadable (Subp) then
+ -- Is_Primitive is tested because there can be cases where
+ -- nonprimitive subprograms (in nested packages) are added
+ -- to the Private_Dependents list.
+
+ if Is_Overloadable (Subp) and then Is_Primitive (Subp) then
Error_Msg_NE
("type& must be completed in the private part",
Parent (Subp), Id);
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 55c1d329fc5a1875df00a9b9eb98da948f65f6fe..b1e99dc79c5ac4f248bd2d7c69a0e8989186fce6 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -1362,23 +1362,28 @@ package body Sem_Disp is
Op1, Op2 : Elmt_Id;
Prev : Elmt_Id := No_Elmt;
- function Derives_From (Proc : Entity_Id) return Boolean;
- -- Check that Subp has the signature of an operation derived from Proc.
- -- Subp has an access parameter that designates Typ.
+ function Derives_From (Parent_Subp : Entity_Id) return Boolean;
+ -- Check that Subp has profile of an operation derived from Parent_Subp.
+ -- Subp must have a parameter or result type that is Typ or an access
+ -- parameter or access result type that designates Typ.
------------------
-- Derives_From --
------------------
- function Derives_From (Proc : Entity_Id) return Boolean is
+ function Derives_From (Parent_Subp : Entity_Id) return Boolean is
F1, F2 : Entity_Id;
begin
- if Chars (Proc) /= Chars (Subp) then
+ if Chars (Parent_Subp) /= Chars (Subp) then
return False;
end if;
- F1 := First_Formal (Proc);
+ -- Check that the type of controlling formals is derived from the
+ -- parent subprogram's controlling formal type (or designated type
+ -- if the formal type is an anonymous access type).
+
+ F1 := First_Formal (Parent_Subp);
F2 := First_Formal (Subp);
while Present (F1) and then Present (F2) loop
if Ekind (Etype (F1)) = E_Anonymous_Access_Type then
@@ -1393,7 +1398,7 @@ package body Sem_Disp is
elsif Ekind (Etype (F2)) = E_Anonymous_Access_Type then
return False;
- elsif Etype (F1) /= Etype (F2) then
+ elsif Etype (F1) = Parent_Typ and then Etype (F2) /= Full then
return False;
end if;
@@ -1401,6 +1406,37 @@ package body Sem_Disp is
Next_Formal (F2);
end loop;
+ -- Check that a controlling result type is derived from the parent
+ -- subprogram's result type (or designated type if the result type
+ -- is an anonymous access type).
+
+ if Ekind (Parent_Subp) = E_Function then
+ if Ekind (Subp) /= E_Function then
+ return False;
+
+ elsif Ekind (Etype (Parent_Subp)) = E_Anonymous_Access_Type then
+ if Ekind (Etype (Subp)) /= E_Anonymous_Access_Type then
+ return False;
+
+ elsif Designated_Type (Etype (Parent_Subp)) = Parent_Typ
+ and then Designated_Type (Etype (Subp)) /= Full
+ then
+ return False;
+ end if;
+
+ elsif Ekind (Etype (Subp)) = E_Anonymous_Access_Type then
+ return False;
+
+ elsif Etype (Parent_Subp) = Parent_Typ
+ and then Etype (Subp) /= Full
+ then
+ return False;
+ end if;
+
+ elsif Ekind (Subp) = E_Function then
+ return False;
+ end if;
+
return No (F1) and then No (F2);
end Derives_From;