From: Arnaud Charlet Date: Tue, 26 Oct 2010 13:05:30 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=0592046e2397a7206383190f84017e9bbe1dd7bc;p=gcc.git [multiple changes] 2010-10-26 Javier Miranda * sem_prag.adb (Process_Import_Or_Interface): Skip primitives of interface types when processing all the entities in the homonym chain that are declared in the same declarative part. 2010-10-26 Ed Schonberg * sem_ch3.adb (Process_Range_In_Decl): If the range is part of a quantified expression, the insertion point for range checks will be arbitrarily far in the tree. * sem_ch5.adb (One_Bound): Use Insert_Actions for the declaration of the temporary that holds the value of the bounds. * sem_res.adb (Resolve_Quantified_Expressions): Disable expansion of condition until the full expression is expanded. From-SVN: r165957 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 896a17ca14a..69ae440f1b6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2010-10-26 Javier Miranda + + * sem_prag.adb (Process_Import_Or_Interface): Skip primitives of + interface types when processing all the entities in the homonym chain + that are declared in the same declarative part. + +2010-10-26 Ed Schonberg + + * sem_ch3.adb (Process_Range_In_Decl): If the range is part of a + quantified expression, the insertion point for range checks will be + arbitrarily far in the tree. + * sem_ch5.adb (One_Bound): Use Insert_Actions for the declaration of + the temporary that holds the value of the bounds. + * sem_res.adb (Resolve_Quantified_Expressions): Disable expansion of + condition until the full expression is expanded. + 2010-10-26 Robert Dewar * opt.ads: Comment fix. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 3dde575c7aa..62aee52b674 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -17627,10 +17627,10 @@ package body Sem_Ch3 is Check_List : List_Id := Empty_List; R_Check_Off : Boolean := False) is - Lo, Hi : Node_Id; - R_Checks : Check_Result; - Type_Decl : Node_Id; - Def_Id : Entity_Id; + Lo, Hi : Node_Id; + R_Checks : Check_Result; + Insert_Node : Node_Id; + Def_Id : Entity_Id; begin Analyze_And_Resolve (R, Base_Type (T)); @@ -17738,32 +17738,43 @@ package body Sem_Ch3 is if not R_Check_Off then R_Checks := Get_Range_Checks (R, T); - -- Look up tree to find an appropriate insertion point. - -- This seems really junk code, and very brittle, couldn't - -- we just use an insert actions call of some kind ??? - - Type_Decl := Parent (R); - while Present (Type_Decl) and then not - (Nkind_In (Type_Decl, N_Full_Type_Declaration, - N_Subtype_Declaration, - N_Loop_Statement, - N_Task_Type_Declaration) - or else - Nkind_In (Type_Decl, N_Single_Task_Declaration, - N_Protected_Type_Declaration, - N_Single_Protected_Declaration)) - loop - Type_Decl := Parent (Type_Decl); + -- Look up tree to find an appropriate insertion point. We + -- can't just use insert_actions because later processing + -- depends on the insertion node. Prior to Ada2012 the + -- insertion point could only be a declaration or a loop, but + -- quantified expressions can appear within any context in an + -- expression, and the insertion point can be any statement, + -- pragma, or declaration. + + Insert_Node := Parent (R); + while Present (Insert_Node) loop + exit when + Nkind (Insert_Node) in N_Declaration + and then + not Nkind_In + (Insert_Node, N_Component_Declaration, + N_Loop_Parameter_Specification, + N_Function_Specification, + N_Procedure_Specification); + + exit when Nkind (Insert_Node) in N_Later_Decl_Item + or else Nkind (Insert_Node) in + N_Statement_Other_Than_Procedure_Call + or else Nkind_In (Insert_Node, N_Procedure_Call_Statement, + N_Pragma); + + Insert_Node := Parent (Insert_Node); end loop; -- Why would Type_Decl not be present??? Without this test, -- short regression tests fail. - if Present (Type_Decl) then + if Present (Insert_Node) then - -- Case of loop statement (more comments ???) + -- Case of loop statement. Verify that the range is part + -- of the subtype indication of the iteration scheme. - if Nkind (Type_Decl) = N_Loop_Statement then + if Nkind (Insert_Node) = N_Loop_Statement then declare Indic : Node_Id; @@ -17780,18 +17791,20 @@ package body Sem_Ch3 is Insert_Range_Checks (R_Checks, - Type_Decl, + Insert_Node, Def_Id, - Sloc (Type_Decl), + Sloc (Insert_Node), R, Do_Before => True); end if; end; - -- All other cases (more comments ???) + -- Insertion before a declaration. If the declaration + -- includes discriminants, the list of applicable checks + -- is given by the caller. - else - Def_Id := Defining_Identifier (Type_Decl); + elsif Nkind (Insert_Node) in N_Declaration then + Def_Id := Defining_Identifier (Insert_Node); if (Ekind (Def_Id) = E_Record_Type and then Depends_On_Discriminant (R)) @@ -17800,18 +17813,29 @@ package body Sem_Ch3 is and then Has_Discriminants (Def_Id)) then Append_Range_Checks - (R_Checks, Check_List, Def_Id, Sloc (Type_Decl), R); + (R_Checks, + Check_List, Def_Id, Sloc (Insert_Node), R); else Insert_Range_Checks - (R_Checks, Type_Decl, Def_Id, Sloc (Type_Decl), R); + (R_Checks, + Insert_Node, Def_Id, Sloc (Insert_Node), R); end if; + + -- Insertion before a statement. Range appears in the + -- context of a quantified expression. Insertion will + -- take place when expression is expanded. + + else + null; end if; end if; end if; end if; + -- Case of other than an explicit N_Range node + elsif Expander_Active then Get_Index_Bounds (R, Lo, Hi); Force_Evaluation (Lo); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 5edc3425a0e..68305d6e80c 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1538,8 +1538,11 @@ package body Sem_Ch5 is Object_Definition => New_Occurrence_Of (Typ, Loc), Expression => Relocate_Node (Original_Bound)); - Insert_Before (Parent (N), Decl); - Analyze (Decl); + -- Insert declaration at proper place. If loop comes from an + -- enclosing quantified expression, the insertion point is + -- arbitrarily far up in the tree. + + Insert_Action (Parent (N), Decl); Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc)); return Expression (Decl); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 5cf92e15daf..acc68474f35 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3928,6 +3928,14 @@ package body Sem_Prag is then null; + -- The pragma does not apply to primitives of interfaces + + elsif Is_Dispatching_Operation (Def_Id) + and then Present (Find_Dispatching_Type (Def_Id)) + and then Is_Interface (Find_Dispatching_Type (Def_Id)) + then + null; + -- Verify that the homonym is in the same declarative part (not -- just the same scope). @@ -4047,10 +4055,10 @@ package body Sem_Prag is and then C = Convention_CPP then -- Types treated as CPP classes are treated as limited, but we - -- don't require them to be declared this way. A warning is - -- issued to encourage the user to declare them as limited. - -- This is not an error, for compatibility reasons, because - -- these types have been supported this way for some time. + -- don't require them to be declared this way. A warning is issued + -- to encourage the user to declare them as limited. This is not + -- an error, for compatibility reasons, because these types have + -- been supported this way for some time. if not Is_Limited_Type (Def_Id) then Error_Msg_N diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index a90c45e5948..8dd8a525955 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7809,9 +7809,13 @@ package body Sem_Res is procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is begin -- The loop structure is already resolved during its analysis, only the - -- resolution of the condition needs to be done. + -- resolution of the condition needs to be done. Expansion is disabled + -- so that checks and other generated code are inserted in the tree + -- after expression has been rewritten as a loop. + Expander_Mode_Save_And_Set (False); Resolve (Condition (N), Typ); + Expander_Mode_Restore; end Resolve_Quantified_Expression; -------------------