From 4637729f3ee4f001e5c4fec92fe26d13b91d9f97 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 Aug 2011 15:51:43 +0200 Subject: [PATCH] [multiple changes] 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. From-SVN: r177156 --- gcc/ada/ChangeLog | 47 +++++++++++++++++++++++++++++++++++++++++ gcc/ada/exp_ch4.adb | 5 ++--- gcc/ada/sem_ch13.adb | 33 +++++++++++++++++++---------- gcc/ada/sem_ch3.adb | 24 +++++++++++---------- gcc/ada/sem_ch5.adb | 28 ++++++++++++++++++++++++- gcc/ada/sem_ch6.adb | 9 +++++++- gcc/ada/sem_ch7.adb | 6 +++++- gcc/ada/sem_disp.adb | 50 +++++++++++++++++++++++++++++++++++++------- 8 files changed, 167 insertions(+), 35 deletions(-) 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; -- 2.30.2