Commit 1bb6e262 by Arnaud Charlet

[multiple changes]

2011-09-01  Gary Dismukes  <dismukes@adacore.com>

	* 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  <obry@adacore.com>

	* prj-part.adb: Minor reformatting.

2011-09-01  Vincent Celier  <celier@adacore.com>

	* prj-env.adb (Create_Mapping_File.Process): Encode the upper
	half character in the unit name.

From-SVN: r178411
parent db15225a
2011-09-01 Gary Dismukes <dismukes@adacore.com>
* 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 <obry@adacore.com>
* prj-part.adb: Minor reformatting.
2011-09-01 Vincent Celier <celier@adacore.com>
* prj-env.adb (Create_Mapping_File.Process): Encode the upper
half character in the unit name.
2011-09-01 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb: Minor code and comment reformatting.
......
......@@ -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 <function_Call>'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;
......@@ -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;
......@@ -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
......
......@@ -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);
......
......@@ -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,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment