diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 41 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 86 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/par-ch6.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/projects.texi | 18 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 2 | ||||
| -rw-r--r-- | 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 <dismukes@adacore.com> + + * sem_res.adb: Minor reformatting. + +2011-10-14 Hristian Kirtchev <kirtchev@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <obry@adacore.com> + + * sem_util.adb, sem_ch4.adb: Minor reformatting. + +2011-10-14 Ed Schonberg <schonberg@adacore.com> + + * sem_ch13.adb: Recognize properly procedure calls that are + transformed into code statements. + +2011-10-14 Vincent Celier <celier@adacore.com> + + * projects.texi: Minor fix in project example. + 2011-10-14 Ed Schonberg <schonberg@adacore.com> * 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; |