From 59f2fcabdbc4b43ae62ecbac36a3a11552bdd75a Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 14 Oct 2011 15:03:39 +0000 Subject: [PATCH] 2011-10-14 Gary Dismukes * sem_res.adb: Minor reformatting. 2011-10-14 Hristian Kirtchev * exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): Code and comment reformatting. Use BIP_Task_Master when creating a _master. (BIP_Formal_Suffix): Code reformatting. Correct the case for BIP_Task_Master. (Make_Build_In_Place_Call_In_Object_Declaration): Use BIP_Task_Master when creating a reference to the enclosing function's _master formal. (Move_Activation_Chain): Use BIP_Task_Master when creating a reference to the _master. * exp_ch6.ads: Change BIP_Master to BIP_Task_Master. (Needs_BIP_Finalization_Master): Alphabetized. * sem_ch6.adb (Create_Extra_Formals): Update the usage of BIP_Task_Master. 2011-10-14 Ed Schonberg * par-ch6.adb (P_Return_Object_Declaration): In Ada 2012 mode, reject an aliased keyword on the object declaration of an extended return statement. In older versions of the language indicate that this is illegal in the standard. 2011-10-14 Pascal Obry * sem_util.adb, sem_ch4.adb: Minor reformatting. 2011-10-14 Ed Schonberg * sem_ch13.adb: Recognize properly procedure calls that are transformed into code statements. 2011-10-14 Vincent Celier * projects.texi: Minor fix in project example. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@179986 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 41 ++++++++++++++++++++++++ gcc/ada/exp_ch6.adb | 86 +++++++++++++++++++++++---------------------------- gcc/ada/exp_ch6.ads | 10 +++--- gcc/ada/par-ch6.adb | 8 +++++ gcc/ada/projects.texi | 18 +++++------ gcc/ada/sem_ch13.adb | 3 ++ gcc/ada/sem_ch4.adb | 12 +++---- gcc/ada/sem_ch6.adb | 2 +- gcc/ada/sem_res.adb | 2 +- gcc/ada/sem_util.adb | 6 ++-- 10 files changed, 116 insertions(+), 72 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2bba027..4c64e56 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,44 @@ +2011-10-14 Gary Dismukes + + * sem_res.adb: Minor reformatting. + +2011-10-14 Hristian Kirtchev + + * exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): + Code and comment reformatting. Use BIP_Task_Master + when creating a _master. + (BIP_Formal_Suffix): Code reformatting. Correct the case for + BIP_Task_Master. + (Make_Build_In_Place_Call_In_Object_Declaration): Use + BIP_Task_Master when creating a reference to the enclosing + function's _master formal. + (Move_Activation_Chain): Use BIP_Task_Master when creating a reference + to the _master. + * exp_ch6.ads: Change BIP_Master to BIP_Task_Master. + (Needs_BIP_Finalization_Master): Alphabetized. + * sem_ch6.adb (Create_Extra_Formals): Update the usage of + BIP_Task_Master. + +2011-10-14 Ed Schonberg + + * par-ch6.adb (P_Return_Object_Declaration): In Ada 2012 mode, + reject an aliased keyword on the object declaration of an extended + return statement. In older versions of the language indicate + that this is illegal in the standard. + +2011-10-14 Pascal Obry + + * sem_util.adb, sem_ch4.adb: Minor reformatting. + +2011-10-14 Ed Schonberg + + * sem_ch13.adb: Recognize properly procedure calls that are + transformed into code statements. + +2011-10-14 Vincent Celier + + * projects.texi: Minor fix in project example. + 2011-10-14 Ed Schonberg * sem_util.adb: Return objects are aliased if their type is diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 581b524..035c433 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -477,9 +477,13 @@ package body Exp_Ch6 is Function_Id : Entity_Id; Master_Actual : Node_Id) is - Loc : constant Source_Ptr := Sloc (Function_Call); - Result_Subt : constant Entity_Id := Available_View (Etype (Function_Id)); - Actual : Node_Id := Master_Actual; + Loc : constant Source_Ptr := Sloc (Function_Call); + Result_Subt : constant Entity_Id := + Available_View (Etype (Function_Id)); + Actual : Node_Id; + Chain_Actual : Node_Id; + Chain_Formal : Node_Id; + Master_Formal : Node_Id; begin -- No such extra parameters are needed if there are no tasks @@ -488,6 +492,8 @@ package body Exp_Ch6 is return; end if; + Actual := Master_Actual; + -- Use a dummy _master actual in case of No_Task_Hierarchy if Restriction_Active (No_Task_Hierarchy) then @@ -500,52 +506,34 @@ package body Exp_Ch6 is Actual := New_Reference_To (Actual, Loc); end if; - -- The master - - declare - Master_Formal : Node_Id; - - begin - -- Locate implicit master parameter in the called function - - Master_Formal := Build_In_Place_Formal (Function_Id, BIP_Master); - Analyze_And_Resolve (Actual, Etype (Master_Formal)); - - -- Build the parameter association for the new actual and add it to - -- the end of the function's actuals. + -- Locate the implicit master parameter in the called function - Add_Extra_Actual_To_Call (Function_Call, Master_Formal, Actual); - end; + Master_Formal := Build_In_Place_Formal (Function_Id, BIP_Task_Master); + Analyze_And_Resolve (Actual, Etype (Master_Formal)); - -- The activation chain + -- Build the parameter association for the new actual and add it to the + -- end of the function's actuals. - declare - Activation_Chain_Actual : Node_Id; - Activation_Chain_Formal : Node_Id; + Add_Extra_Actual_To_Call (Function_Call, Master_Formal, Actual); - begin - -- Locate implicit activation chain parameter in the called function + -- Locate the implicit activation chain parameter in the called function - Activation_Chain_Formal := - Build_In_Place_Formal (Function_Id, BIP_Activation_Chain); + Chain_Formal := + Build_In_Place_Formal (Function_Id, BIP_Activation_Chain); - -- Create the actual which is a pointer to the current activation - -- chain + -- Create the actual which is a pointer to the current activation chain - Activation_Chain_Actual := - Make_Attribute_Reference (Loc, - Prefix => Make_Identifier (Loc, Name_uChain), - Attribute_Name => Name_Unrestricted_Access); + Chain_Actual := + Make_Attribute_Reference (Loc, + Prefix => Make_Identifier (Loc, Name_uChain), + Attribute_Name => Name_Unrestricted_Access); - Analyze_And_Resolve - (Activation_Chain_Actual, Etype (Activation_Chain_Formal)); + Analyze_And_Resolve (Chain_Actual, Etype (Chain_Formal)); - -- Build the parameter association for the new actual and add it to - -- the end of the function's actuals. + -- Build the parameter association for the new actual and add it to the + -- end of the function's actuals. - Add_Extra_Actual_To_Call - (Function_Call, Activation_Chain_Formal, Activation_Chain_Actual); - end; + Add_Extra_Actual_To_Call (Function_Call, Chain_Formal, Chain_Actual); end Add_Task_Actuals_To_Build_In_Place_Call; ----------------------- @@ -557,12 +545,12 @@ package body Exp_Ch6 is case Kind is when BIP_Alloc_Form => return "BIPalloc"; - when BIP_Storage_Pool => + when BIP_Storage_Pool => return "BIPstoragepool"; when BIP_Finalization_Master => return "BIPfinalizationmaster"; - when BIP_Master => - return "BIPmaster"; + when BIP_Task_Master => + return "BIPtaskmaster"; when BIP_Activation_Chain => return "BIPactivationchain"; when BIP_Object_Access => @@ -578,6 +566,9 @@ package body Exp_Ch6 is (Func : Entity_Id; Kind : BIP_Formal_Kind) return Entity_Id is + Formal_Name : constant Name_Id := + New_External_Name + (Chars (Func), BIP_Formal_Suffix (Kind)); Extra_Formal : Entity_Id := Extra_Formals (Func); begin @@ -596,9 +587,8 @@ package body Exp_Ch6 is loop pragma Assert (Present (Extra_Formal)); - exit when - Chars (Extra_Formal) = - New_External_Name (Chars (Func), BIP_Formal_Suffix (Kind)); + exit when Chars (Extra_Formal) = Formal_Name; + Next_Formal_With_Extras (Extra_Formal); end loop; @@ -4831,7 +4821,7 @@ package body Exp_Ch6 is -- New master New_Reference_To - (Build_In_Place_Formal (Par_Func, BIP_Master), Loc))); + (Build_In_Place_Formal (Par_Func, BIP_Task_Master), Loc))); end Move_Activation_Chain; -- Start of processing for Expand_N_Extended_Return_Statement @@ -8248,8 +8238,8 @@ package body Exp_Ch6 is Add_Task_Actuals_To_Build_In_Place_Call (Func_Call, Function_Id, Master_Actual => - New_Reference_To - (Build_In_Place_Formal (Enclosing_Func, BIP_Master), Loc)); + New_Reference_To (Build_In_Place_Formal + (Enclosing_Func, BIP_Task_Master), Loc)); else Add_Task_Actuals_To_Build_In_Place_Call diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 8c27868..77df2b7 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -107,7 +107,7 @@ package Exp_Ch6 is -- Present if result type needs finalization. Pointer to caller's -- finalization master. - BIP_Master, + BIP_Task_Master, -- Present if result type contains tasks. Master associated with -- calling context. @@ -201,14 +201,14 @@ package Exp_Ch6 is -- for which Is_Build_In_Place_Call is True, or an N_Qualified_Expression -- node applied to such a function call. - function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean; - -- Ada 2005 (AI-318-02): Return True if the function needs an implicit - -- finalization master implicit parameter. - function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean; -- Ada 2005 (AI-318-02): Return True if the function needs an implicit -- BIP_Alloc_Form parameter (see type BIP_Formal_Kind). + function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean; + -- Ada 2005 (AI-318-02): Return True if the result subtype of function + -- Func_Id needs finalization actions. + function Needs_Result_Accessibility_Level (Func_Id : Entity_Id) return Boolean; -- Ada 2012 (AI05-0234): Return True if the function needs an implicit diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index cb0575b..7d59854 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -1677,6 +1677,14 @@ package body Ch6 is Scan; -- past ALIASED Set_Aliased_Present (Decl_Node); + if Ada_Version < Ada_2012 then + Error_Msg_SC -- CODEFIX + ("ALIASED not allowed in extended return in Ada2012?"); + else + Error_Msg_SC -- CODEFIX + ("ALIASED not allowed in extended return"); + end if; + if Token = Tok_Constant then Scan; -- past CONSTANT Set_Constant_Present (Decl_Node); diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index d63923c..356104f 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -580,19 +580,19 @@ packages would be involved in the build process. @b{for} Object_Dir @b{use} "obj"; @b{for} Exec_Dir @b{use} "."; @b{for} Main @b{use} ("proc.adb"); - @b{end} Build; - @b{package} Builder @b{is} --<<< for gnatmake and gprbuild - @b{end} Builder; + @b{package} Builder @b{is} --<<< for gnatmake and gprbuild + @b{end} Builder; - @b{package} Compiler @b{is} --<<< for the compiler - @b{end} Compiler; + @b{package} Compiler @b{is} --<<< for the compiler + @b{end} Compiler; - @b{package} Binder @b{is} --<<< for the binder - @b{end} Binder; + @b{package} Binder @b{is} --<<< for the binder + @b{end} Binder; - @b{package} Linker @b{is} --<<< for the linker - @b{end} Linker; + @b{package} Linker @b{is} --<<< for the linker + @b{end} Linker; + @b{end} Build; @end smallexample @noindent diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 3a5a9fd..5790b9a 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3372,8 +3372,11 @@ package body Sem_Ch13 is while Present (Stmt) loop StmtO := Original_Node (Stmt); + -- A procedure call transformed into a code statement is OK. + if Ada_Version >= Ada_2012 and then Nkind (StmtO) = N_Procedure_Call_Statement + and then Nkind (Name (StmtO)) = N_Qualified_Expression then null; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ed949cb..ba60024 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3155,9 +3155,9 @@ package body Sem_Ch4 is -- Unary operator case else - if Op_Name = Name_Op_Subtract or else - Op_Name = Name_Op_Add or else - Op_Name = Name_Op_Abs + if Op_Name = Name_Op_Subtract + or else Op_Name = Name_Op_Add + or else Op_Name = Name_Op_Abs then Find_Unary_Types (Act1, Op_Id, N); @@ -6434,7 +6434,7 @@ package body Sem_Ch4 is begin - -- Check whether type has a specified indexing aspect. + -- Check whether type has a specified indexing aspect Func_Name := Empty; Is_Var := False; @@ -6443,7 +6443,7 @@ package body Sem_Ch4 is while Present (Ritem) loop if Nkind (Ritem) = N_Aspect_Specification then - -- Prefer Variable_Indexing, but will settle for Constant. + -- Prefer Variable_Indexing, but will settle for Constant if Get_Aspect_Id (Chars (Identifier (Ritem))) = Aspect_Constant_Indexing @@ -6529,7 +6529,7 @@ package body Sem_Ch4 is if Success then Set_Etype (Name (N), It.Typ); - -- Add implicit dereference interpretation. + -- Add implicit dereference interpretation Disc := First_Discriminant (Etype (It.Nam)); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 8675a2b..4ebf967 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6516,7 +6516,7 @@ package body Sem_Ch6 is Discard := Add_Extra_Formal (E, RTE (RE_Master_Id), - E, BIP_Formal_Suffix (BIP_Master)); + E, BIP_Formal_Suffix (BIP_Task_Master)); Discard := Add_Extra_Formal (E, RTE (RE_Activation_Chain_Access), diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index d71bde6..d94a6bf 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7368,7 +7368,7 @@ package body Sem_Res is -- evaluation of the corresponding "and then" or "or else". If we left -- the replacement to expansion time, then run-time checks associated -- with such operands would be evaluated unconditionally, due to being - -- before to the condition prior to the rewriting as short-circuit forms + -- before the condition prior to the rewriting as short-circuit forms -- during expansion. if Short_Circuit_And_Or diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1375225..ec0b135 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3025,7 +3025,8 @@ package body Sem_Util is function Effective_Extra_Accessibility (Id : Entity_Id) return Entity_Id is begin if Present (Renamed_Object (Id)) - and then Is_Entity_Name (Renamed_Object (Id)) then + and then Is_Entity_Name (Renamed_Object (Id)) + then return Effective_Extra_Accessibility (Entity (Renamed_Object (Id))); end if; @@ -3922,7 +3923,8 @@ package body Sem_Util is -- Check for components elsif - Nkind_In (Expr, N_Selected_Component, N_Indexed_Component) then + Nkind_In (Expr, N_Selected_Component, N_Indexed_Component) + then Expr := Prefix (Expr); Off := True; -- 2.7.4