From 749b64b7363236173b2a7c95b07766e5d0549390 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 5 Sep 2011 13:48:16 +0000 Subject: [PATCH] 2011-09-05 Robert Dewar * sem_ch3.adb: Minor reformatting. 2011-09-05 Ed Schonberg * sem_ch5.adb: Better error message. 2011-09-05 Hristian Kirtchev * exp_aggr.adb: Add with and use clause for Exp_Ch6. (Expand_Array_Aggregate): Detect a special case of an aggregate which contains tasks in the context of an unexpanded return statement of a build-in-place function. * exp_ch6.adb: Add with and use clause for Exp_Aggr. (Expand_N_Extended_Return_Statement): Detect a delayed aggregate which contains tasks and expand it now that the original simple return statement has been rewritten. * exp_ch9.adb (Build_Activation_Chain_Entity): Code reformatting. Do not create a chain for an extended return statement if one is already available. (Has_Activation_Chain): New routine. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178539 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 23 ++++++++ gcc/ada/exp_aggr.adb | 16 ++++++ gcc/ada/exp_ch6.adb | 10 ++++ gcc/ada/exp_ch9.adb | 145 ++++++++++++++++++++++++++++++++++----------------- gcc/ada/sem_ch3.adb | 5 +- gcc/ada/sem_ch5.adb | 10 ++-- 6 files changed, 156 insertions(+), 53 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e267e9b..056672d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2011-09-05 Robert Dewar + + * sem_ch3.adb: Minor reformatting. + +2011-09-05 Ed Schonberg + + * sem_ch5.adb: Better error message. + +2011-09-05 Hristian Kirtchev + + * exp_aggr.adb: Add with and use clause for Exp_Ch6. + (Expand_Array_Aggregate): Detect a special case of an aggregate + which contains tasks in the context of an unexpanded return + statement of a build-in-place function. + * exp_ch6.adb: Add with and use clause for Exp_Aggr. + (Expand_N_Extended_Return_Statement): Detect a delayed aggregate + which contains tasks and expand it now that the original simple + return statement has been rewritten. + * exp_ch9.adb (Build_Activation_Chain_Entity): Code + reformatting. Do not create a chain for an extended return + statement if one is already available. + (Has_Activation_Chain): New routine. + 2011-09-05 Marc Sango * sem_ch3.adb (Analyze_Object_Declaration): Remove diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 03b686c..31b0c61 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -32,6 +32,7 @@ with Errout; use Errout; with Expander; use Expander; with Exp_Util; use Exp_Util; with Exp_Ch3; use Exp_Ch3; +with Exp_Ch6; use Exp_Ch6; with Exp_Ch7; use Exp_Ch7; with Exp_Ch9; use Exp_Ch9; with Exp_Disp; use Exp_Disp; @@ -4604,6 +4605,21 @@ package body Exp_Aggr is or else Is_RTE (Ctyp, RE_Asm_Output_Operand) then return; + + -- Do not expand an aggregate for an array type which contains tasks if + -- the aggregate is associated with an unexpanded return statement of a + -- build-in-place function. The aggregate is expanded when the related + -- return statement (rewritten into an extended return) is processed. + -- This delay ensures that any temporaries and initialization code + -- generated for the aggregate appear in the proper return block and + -- use the correct _chain and _master. + + elsif Has_Task (Base_Type (Etype (N))) + and then Nkind (Parent (N)) = N_Simple_Return_Statement + and then Is_Build_In_Place_Function + (Return_Applies_To (Return_Statement_Entity (Parent (N)))) + then + return; end if; -- If the semantic analyzer has determined that aggregate N will raise diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index e8e46e1..82f1193 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -29,6 +29,7 @@ with Debug; use Debug; with Einfo; use Einfo; with Errout; use Errout; with Elists; use Elists; +with Exp_Aggr; use Exp_Aggr; with Exp_Atag; use Exp_Atag; with Exp_Ch2; use Exp_Ch2; with Exp_Ch3; use Exp_Ch3; @@ -4768,6 +4769,15 @@ package body Exp_Ch6 is if Is_Build_In_Place and then Has_Task (Etype (Par_Func)) then + -- The return expression is an aggregate for a complex type which + -- contains tasks. This particular case is left unexpanded since + -- the regular expansion would insert all temporaries and + -- initialization code in the wrong block. + + if Nkind (Exp) = N_Aggregate then + Expand_N_Aggregate (Exp); + end if; + Append_To (Stmts, Move_Activation_Chain); end if; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index ad7f6b1..542ae61 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -843,72 +843,121 @@ package body Exp_Ch9 is ----------------------------------- procedure Build_Activation_Chain_Entity (N : Node_Id) is - P : Node_Id; + function Has_Activation_Chain (Stmt : Node_Id) return Boolean; + -- Determine whether an extended return statement has an activation + -- chain. + + -------------------------- + -- Has_Activation_Chain -- + -------------------------- + + function Has_Activation_Chain (Stmt : Node_Id) return Boolean is + Decl : Node_Id; + + begin + Decl := First (Return_Object_Declarations (Stmt)); + while Present (Decl) loop + if Nkind (Decl) = N_Object_Declaration + and then Chars (Defining_Identifier (Decl)) = Name_uChain + then + return True; + end if; + + Next (Decl); + end loop; + + return False; + end Has_Activation_Chain; + + -- Local variables + Decls : List_Id; - Chain : Entity_Id; + Par : Node_Id; + + -- Start of processing for Build_Activation_Chain_Entity begin - -- Loop to find enclosing construct containing activation chain variable - -- The construct is a body, a block, or an extended return. - - P := Parent (N); - - while not Nkind_In (P, N_Subprogram_Body, - N_Entry_Body, - N_Package_Declaration, - N_Package_Body, - N_Block_Statement, - N_Task_Body, - N_Extended_Return_Statement) + -- Traverse the parent chain looking for an enclosing construct which + -- contains an activation chain variable. The construct is either a + -- body, a block, or an extended return. + + Par := Parent (N); + + while not Nkind_In (Par, N_Block_Statement, + N_Entry_Body, + N_Extended_Return_Statement, + N_Package_Body, + N_Package_Declaration, + N_Subprogram_Body, + N_Task_Body) loop - P := Parent (P); + Par := Parent (Par); end loop; - -- If we are in a package body, the activation chain variable is - -- declared in the body, but the Activation_Chain_Entity is attached - -- to the spec. + -- When the enclosing construct is a package body, the activation chain + -- variable is declared in the body, but the Activation_Chain_Entity is + -- attached to the spec. - if Nkind (P) = N_Package_Body then - Decls := Declarations (P); - P := Unit_Declaration_Node (Corresponding_Spec (P)); + if Nkind (Par) = N_Package_Body then + Decls := Declarations (Par); + Par := Unit_Declaration_Node (Corresponding_Spec (Par)); - elsif Nkind (P) = N_Package_Declaration then - Decls := Visible_Declarations (Specification (P)); + elsif Nkind (Par) = N_Package_Declaration then + Decls := Visible_Declarations (Specification (Par)); - elsif Nkind (P) = N_Extended_Return_Statement then - Decls := Return_Object_Declarations (P); + elsif Nkind (Par) = N_Extended_Return_Statement then + Decls := Return_Object_Declarations (Par); else - Decls := Declarations (P); + Decls := Declarations (Par); end if; - -- If activation chain entity not already declared, declare it + -- If an activation chain entity has not been declared already, create + -- one. - if Nkind (P) = N_Extended_Return_Statement - or else No (Activation_Chain_Entity (P)) + if Nkind (Par) = N_Extended_Return_Statement + or else No (Activation_Chain_Entity (Par)) then - Chain := Make_Defining_Identifier (Sloc (N), Name_uChain); - - -- Note: An extended return statement is not really a task activator, - -- but it does have an activation chain on which to store the tasks - -- temporarily. On successful return, the tasks on this chain are - -- moved to the chain passed in by the caller. We do not build an - -- Activation_Chain_Entity for an N_Extended_Return_Statement, - -- because we do not want to build a call to Activate_Tasks. Task - -- activation is the responsibility of the caller. - - if Nkind (P) /= N_Extended_Return_Statement then - Set_Activation_Chain_Entity (P, Chain); + -- Since extended return statements do not store the entity of the + -- chain, examine the return object declarations to avoid creating + -- a duplicate. + + if Nkind (Par) = N_Extended_Return_Statement + and then Has_Activation_Chain (Par) + then + return; end if; - Prepend_To (Decls, - Make_Object_Declaration (Sloc (P), - Defining_Identifier => Chain, - Aliased_Present => True, - Object_Definition => - New_Reference_To (RTE (RE_Activation_Chain), Sloc (P)))); + declare + Chain : Entity_Id; + Decl : Node_Id; - Analyze (First (Decls)); + begin + Chain := Make_Defining_Identifier (Sloc (N), Name_uChain); + + -- Note: An extended return statement is not really a task + -- activator, but it does have an activation chain on which to + -- store the tasks temporarily. On successful return, the tasks + -- on this chain are moved to the chain passed in by the caller. + -- We do not build an Activation_Chain_Entity for an extended + -- return statement, because we do not want to build a call to + -- Activate_Tasks. Task activation is the responsibility of the + -- caller. + + if Nkind (Par) /= N_Extended_Return_Statement then + Set_Activation_Chain_Entity (Par, Chain); + end if; + + Decl := + Make_Object_Declaration (Sloc (Par), + Defining_Identifier => Chain, + Aliased_Present => True, + Object_Definition => + New_Reference_To (RTE (RE_Activation_Chain), Sloc (Par))); + + Prepend_To (Decls, Decl); + Analyze (Decl); + end; end if; end Build_Activation_Chain_Entity; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 2953141..b5ee8fe 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3270,8 +3270,11 @@ package body Sem_Ch3 is -- In SPARK, a declaration of unconstrained type is allowed -- only for constants of type string. + -- Why do we need to test Original_Node here ??? + if Is_String_Type (T) - and then not Constant_Present (Original_Node (N)) then + and then not Constant_Present (Original_Node (N)) + then Check_SPARK_Restriction ("declaration of object of unconstrained type not allowed", N); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 81153fa..36b9e31 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2337,13 +2337,15 @@ package body Sem_Ch5 is if Of_Present (N) then Set_Etype (Def_Id, Component_Type (Typ)); - elsif Ada_Version < Ada_2012 then + else Error_Msg_N ("missing Range attribute in iteration over an array", N); - else - Error_Msg_N - ("to iterate over the elements of an array, use OF", N); + if Ada_Version >= Ada_2012 then + Error_Msg_NE + ("\if& is meant to designate an element of the array, use OF", + N, Def_Id); + end if; -- Prevent cascaded errors -- 2.7.4