From 1bb6e262cf96060be3098d2089c1fe059e73dedd Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 1 Sep 2011 15:16:58 +0200 Subject: [PATCH] [multiple changes] 2011-09-01 Gary Dismukes * exp_ch6.ads (Needs_BIP_Alloc_Form): New utility function. * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): Test for case where call initializes an object of a return statement before testing for a constrained call, to ensure that all such cases get handled by simply passing on the caller's parameters. Also, in that case call Needs_BIP_Alloc_Form to determine whether to pass on the BIP_Alloc_Form parameter of the enclosing function rather than testing Is_Constrained. Add similar tests for the return of a BIP call to later processing to ensure consistent handling. (Needs_BIP_Alloc_Form): New utility function. * sem_ch6.adb: (Create_Extra_Formals): Replace test for adding a BIP_Alloc_Form formal with call to new utility function Needs_BIP_Alloc_Form. 2011-09-01 Pascal Obry * prj-part.adb: Minor reformatting. 2011-09-01 Vincent Celier * prj-env.adb (Create_Mapping_File.Process): Encode the upper half character in the unit name. From-SVN: r178411 --- gcc/ada/ChangeLog | 26 ++++++++++ gcc/ada/exp_ch6.adb | 120 +++++++++++++++++++++++++------------------ gcc/ada/exp_ch6.ads | 8 ++- gcc/ada/prj-env.adb | 19 ++++++- gcc/ada/prj-part.adb | 4 +- gcc/ada/sem_ch6.adb | 4 +- 6 files changed, 123 insertions(+), 58 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 957a04a2b73..83cf332fde5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,29 @@ +2011-09-01 Gary Dismukes + + * exp_ch6.ads (Needs_BIP_Alloc_Form): New utility function. + * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): + Test for case where call + initializes an object of a return statement before testing for + a constrained call, to ensure that all such cases get handled + by simply passing on the caller's parameters. Also, in that + case call Needs_BIP_Alloc_Form to determine whether to pass on + the BIP_Alloc_Form parameter of the enclosing function rather + than testing Is_Constrained. Add similar tests for the return + of a BIP call to later processing to ensure consistent handling. + (Needs_BIP_Alloc_Form): New utility function. + * sem_ch6.adb: (Create_Extra_Formals): Replace test for adding + a BIP_Alloc_Form formal with call to new utility function + Needs_BIP_Alloc_Form. + +2011-09-01 Pascal Obry + + * prj-part.adb: Minor reformatting. + +2011-09-01 Vincent Celier + + * prj-env.adb (Create_Mapping_File.Process): Encode the upper + half character in the unit name. + 2011-09-01 Hristian Kirtchev * exp_ch4.adb: Minor code and comment reformatting. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 90fb73e1b79..eb74c122847 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4198,7 +4198,6 @@ package body Exp_Ch6 is Constant_Present => True, Object_Definition => New_Occurrence_Of (Temp_Typ, Loc), Expression => New_A); - else Decl := Make_Object_Renaming_Declaration (Loc, @@ -7579,54 +7578,26 @@ package body Exp_Ch6 is Result_Subt := Etype (Function_Id); - -- In the constrained case, add an implicit actual to the function call - -- that provides access to the declared object. An unchecked conversion - -- to the (specific) result type of the function is inserted to handle - -- the case where the object is declared with a class-wide type. - - if Is_Constrained (Underlying_Type (Result_Subt)) then - Caller_Object := - Make_Unchecked_Type_Conversion (Loc, - Subtype_Mark => New_Reference_To (Result_Subt, Loc), - Expression => New_Reference_To (Obj_Def_Id, Loc)); - - -- When the function has a controlling result, an allocation-form - -- parameter must be passed indicating that the caller is allocating - -- the result object. This is needed because such a function can be - -- called as a dispatching operation and must be treated similarly - -- to functions with unconstrained result subtypes. - - Add_Alloc_Form_Actual_To_Build_In_Place_Call - (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); - - -- If the function's result subtype is unconstrained and the object is - -- a return object of an enclosing build-in-place function, then the - -- implicit build-in-place parameters of the enclosing function must be - -- passed along to the called function. (Unfortunately, this won't cover - -- the case of extension aggregates where the ancestor part is a build- - -- in-place unconstrained function call that should be passed along the - -- caller's parameters. Currently those get mishandled by reassigning - -- the result of the call to the aggregate return object, when the call - -- result should really be directly built in place in the aggregate and - -- not built in a temporary. ???) - - elsif Is_Return_Object (Defining_Identifier (Object_Decl)) then + -- If the the object is a return object of an enclosing build-in-place + -- function, then the implicit build-in-place parameters of the + -- enclosing function are simply passed along to the called function. + -- (Unfortunately, this won't cover the case of extension aggregates + -- where the ancestor part is a build-in-place unconstrained function + -- call that should be passed along the caller's parameters. Currently + -- those get mishandled by reassigning the result of the call to the + -- aggregate return object, when the call result should really be + -- directly built in place in the aggregate and not in a temporary. ???) + + if Is_Return_Object (Defining_Identifier (Object_Decl)) then Pass_Caller_Acc := True; Enclosing_Func := Enclosing_Subprogram (Obj_Def_Id); - -- If the enclosing function has a constrained result type, then - -- caller allocation will be used. - - if Is_Constrained (Etype (Enclosing_Func)) then - Add_Alloc_Form_Actual_To_Build_In_Place_Call - (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); - - -- Otherwise, when the enclosing function has an unconstrained result - -- type, the BIP_Alloc_Form formal of the enclosing function must be - -- passed along to the callee. + -- When the enclosing function has a BIP_Alloc_Form formal then we + -- pass it along to the callee (such as when the enclosing function + -- has an unconstrained or tagged result type). - else + if Needs_BIP_Alloc_Form (Enclosing_Func) then Add_Alloc_Form_Actual_To_Build_In_Place_Call (Func_Call, Function_Id, @@ -7634,6 +7605,13 @@ package body Exp_Ch6 is New_Reference_To (Build_In_Place_Formal (Enclosing_Func, BIP_Alloc_Form), Loc)); + + -- Otherwise, if enclosing function has a constrained result subtype, + -- then caller allocation will be used. + + else + Add_Alloc_Form_Actual_To_Build_In_Place_Call + (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); end if; -- Retrieve the BIPacc formal from the enclosing function and convert @@ -7651,6 +7629,26 @@ package body Exp_Ch6 is (Build_In_Place_Formal (Enclosing_Func, BIP_Object_Access), Loc)); + -- In the constrained case, add an implicit actual to the function call + -- that provides access to the declared object. An unchecked conversion + -- to the (specific) result type of the function is inserted to handle + -- the case where the object is declared with a class-wide type. + + elsif Is_Constrained (Underlying_Type (Result_Subt)) then + Caller_Object := + Make_Unchecked_Type_Conversion (Loc, + Subtype_Mark => New_Reference_To (Result_Subt, Loc), + Expression => New_Reference_To (Obj_Def_Id, Loc)); + + -- When the function has a controlling result, an allocation-form + -- parameter must be passed indicating that the caller is allocating + -- the result object. This is needed because such a function can be + -- called as a dispatching operation and must be treated similarly + -- to functions with unconstrained result subtypes. + + Add_Alloc_Form_Actual_To_Build_In_Place_Call + (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); + -- In other unconstrained cases, pass an indication to do the allocation -- on the secondary stack and set Caller_Object to Empty so that a null -- value will be passed for the caller's object address. A transient @@ -7710,11 +7708,14 @@ package body Exp_Ch6 is -- The access type and its accompanying object must be inserted after -- the object declaration in the constrained case, so that the function -- call can be passed access to the object. In the unconstrained case, - -- the access type and object must be inserted before the object, since - -- the object declaration is rewritten to be a renaming of a dereference - -- of the access object. + -- or if the object declaration is for a return object, the access type + -- and object must be inserted before the object, since the object + -- declaration is rewritten to be a renaming of a dereference of the + -- access object. - if Is_Constrained (Underlying_Type (Result_Subt)) then + if Is_Constrained (Underlying_Type (Result_Subt)) + and then not Is_Return_Object (Defining_Identifier (Object_Decl)) + then Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl); else Insert_Action (Object_Decl, Ptr_Typ_Decl); @@ -7734,11 +7735,18 @@ package body Exp_Ch6 is Object_Definition => New_Reference_To (Ref_Type, Loc), Expression => New_Expr)); - if Is_Constrained (Underlying_Type (Result_Subt)) then + -- If the result subtype of the called function is constrained and + -- is not itself the return expression of an enclosing BIP function, + -- then mark the object as having no initialization. + + if Is_Constrained (Underlying_Type (Result_Subt)) + and then not Is_Return_Object (Defining_Identifier (Object_Decl)) + then Set_Expression (Object_Decl, Empty); Set_No_Initialization (Object_Decl); - -- In case of an unconstrained result subtype, rewrite the object + -- In case of an unconstrained result subtype, or if the call is the + -- return expression of an enclosing BIP function, rewrite the object -- declaration as an object renaming where the renamed object is a -- dereference of 'reference: -- @@ -7830,4 +7838,16 @@ package body Exp_Ch6 is and then Needs_Finalization (Func_Typ); end Needs_BIP_Finalization_Master; + -------------------------- + -- Needs_BIP_Alloc_Form -- + -------------------------- + + function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean is + pragma Assert (Is_Build_In_Place_Function (Func_Id)); + Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id)); + + begin + return not Is_Constrained (Func_Typ) or else Is_Tagged_Type (Func_Typ); + end Needs_BIP_Alloc_Form; + end Exp_Ch6; diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 95a10ec9ded..29dc27322d9 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -198,7 +198,11 @@ package Exp_Ch6 is -- 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 a finalization - -- master implicit parameter. + -- 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). end Exp_Ch6; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 0c80f7f7b94..68965ab3156 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -836,7 +836,24 @@ package body Prj.Env is or else Source.Unit /= No_Unit_Index) then if Source.Unit /= No_Unit_Index then - Get_Name_String (Source.Unit.Name); + -- Put the encoded unit name in the name buffer + + declare + Uname : constant String := + Get_Name_String (Source.Unit.Name); + + begin + Name_Len := 0; + + for J in Uname'Range loop + if Uname (J) in Upper_Half_Character then + Store_Encoded_Character (Get_Char_Code (Uname (J))); + + else + Add_Char_To_Name_Buffer (Uname (J)); + end if; + end loop; + end; if Source.Language.Config.Kind = Unit_Based then diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 8985e9711a3..3b07a804648 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -1037,8 +1037,8 @@ package body Prj.Part is Proj_Qualifier := Aggregate; Scan (In_Tree); - if Token = Tok_Identifier and then - Token_Name = Snames.Name_Library + if Token = Tok_Identifier + and then Token_Name = Snames.Name_Library then Proj_Qualifier := Aggregate_Library; Scan (In_Tree); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index d3dfedd43f0..7b4bf913ab6 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6120,9 +6120,7 @@ package body Sem_Ch6 is -- dispatching context and such calls must be handled like calls -- to a class-wide function. - if not Is_Constrained (Underlying_Type (Result_Subt)) - or else Is_Tagged_Type (Underlying_Type (Result_Subt)) - then + if Needs_BIP_Alloc_Form (E) then Discard := Add_Extra_Formal (E, Standard_Natural, -- 2.30.2