procedure Expand_N_Extended_Return_Statement (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
- Par_Func : constant Entity_Id :=
- Return_Applies_To (Return_Statement_Entity (N));
- Result_Subt : constant Entity_Id := Etype (Par_Func);
- Ret_Obj_Id : constant Entity_Id :=
- First_Entity (Return_Statement_Entity (N));
- Ret_Obj_Decl : constant Node_Id := Parent (Ret_Obj_Id);
-
- Is_Build_In_Place : constant Boolean :=
- Is_Build_In_Place_Function (Par_Func);
-
- Exp : Node_Id;
- HSS : Node_Id;
- Result : Node_Id;
- Return_Stmt : Node_Id;
- Stmts : List_Id;
-
function Build_Heap_Allocator
(Temp_Id : Entity_Id;
Temp_Typ : Entity_Id;
-- temporary. Func_Id is the enclosing function. Ret_Typ is the return
-- type of Func_Id. Alloc_Expr is the actual allocator.
- function Move_Activation_Chain return Node_Id;
+ function Move_Activation_Chain (Func_Id : Entity_Id) return Node_Id;
-- Construct a call to System.Tasking.Stages.Move_Activation_Chain
-- with parameters:
-- From current activation chain
-- To activation chain passed in by the caller
-- New_Master master passed in by the caller
+ --
+ -- Func_Id is the entity of the function where the extended return
+ -- statement appears.
--------------------------
-- Build_Heap_Allocator --
-- Move_Activation_Chain --
---------------------------
- function Move_Activation_Chain return Node_Id is
+ function Move_Activation_Chain (Func_Id : Entity_Id) return Node_Id is
begin
return
Make_Procedure_Call_Statement (Loc,
-- Destination chain
New_Occurrence_Of
- (Build_In_Place_Formal (Par_Func, BIP_Activation_Chain), Loc),
+ (Build_In_Place_Formal (Func_Id, BIP_Activation_Chain), Loc),
-- New master
New_Occurrence_Of
- (Build_In_Place_Formal (Par_Func, BIP_Task_Master), Loc)));
+ (Build_In_Place_Formal (Func_Id, BIP_Task_Master), Loc)));
end Move_Activation_Chain;
+ -- Local variables
+
+ Func_Id : constant Entity_Id :=
+ Return_Applies_To (Return_Statement_Entity (N));
+ Is_BIP_Func : constant Boolean :=
+ Is_Build_In_Place_Function (Func_Id);
+ Ret_Obj_Id : constant Entity_Id :=
+ First_Entity (Return_Statement_Entity (N));
+ Ret_Obj_Decl : constant Node_Id := Parent (Ret_Obj_Id);
+ Ret_Typ : constant Entity_Id := Etype (Func_Id);
+
+ Exp : Node_Id;
+ HSS : Node_Id;
+ Result : Node_Id;
+ Return_Stmt : Node_Id;
+ Stmts : List_Id;
+
-- Start of processing for Expand_N_Extended_Return_Statement
begin
-- with the scope finalizer. There is one flag per each return object
-- in case of multiple returns.
- if Is_Build_In_Place
- and then Needs_Finalization (Etype (Ret_Obj_Id))
- then
+ if Is_BIP_Func and then Needs_Finalization (Etype (Ret_Obj_Id)) then
declare
Flag_Decl : Node_Id;
Flag_Id : Entity_Id;
begin
-- Recover the function body
- Func_Bod := Unit_Declaration_Node (Par_Func);
+ Func_Bod := Unit_Declaration_Node (Func_Id);
if Nkind (Func_Bod) = N_Subprogram_Declaration then
Func_Bod := Parent (Parent (Corresponding_Body (Func_Bod)));
-- built in place (though we plan to do so eventually).
if Present (HSS)
- or else Is_Composite_Type (Result_Subt)
+ or else Is_Composite_Type (Ret_Typ)
or else No (Exp)
then
if No (HSS) then
-- result to be built in place, though that's necessarily true for
-- the case of result types with task parts.
- if Is_Build_In_Place
- and then Has_Task (Result_Subt)
- then
+ if Is_BIP_Func and then Has_Task (Ret_Typ) 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
-- contain tasks.
if Has_Task (Etype (Ret_Obj_Id)) then
- Append_To (Stmts, Move_Activation_Chain);
+ Append_To (Stmts, Move_Activation_Chain (Func_Id));
end if;
end if;
-- Update the state of the function right before the object is
-- returned.
- if Is_Build_In_Place
- and then Needs_Finalization (Etype (Ret_Obj_Id))
- then
+ if Is_BIP_Func and then Needs_Finalization (Etype (Ret_Obj_Id)) then
declare
Flag_Id : constant Entity_Id :=
Status_Flag_Or_Transient_Decl (Ret_Obj_Id);
-- build-in-place function, and that function is responsible for
-- the allocation of the return object.
- if Is_Build_In_Place
+ if Is_BIP_Func
and then Nkind (Ret_Obj_Decl) = N_Object_Renaming_Declaration
then
pragma Assert
Set_By_Ref (Return_Stmt);
- elsif Is_Build_In_Place then
+ elsif Is_BIP_Func then
-- Locate the implicit access parameter associated with the
-- caller-supplied return object and convert the return
-- ...
declare
- Return_Obj_Id : constant Entity_Id :=
- Defining_Identifier (Ret_Obj_Decl);
- Return_Obj_Typ : constant Entity_Id := Etype (Return_Obj_Id);
- Return_Obj_Expr : constant Node_Id :=
- Expression (Ret_Obj_Decl);
- Constr_Result : constant Boolean :=
- Is_Constrained (Result_Subt);
- Obj_Alloc_Formal : Entity_Id;
- Object_Access : Entity_Id;
- Obj_Acc_Deref : Node_Id;
+ Ret_Obj_Expr : constant Node_Id := Expression (Ret_Obj_Decl);
+ Ret_Obj_Typ : constant Entity_Id := Etype (Ret_Obj_Id);
+
Init_Assignment : Node_Id := Empty;
+ Obj_Acc_Formal : Entity_Id;
+ Obj_Acc_Deref : Node_Id;
+ Obj_Alloc_Formal : Entity_Id;
begin
-- Build-in-place results must be returned by reference
-- Retrieve the implicit access parameter passed by the caller
- Object_Access :=
- Build_In_Place_Formal (Par_Func, BIP_Object_Access);
+ Obj_Acc_Formal :=
+ Build_In_Place_Formal (Func_Id, BIP_Object_Access);
-- If the return object's declaration includes an expression
-- and the declaration isn't marked as No_Initialization, then
-- is a nonlimited descendant of a limited interface (the
-- interface has no assignment operation).
- if Present (Return_Obj_Expr)
+ if Present (Ret_Obj_Expr)
and then not No_Initialization (Ret_Obj_Decl)
- and then not Is_Interface (Return_Obj_Typ)
+ and then not Is_Interface (Ret_Obj_Typ)
then
Init_Assignment :=
Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Return_Obj_Id, Loc),
- Expression => Relocate_Node (Return_Obj_Expr));
+ Name => New_Occurrence_Of (Ret_Obj_Id, Loc),
+ Expression => Relocate_Node (Ret_Obj_Expr));
- Set_Etype (Name (Init_Assignment), Etype (Return_Obj_Id));
+ Set_Etype (Name (Init_Assignment), Etype (Ret_Obj_Id));
Set_Assignment_OK (Name (Init_Assignment));
Set_No_Ctrl_Actions (Init_Assignment);
Set_Expression (Ret_Obj_Decl, Empty);
- if Is_Class_Wide_Type (Etype (Return_Obj_Id))
+ if Is_Class_Wide_Type (Etype (Ret_Obj_Id))
and then not Is_Class_Wide_Type
(Etype (Expression (Init_Assignment)))
then
Rewrite (Expression (Init_Assignment),
Make_Type_Conversion (Loc,
Subtype_Mark =>
- New_Occurrence_Of (Etype (Return_Obj_Id), Loc),
+ New_Occurrence_Of (Etype (Ret_Obj_Id), Loc),
Expression =>
Relocate_Node (Expression (Init_Assignment))));
end if;
-- the different forms of allocation (this is true for
-- unconstrained and tagged result subtypes).
- if Constr_Result
- and then not Is_Tagged_Type (Underlying_Type (Result_Subt))
+ if Is_Constrained (Ret_Typ)
+ and then not Is_Tagged_Type (Underlying_Type (Ret_Typ))
then
Insert_After (Ret_Obj_Decl, Init_Assignment);
end if;
-- called in dispatching contexts and must be handled similarly
-- to functions with a class-wide result.
- if not Constr_Result
- or else Is_Tagged_Type (Underlying_Type (Result_Subt))
+ if not Is_Constrained (Ret_Typ)
+ or else Is_Tagged_Type (Underlying_Type (Ret_Typ))
then
Obj_Alloc_Formal :=
- Build_In_Place_Formal (Par_Func, BIP_Alloc_Form);
+ Build_In_Place_Formal (Func_Id, BIP_Alloc_Form);
declare
Pool_Id : constant Entity_Id :=
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication =>
- New_Occurrence_Of (Return_Obj_Typ, Loc)));
+ New_Occurrence_Of (Ret_Obj_Typ, Loc)));
Insert_Before (Ret_Obj_Decl, Ptr_Type_Decl);
-- global heap. If there's an initialization expression,
-- then create these as initialized allocators.
- if Present (Return_Obj_Expr)
+ if Present (Ret_Obj_Expr)
and then not No_Initialization (Ret_Obj_Decl)
then
-- Always use the type of the expression for the
Make_Qualified_Expression (Loc,
Subtype_Mark =>
New_Occurrence_Of
- (Etype (Return_Obj_Expr), Loc),
- Expression =>
- New_Copy_Tree (Return_Obj_Expr)));
+ (Etype (Ret_Obj_Expr), Loc),
+ Expression => New_Copy_Tree (Ret_Obj_Expr)));
else
-- If the function returns a class-wide type we cannot
-- use the type of the expression, which must be an
-- aggregate of a definite type.
- if Is_Class_Wide_Type (Return_Obj_Typ) then
+ if Is_Class_Wide_Type (Ret_Obj_Typ) then
Heap_Allocator :=
Make_Allocator (Loc,
Expression =>
New_Occurrence_Of
- (Etype (Return_Obj_Expr), Loc));
+ (Etype (Ret_Obj_Expr), Loc));
else
Heap_Allocator :=
Make_Allocator (Loc,
Expression =>
- New_Occurrence_Of (Return_Obj_Typ, Loc));
+ New_Occurrence_Of (Ret_Obj_Typ, Loc));
end if;
-- If the object requires default initialization then
Make_Explicit_Dereference (Loc,
New_Occurrence_Of
(Build_In_Place_Formal
- (Par_Func, BIP_Storage_Pool), Loc)));
+ (Func_Id, BIP_Storage_Pool), Loc)));
Set_Storage_Pool (Pool_Allocator, Pool_Id);
Set_Procedure_To_Call
(Pool_Allocator, RTE (RE_Allocate_Any));
-- statement, past the point where these flags are
-- normally set.
- Set_Sec_Stack_Needed_For_Return (Par_Func);
+ Set_Sec_Stack_Needed_For_Return (Func_Id);
Set_Sec_Stack_Needed_For_Return
(Return_Statement_Entity (N));
- Set_Uses_Sec_Stack (Par_Func);
+ Set_Uses_Sec_Stack (Func_Id);
Set_Uses_Sec_Stack (Return_Statement_Entity (N));
-- Create an if statement to test the BIP_Alloc_Form
Subtype_Mark =>
New_Occurrence_Of (Ref_Type, Loc),
Expression =>
- New_Occurrence_Of (Object_Access, Loc)))),
+ New_Occurrence_Of (Obj_Acc_Formal, Loc)))),
Elsif_Parts => New_List (
Make_Elsif_Part (Loc,
Build_Heap_Allocator
(Temp_Id => Alloc_Obj_Id,
Temp_Typ => Ref_Type,
- Func_Id => Par_Func,
- Ret_Typ => Return_Obj_Typ,
+ Func_Id => Func_Id,
+ Ret_Typ => Ret_Obj_Typ,
Alloc_Expr => Heap_Allocator)))),
Else_Statements => New_List (
Build_Heap_Allocator
(Temp_Id => Alloc_Obj_Id,
Temp_Typ => Ref_Type,
- Func_Id => Par_Func,
- Ret_Typ => Return_Obj_Typ,
+ Func_Id => Func_Id,
+ Ret_Typ => Ret_Obj_Typ,
Alloc_Expr => Pool_Allocator)));
-- If a separate initialization assignment was created
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc)));
- Set_Etype
- (Name (Init_Assignment), Etype (Return_Obj_Id));
+ Set_Etype (Name (Init_Assignment), Etype (Ret_Obj_Id));
Append_To
(Then_Statements (Alloc_If_Stmt), Init_Assignment);
-- Remember the local access object for use in the
-- dereference of the renaming created below.
- Object_Access := Alloc_Obj_Id;
+ Obj_Acc_Formal := Alloc_Obj_Id;
end;
end if;
Obj_Acc_Deref :=
Make_Explicit_Dereference (Loc,
- Prefix => New_Occurrence_Of (Object_Access, Loc));
+ Prefix => New_Occurrence_Of (Obj_Acc_Formal, Loc));
Rewrite (Ret_Obj_Decl,
Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => Return_Obj_Id,
+ Defining_Identifier => Ret_Obj_Id,
Access_Definition => Empty,
- Subtype_Mark =>
- New_Occurrence_Of (Return_Obj_Typ, Loc),
+ Subtype_Mark => New_Occurrence_Of (Ret_Obj_Typ, Loc),
Name => Obj_Acc_Deref));
- Set_Renamed_Object (Return_Obj_Id, Obj_Acc_Deref);
+ Set_Renamed_Object (Ret_Obj_Id, Obj_Acc_Deref);
end;
end if;
----------------------------------------------------
procedure Make_Build_In_Place_Call_In_Object_Declaration
- (Object_Decl : Node_Id;
+ (Obj_Decl : Node_Id;
Function_Call : Node_Id)
is
- Loc : Source_Ptr;
- Obj_Def_Id : constant Entity_Id :=
- Defining_Identifier (Object_Decl);
- Enclosing_Func : constant Entity_Id :=
- Enclosing_Subprogram (Obj_Def_Id);
+ Obj_Def_Id : constant Entity_Id := Defining_Identifier (Obj_Decl);
+ Encl_Func : constant Entity_Id := Enclosing_Subprogram (Obj_Def_Id);
+ Loc : constant Source_Ptr := Sloc (Function_Call);
+ Obj_Loc : constant Source_Ptr := Sloc (Obj_Decl);
+
Call_Deref : Node_Id;
Caller_Object : Node_Id;
Def_Id : Entity_Id;
Set_Is_Expanded_Build_In_Place_Call (Func_Call);
- Loc := Sloc (Function_Call);
-
if Is_Entity_Name (Name (Func_Call)) then
Function_Id := Entity (Name (Func_Call));
-- cause freezing.
if Definite
- and then not Is_Return_Object (Defining_Identifier (Object_Decl))
+ and then not Is_Return_Object (Defining_Identifier (Obj_Decl))
then
- Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl);
+ Insert_After_And_Analyze (Obj_Decl, Ptr_Typ_Decl);
else
- Insert_Action (Object_Decl, Ptr_Typ_Decl);
+ Insert_Action (Obj_Decl, Ptr_Typ_Decl);
end if;
-- Force immediate freezing of Ptr_Typ because Res_Decl will be
-- 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
+ if Is_Return_Object (Defining_Identifier (Obj_Decl)) then
Pass_Caller_Acc := True;
-- 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).
- if Needs_BIP_Alloc_Form (Enclosing_Func) then
+ if Needs_BIP_Alloc_Form (Encl_Func) then
if RTE_Available (RE_Root_Storage_Pool_Ptr) then
Pool_Actual :=
- New_Occurrence_Of (Build_In_Place_Formal
- (Enclosing_Func, BIP_Storage_Pool), Loc);
+ New_Occurrence_Of
+ (Build_In_Place_Formal (Encl_Func, BIP_Storage_Pool), Loc);
-- The build-in-place pool formal is not built on e.g. ZFP
Function_Id => Function_Id,
Alloc_Form_Exp =>
New_Occurrence_Of
- (Build_In_Place_Formal
- (Enclosing_Func, BIP_Alloc_Form), Loc),
+ (Build_In_Place_Formal (Encl_Func, BIP_Alloc_Form), Loc),
Pool_Actual => Pool_Actual);
-- Otherwise, if enclosing function has a definite result subtype,
(Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
end if;
- if Needs_BIP_Finalization_Master (Enclosing_Func) then
+ if Needs_BIP_Finalization_Master (Encl_Func) then
Fmaster_Actual :=
New_Occurrence_Of
(Build_In_Place_Formal
- (Enclosing_Func, BIP_Finalization_Master), Loc);
+ (Encl_Func, BIP_Finalization_Master), Loc);
end if;
-- Retrieve the BIPacc formal from the enclosing function and convert
-- it to the access type of the callee's BIP_Object_Access formal.
Caller_Object :=
- Make_Unchecked_Type_Conversion (Loc,
- Subtype_Mark =>
- New_Occurrence_Of
- (Etype
- (Build_In_Place_Formal (Function_Id, BIP_Object_Access)),
- Loc),
- Expression =>
- New_Occurrence_Of
- (Build_In_Place_Formal (Enclosing_Func, BIP_Object_Access),
- Loc));
+ Make_Unchecked_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of
+ (Etype
+ (Build_In_Place_Formal (Function_Id, BIP_Object_Access)),
+ Loc),
+ Expression =>
+ New_Occurrence_Of
+ (Build_In_Place_Formal (Encl_Func, BIP_Object_Access),
+ Loc));
-- In the definite case, add an implicit actual to the function call
-- that provides access to the declared object. An unchecked conversion
-- the secondary stack is destroyed after each library unload. This is
-- a hybrid mechanism where a stack-allocated object lives on the heap.
- elsif Is_Library_Level_Entity (Defining_Identifier (Object_Decl))
+ elsif Is_Library_Level_Entity (Defining_Identifier (Obj_Decl))
and then not Restriction_Active (No_Implicit_Heap_Allocations)
then
Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Alloc_Form => Secondary_Stack);
Caller_Object := Empty;
- Establish_Transient_Scope (Object_Decl, Sec_Stack => True);
+ Establish_Transient_Scope (Obj_Decl, Sec_Stack => True);
end if;
-- Pass along any finalization master actual, which is needed in the
Func_Id => Function_Id,
Master_Exp => Fmaster_Actual);
- if Nkind (Parent (Object_Decl)) = N_Extended_Return_Statement
+ if Nkind (Parent (Obj_Decl)) = N_Extended_Return_Statement
and then Has_Task (Result_Subt)
then
-- Here we're passing along the master that was passed in to this
Add_Task_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id,
Master_Actual =>
- New_Occurrence_Of (Build_In_Place_Formal
- (Enclosing_Func, BIP_Task_Master), Loc));
+ New_Occurrence_Of
+ (Build_In_Place_Formal (Encl_Func, BIP_Task_Master), Loc));
else
Add_Task_Actuals_To_Build_In_Place_Call
-- the object as having no initialization.
if Definite
- and then not Is_Return_Object (Defining_Identifier (Object_Decl))
+ and then not Is_Return_Object (Defining_Identifier (Obj_Decl))
then
-- The related object declaration is encased in a transient block
-- because the build-in-place function call contains at least one
-- which prompted the generation of the transient block. To resolve
-- this scenario, store the build-in-place call.
- if Scope_Is_Transient
- and then Node_To_Be_Wrapped = Object_Decl
- then
+ if Scope_Is_Transient and then Node_To_Be_Wrapped = Obj_Decl then
Set_BIP_Initialization_Call (Obj_Def_Id, Res_Decl);
end if;
- Set_Expression (Object_Decl, Empty);
- Set_No_Initialization (Object_Decl);
+ Set_Expression (Obj_Decl, Empty);
+ Set_No_Initialization (Obj_Decl);
-- In case of an indefinite result subtype, or if the call is the
-- return expression of an enclosing BIP function, rewrite the object
else
Call_Deref :=
- Make_Explicit_Dereference (Loc,
- Prefix => New_Occurrence_Of (Def_Id, Loc));
-
- Loc := Sloc (Object_Decl);
- Rewrite (Object_Decl,
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => Make_Temporary (Loc, 'D'),
- Access_Definition => Empty,
- Subtype_Mark => New_Occurrence_Of (Result_Subt, Loc),
+ Make_Explicit_Dereference (Obj_Loc,
+ Prefix => New_Occurrence_Of (Def_Id, Obj_Loc));
+
+ Rewrite (Obj_Decl,
+ Make_Object_Renaming_Declaration (Obj_Loc,
+ Defining_Identifier => Make_Temporary (Obj_Loc, 'D'),
+ Subtype_Mark => New_Occurrence_Of (Result_Subt, Obj_Loc),
Name => Call_Deref));
- Set_Renamed_Object (Defining_Identifier (Object_Decl), Call_Deref);
+ Set_Renamed_Object (Defining_Identifier (Obj_Decl), Call_Deref);
+
+ -- If the original entity comes from source, then mark the new
+ -- entity as needing debug information, even though it's defined
+ -- by a generated renaming that does not come from source, so that
+ -- the Materialize_Entity flag will be set on the entity when
+ -- Debug_Renaming_Declaration is called during analysis.
+
+ if Comes_From_Source (Obj_Def_Id) then
+ Set_Debug_Info_Needed (Defining_Identifier (Obj_Decl));
+ end if;
- Analyze (Object_Decl);
+ Analyze (Obj_Decl);
-- Replace the internal identifier of the renaming declaration's
-- entity with identifier of the original object entity. We also have
-- corrupted. Finally, the homonym chain must be preserved as well.
declare
- Renaming_Def_Id : constant Entity_Id :=
- Defining_Identifier (Object_Decl);
- Next_Entity_Temp : constant Entity_Id :=
- Next_Entity (Renaming_Def_Id);
+ Ren_Id : constant Entity_Id := Defining_Entity (Obj_Decl);
+ Next_Id : constant Entity_Id := Next_Entity (Ren_Id);
+
begin
- Set_Chars (Renaming_Def_Id, Chars (Obj_Def_Id));
+ Set_Chars (Ren_Id, Chars (Obj_Def_Id));
-- Swap next entity links in preparation for exchanging entities
- Set_Next_Entity (Renaming_Def_Id, Next_Entity (Obj_Def_Id));
- Set_Next_Entity (Obj_Def_Id, Next_Entity_Temp);
- Set_Homonym (Renaming_Def_Id, Homonym (Obj_Def_Id));
+ Set_Next_Entity (Ren_Id, Next_Entity (Obj_Def_Id));
+ Set_Next_Entity (Obj_Def_Id, Next_Id);
+ Set_Homonym (Ren_Id, Homonym (Obj_Def_Id));
- Exchange_Entities (Renaming_Def_Id, Obj_Def_Id);
+ Exchange_Entities (Ren_Id, Obj_Def_Id);
-- Preserve source indication of original declaration, so that
-- xref information is properly generated for the right entity.
- Preserve_Comes_From_Source
- (Object_Decl, Original_Node (Object_Decl));
-
- Preserve_Comes_From_Source
- (Obj_Def_Id, Original_Node (Object_Decl));
+ Preserve_Comes_From_Source (Obj_Decl, Original_Node (Obj_Decl));
+ Preserve_Comes_From_Source (Obj_Def_Id, Original_Node (Obj_Decl));
- Set_Comes_From_Source (Renaming_Def_Id, False);
+ Set_Comes_From_Source (Ren_Id, False);
end;
end if;
-- improve this treatment when build-in-place functions with class-wide
-- results are implemented. ???
- if Is_Class_Wide_Type (Etype (Defining_Identifier (Object_Decl))) then
- Set_Etype (Defining_Identifier (Object_Decl), Result_Subt);
+ if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl))) then
+ Set_Etype (Defining_Identifier (Obj_Decl), Result_Subt);
end if;
end Make_Build_In_Place_Call_In_Object_Declaration;
projects / gcc.git / commitdiff