diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1acadb7e970..71be8748ea8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,50 @@ +2011-08-02 Robert Dewar + + * exp_ch4.adb: Minor reformatting. + +2011-08-02 Ed Schonberg + + * 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 + + * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ignore + size/alignment related attributes in CodePeer_Mode. + +2011-08-02 Gary Dismukes + + * 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 * errout.adb (First_Node): minor renaming diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 09d9e75f596..85e9d572ba4 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 a1af56f5aec..7d2e64c64e4 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 0571ab24eb8..458505211fe 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 7dd2e89c799..177987c2310 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 186664673f2..34278978c43 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 caf2a73d04b..46d63dc7ab4 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 55c1d329fc5..b1e99dc79c5 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;