diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 41 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/exp_prag.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 214 | ||||
| -rw-r--r-- | gcc/ada/exp_util.ads | 16 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 20 |
12 files changed, 269 insertions, 145 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index decde4a..06fe6a2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,44 @@ +2013-01-04 Thomas Quinot <quinot@adacore.com> + + * sinfo.ads: Minor documentation update. + +2013-01-04 Thomas Quinot <quinot@adacore.com> + + * sem_ch3.adb, einfo.adb (Analyze_Object_Declaration): Do not set Ekind + before resolving initialization expression. + +2013-01-04 Hristian Kirtchev <kirtchev@adacore.com> + + * checks.adb (Generate_Index_Checks): Delay the generation of + the check for an indexed component where the prefix mentions + Loop_Entry until the attribute has been properly expanded. + * exp_ch5.adb (Expand_Loop_Entry_Attributes): Perform minor + decoration of the constant that captures the value of Loop_Entry's + prefix at the entry point into a loop. Generate index checks + for an attribute reference that has been transformed into an + indexed component. + +2013-01-04 Thomas Quinot <quinot@adacore.com> + + * exp_prag.adb, exp_util.adb, exp_util.ads, freeze.adb, exp_aggr.adb, + sem_ch13.adb (Exp_Aggr.Collect_Initialization_Statements): Nothing to + do if Obj is already frozen. + (Exp_Util.Find_Init_Call): Rename to... + (Exp_Util.Remove_Init_Call): New subprogram, renamed from + Find_Init_Call. Remove the initialization call from the enclosing + list if found, and if it is from an Initialization_Statements + attribute, reset it. + (Exp_Util.Append_Freeze_Action): Minor code reorganization. + (Exp_Util.Append_Freeze_Actions): Ensure a freeze node has been + allocated (as is already done in Append_Freeze_Action). + (Freeze.Freeze_Entity): For an object with captured + Initialization_Statements and non-delayed freezeing, unwrap the + initialization statements and insert and them directly in the + enclosing list. + (Sem_Ch13.Check_Address_Clause): For an object + with Initialization_Statements and an address clause, unwrap the + initialization statements when moving them to the freeze actions. + 2013-01-03 Pascal Obry <obry@adacore.com> * prj-attr.adb, projects.texi, snames.ads-tmpl: Add package remote and diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 337546a..0c3f589 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -5522,6 +5522,23 @@ package body Checks is or else Index_Checks_Suppressed (Etype (A)) then return; + + -- The indexed component we are dealing with contains 'Loop_Entry in its + -- prefix. This case arises when analysis has determined that constructs + -- such as + + -- Prefix'Loop_Entry (Expr) + -- Prefix'Loop_Entry (Expr1, Expr2, ... ExprN) + + -- require rewriting for error detection purposes. A side effect of this + -- action is the generation of index checks that mention 'Loop_Entry. + -- Delay the generation of the check until 'Loop_Entry has been properly + -- expanded. This is done in Expand_Loop_Entry_Attributes. + + elsif Nkind (Prefix (N)) = N_Attribute_Reference + and then Attribute_Name (Prefix (N)) = Name_Loop_Entry + then + return; end if; -- Generate a raise of constraint error with the appropriate reason and diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index a0d07c2..5902256 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -4263,7 +4263,11 @@ package body Einfo is procedure Set_Initialization_Statements (Id : E; V : N) is begin - pragma Assert (Ekind_In (Id, E_Constant, E_Variable)); + -- Tolerate an E_Void entity since this can be called while resolving + -- an aggregate used as the initialization expression for an object + -- declaration, and this occurs before the Ekind for the object is set. + + pragma Assert (Ekind_In (Id, E_Void, E_Constant, E_Variable)); Set_Node28 (Id, V); end Set_Initialization_Statements; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index efadf4b..0b5e13f 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -106,9 +106,10 @@ package body Exp_Aggr is (Obj : Entity_Id; N : Node_Id; Node_After : Node_Id); - -- Collect actions inserted after N until, but not including, Node_After, - -- for initialization of Obj, and move them to an expression with actions, - -- which becomes the Initialization_Statements for Obj. + -- If Obj is not frozen, collect actions inserted after N until, but not + -- including, Node_After, for initialization of Obj, and move them to an + -- expression with actions, which becomes the Initialization_Statements for + -- Obj. ------------------------------------------------------ -- Local subprograms for Record Aggregate Expansion -- @@ -2965,6 +2966,13 @@ package body Exp_Aggr is EA : Node_Id; Init_Actions : constant List_Id := New_List; begin + -- Nothing to do if Obj is already frozen, as in this case we known we + -- won't need to move the initialization statements about later on. + + if Is_Frozen (Obj) then + return; + end if; + Init_Node := N; while Next (Init_Node) /= Node_After loop diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 74acb34..66aeb68 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1828,11 +1828,29 @@ package body Exp_Ch5 is Object_Definition => New_Reference_To (Typ, Loc), Expression => Relocate_Node (Prefix (LE)))); + -- Perform minor decoration as this information will be needed for + -- the creation of index checks (if applicable). + + Set_Ekind (Temp, E_Constant); + Set_Etype (Temp, Typ); + -- Replace the original attribute with a reference to the constant Rewrite (LE, New_Reference_To (Temp, Loc)); Set_Etype (LE, Typ); + -- Analysis converts attribute references of the following form + + -- Prefix'Loop_Entry (Expr) + -- Prefix'Loop_Entry (Expr1, Expr2, ... ExprN) + + -- into indexed components for error detection purposes. Generate + -- index checks now that 'Loop_Entry has been properly expanded. + + if Nkind (Parent (LE)) = N_Indexed_Component then + Generate_Index_Checks (Parent (LE)); + end if; + Next_Elmt (LE_Elmt); end loop; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 537fa01..f2b1c85 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -549,12 +549,9 @@ package body Exp_Prag is Def_Id := Entity (Arg2 (N)); if Ekind (Def_Id) = E_Variable then - -- Find generated initialization call for object, if any + -- Find and remove generated initialization call for object, if any - Init_Call := Find_Init_Call (Def_Id, Rep_Clause => N); - if Present (Init_Call) then - Remove (Init_Call); - end if; + Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N); -- Any default initialization expression should be removed -- (e.g., null defaults for access objects, zero initialization diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 2ee0113..50a2ba1 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -366,10 +366,11 @@ package body Exp_Util is Fnode := Freeze_Node (T); if No (Actions (Fnode)) then - Set_Actions (Fnode, New_List); + Set_Actions (Fnode, New_List (N)); + else + Append (N, Actions (Fnode)); end if; - Append (N, Actions (Fnode)); end Append_Freeze_Action; --------------------------- @@ -377,18 +378,20 @@ package body Exp_Util is --------------------------- procedure Append_Freeze_Actions (T : Entity_Id; L : List_Id) is - Fnode : constant Node_Id := Freeze_Node (T); + Fnode : Node_Id; begin if No (L) then return; + end if; + + Ensure_Freeze_Node (T); + Fnode := Freeze_Node (T); + if No (Actions (Fnode)) then + Set_Actions (Fnode, L); else - if No (Actions (Fnode)) then - Set_Actions (Fnode, L); - else - Append_List (L, Actions (Fnode)); - end if; + Append_List (L, Actions (Fnode)); end if; end Append_Freeze_Actions; @@ -2160,101 +2163,6 @@ package body Exp_Util is end if; end Expand_Subtype_From_Expr; - -------------------- - -- Find_Init_Call -- - -------------------- - - function Find_Init_Call - (Var : Entity_Id; - Rep_Clause : Node_Id) return Node_Id - is - Par : constant Node_Id := Parent (Var); - Typ : constant Entity_Id := Etype (Var); - - Init_Proc : Entity_Id; - -- Initialization procedure for Typ - - function Find_Init_Call_In_List (From : Node_Id) return Node_Id; - -- Look for init call for Var starting at From and scanning the - -- enclosing list until Rep_Clause or the end of the list is reached. - - ---------------------------- - -- Find_Init_Call_In_List -- - ---------------------------- - - function Find_Init_Call_In_List (From : Node_Id) return Node_Id is - Init_Call : Node_Id; - begin - Init_Call := From; - - while Present (Init_Call) and then Init_Call /= Rep_Clause loop - if Nkind (Init_Call) = N_Procedure_Call_Statement - and then Is_Entity_Name (Name (Init_Call)) - and then Entity (Name (Init_Call)) = Init_Proc - then - return Init_Call; - end if; - - Next (Init_Call); - end loop; - - return Empty; - end Find_Init_Call_In_List; - - Init_Call : Node_Id; - - -- Start of processing for Find_Init_Call - - begin - if Present (Initialization_Statements (Var)) then - return Initialization_Statements (Var); - - elsif not Has_Non_Null_Base_Init_Proc (Typ) then - - -- No init proc for the type, so obviously no call to be found - - return Empty; - end if; - - -- We might be able to handle other cases below by just properly setting - -- Initialization_Statements at the point where the init proc call is - -- generated??? - - Init_Proc := Base_Init_Proc (Typ); - - -- First scan the list containing the declaration of Var - - Init_Call := Find_Init_Call_In_List (From => Next (Par)); - - -- If not found, also look on Var's freeze actions list, if any, since - -- the init call may have been moved there (case of an address clause - -- applying to Var). - - if No (Init_Call) and then Present (Freeze_Node (Var)) then - Init_Call := - Find_Init_Call_In_List (First (Actions (Freeze_Node (Var)))); - end if; - - -- If the initialization call has actuals that use the secondary stack, - -- the call may have been wrapped into a temporary block, in which case - -- the block itself has to be removed. - - if No (Init_Call) and then Nkind (Next (Par)) = N_Block_Statement then - declare - Blk : constant Node_Id := Next (Par); - begin - if Present - (Find_Init_Call_In_List - (First (Statements (Handled_Statement_Sequence (Blk))))) - then - Init_Call := Blk; - end if; - end; - end if; - - return Init_Call; - end Find_Init_Call; - ------------------------ -- Find_Interface_ADT -- ------------------------ @@ -6295,6 +6203,106 @@ package body Exp_Util is end case; end Process_Statements_For_Controlled_Objects; + ---------------------- + -- Remove_Init_Call -- + ---------------------- + + function Remove_Init_Call + (Var : Entity_Id; + Rep_Clause : Node_Id) return Node_Id + is + Par : constant Node_Id := Parent (Var); + Typ : constant Entity_Id := Etype (Var); + + Init_Proc : Entity_Id; + -- Initialization procedure for Typ + + function Find_Init_Call_In_List (From : Node_Id) return Node_Id; + -- Look for init call for Var starting at From and scanning the + -- enclosing list until Rep_Clause or the end of the list is reached. + + ---------------------------- + -- Find_Init_Call_In_List -- + ---------------------------- + + function Find_Init_Call_In_List (From : Node_Id) return Node_Id is + Init_Call : Node_Id; + begin + Init_Call := From; + + while Present (Init_Call) and then Init_Call /= Rep_Clause loop + if Nkind (Init_Call) = N_Procedure_Call_Statement + and then Is_Entity_Name (Name (Init_Call)) + and then Entity (Name (Init_Call)) = Init_Proc + then + return Init_Call; + end if; + + Next (Init_Call); + end loop; + + return Empty; + end Find_Init_Call_In_List; + + Init_Call : Node_Id; + + -- Start of processing for Find_Init_Call + + begin + if Present (Initialization_Statements (Var)) then + Init_Call := Initialization_Statements (Var); + Set_Initialization_Statements (Var, Empty); + + elsif not Has_Non_Null_Base_Init_Proc (Typ) then + + -- No init proc for the type, so obviously no call to be found + + return Empty; + + else + -- We might be able to handle other cases below by just properly + -- setting Initialization_Statements at the point where the init proc + -- call is generated??? + + Init_Proc := Base_Init_Proc (Typ); + + -- First scan the list containing the declaration of Var + + Init_Call := Find_Init_Call_In_List (From => Next (Par)); + + -- If not found, also look on Var's freeze actions list, if any, + -- since the init call may have been moved there (case of an address + -- clause applying to Var). + + if No (Init_Call) and then Present (Freeze_Node (Var)) then + Init_Call := + Find_Init_Call_In_List (First (Actions (Freeze_Node (Var)))); + end if; + + -- If the initialization call has actuals that use the secondary + -- stack, the call may have been wrapped into a temporary block, in + -- which case the block itself has to be removed. + + if No (Init_Call) and then Nkind (Next (Par)) = N_Block_Statement then + declare + Blk : constant Node_Id := Next (Par); + begin + if Present + (Find_Init_Call_In_List + (First (Statements (Handled_Statement_Sequence (Blk))))) + then + Init_Call := Blk; + end if; + end; + end if; + end if; + + if Present (Init_Call) then + Remove (Init_Call); + end if; + return Init_Call; + end Remove_Init_Call; + ------------------------- -- Remove_Side_Effects -- ------------------------- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index f89a0ac..d87a5a4 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -379,14 +379,6 @@ package Exp_Util is -- declarations and/or allocations when the type is indefinite (including -- class-wide). - function Find_Init_Call - (Var : Entity_Id; - Rep_Clause : Node_Id) return Node_Id; - -- Look for init_proc call for variable Var, either among declarations - -- between that of Var and a subsequent Rep_Clause applying to Var, or - -- in the list of freeze actions associated with Var, and if found, return - -- that call node. - function Find_Interface_ADT (T : Entity_Id; Iface : Entity_Id) return Elmt_Id; @@ -723,6 +715,14 @@ package Exp_Util is -- statements looking for declarations of controlled objects. If at least -- one such object is found, wrap the statement list in a block. + function Remove_Init_Call + (Var : Entity_Id; + Rep_Clause : Node_Id) return Node_Id; + -- Look for init_proc call or aggregate initialization statements for + -- variable Var, either among declarations between that of Var and a + -- subsequent Rep_Clause applying to Var, or in the list of freeze actions + -- associated with Var, and if found, remove and return that call node. + procedure Remove_Side_Effects (Exp : Node_Id; Name_Req : Boolean := False; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index fdf8ac4..bf71111 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3344,6 +3344,31 @@ package body Freeze is then Layout_Object (E); end if; + + -- If initialization statements were captured in an expression + -- with actions with null expression, and the object does not + -- have delayed freezing, move them back now directly within the + -- enclosing statement sequence. + + if Ekind_In (E, E_Constant, E_Variable) + and then not Has_Delayed_Freeze (E) + then + declare + Init_Stmts : constant Node_Id := + Initialization_Statements (E); + begin + if Present (Init_Stmts) + and then Nkind (Init_Stmts) = N_Expression_With_Actions + and then Nkind (Expression (Init_Stmts)) + = N_Null_Statement + then + Insert_List_Before (Init_Stmts, Actions (Init_Stmts)); + Remove (Init_Stmts); + Set_Initialization_Statements (E, Empty); + end if; + end; + end if; + end if; -- Case of a type or subtype being frozen diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 0a2ac51..e02b7a0 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2903,11 +2903,25 @@ package body Sem_Ch13 is -- before its definition. declare - Init_Call : constant Node_Id := Find_Init_Call (U_Ent, N); + Init_Call : constant Node_Id := + Remove_Init_Call (U_Ent, N); begin if Present (Init_Call) then - Remove (Init_Call); - Append_Freeze_Action (U_Ent, Init_Call); + + -- If the init call is an expression with actions with + -- null expression, just extract the actions. + + if Nkind (Init_Call) = N_Expression_With_Actions + and then Nkind (Expression (Init_Call)) + = N_Null_Statement + then + Append_Freeze_Actions (U_Ent, Actions (Init_Call)); + + -- General case: move Init_Call to freeze actions + + else + Append_Freeze_Action (U_Ent, Init_Call); + end if; end if; end; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 49020fa..ac0e0cc 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3171,14 +3171,9 @@ package body Sem_Ch3 is Set_Has_Completion (Id); end if; - -- Set kind (expansion of E may need it) and type now, and resolve. - -- Type might be overridden later on. - - if Constant_Present (N) then - Set_Ekind (Id, E_Constant); - else - Set_Ekind (Id, E_Variable); - end if; + -- Set type and resolve (type may be overridden later on). Note: + -- Ekind (Id) must still be E_Void at this point so that incorrect + -- early usage within E is properly diagnosed. Set_Etype (Id, T); Resolve (E, T); @@ -3520,12 +3515,11 @@ package body Sem_Ch3 is Set_Never_Set_In_Source (Id, True); - -- Now establish the proper kind (if not already set) and type of the - -- object. + -- Now establish the proper kind and type of the object if Constant_Present (N) then + Set_Ekind (Id, E_Constant); Set_Is_True_Constant (Id, True); - Set_Ekind (Id, E_Constant); else Set_Ekind (Id, E_Variable); diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index d3e7d71..08b09d2 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -7020,15 +7020,10 @@ package Sinfo is -- a subexpression, whose value is the value of the Expression after -- executing all the actions. - -- Note: if the actions contain declarations, then these declarations - -- may be referenced within the expression. It is thus appropriate for - -- the back-end to create a scope that encompasses the construct (any - -- declarations within the actions will definitely not be referenced - -- once elaboration of the construct is completed). - - -- But we rely on freeze nodes appearing in actions being elaborated in - -- the enclosing scope (see Exp_Aggr.Collect_Initialization_ - -- Statements)??? + -- If the actions contain declarations, then these declarations may + -- be referenced within the expression. However note that there is + -- no proper scope associated with the expression-with-action, so the + -- back-end will elaborate them in the context of the enclosing scope. -- Sprint syntax: do -- action; @@ -7046,7 +7041,10 @@ package Sinfo is -- never have created this node if there weren't some actions. -- Note: Expression may be a Null_Statement, in which case the - -- N_Expression_With_Actions has type Standard_Void_Type. + -- N_Expression_With_Actions has type Standard_Void_Type. However some + -- backends do not support such expression-with-actions occurring + -- outside of a proper (non-void) expression, so this should just be + -- used as an intermediate representation within the front-end. -------------------- -- Free Statement -- @@ -7183,7 +7181,7 @@ package Sinfo is -- the exception to be raised (i.e. it is equivalent to a raise -- statement that raises the corresponding exception). This use -- is distinguished by the fact that the Etype in this case is - -- Standard_Void_Type, In the subexpression case, the Etype is the + -- Standard_Void_Type; in the subexpression case, the Etype is the -- same as the type of the subexpression which it replaces. -- If Condition is empty, then the raise is unconditional. If the |