@@ -7675,59 +7675,54 @@ package body Exp_Ch3 is
Rewrite_As_Renaming :=
- -- If the object declaration appears in the form
+ -- The declaration cannot be rewritten if it has got constraints
+ -- in other words the nominal subtype must be unconstrained.
- -- Obj : Typ := Func (...);
+ Is_Entity_Name (Original_Node (Obj_Def))
- -- where Typ needs finalization and is returned on the secondary
- -- stack, the declaration can be rewritten into a dereference of
- -- the reference to the result built on the secondary stack (see
- -- Expand_Ctrl_Function_Call for this expansion of the call):
+ -- The aliased case has to be excluded because the expression
+ -- will not be aliased in the general case.
- -- type Axx is access all Typ;
- -- Rxx : constant Axx := Func (...)'reference;
- -- Obj : Typ renames Rxx.all;
+ and then not Aliased_Present (N)
- -- This avoids an extra copy and a pair of Adjust/Finalize calls
+ -- If the object declaration originally appears in the form
- ((not Is_Library_Level_Entity (Def_Id)
- and then Nkind (Expr_Q) = N_Explicit_Dereference
- and then not Comes_From_Source (Expr_Q)
- and then Nkind (Original_Node (Expr_Q)) = N_Function_Call
- and then Needs_Finalization (Typ)
- and then not Is_Class_Wide_Type (Typ))
+ -- Obj : Typ := Func (...);
- -- If the initializing expression is for a variable with flag
- -- OK_To_Rename set, then transform:
+ -- and has been rewritten as the dereference of a reference
+ -- to the function result built either on the primary or the
+ -- secondary stack, then the declaration can be rewritten as
+ -- the renaming of this dereference:
- -- Obj : Typ := Expr;
+ -- type Axx is access all Typ;
+ -- Rxx : constant Axx := Func (...)'reference;
+ -- Obj : Typ renames Rxx.all;
- -- into
+ -- This avoids an extra copy and, in the case where Typ needs
+ -- finalization, a pair of Adjust/Finalize calls (see below).
- -- Obj : Typ renames Expr;
+ and then
+ ((not Is_Library_Level_Entity (Def_Id)
+ and then Nkind (Expr_Q) = N_Explicit_Dereference
+ and then not Comes_From_Source (Expr_Q)
+ and then Nkind (Original_Node (Expr_Q)) = N_Function_Call
+ and then not Is_Class_Wide_Type (Typ))
- -- provided that Obj is not aliased. The aliased case has to
- -- be excluded because Expr will not be aliased in general.
+ -- If the initializing expression is a variable with the
+ -- flag OK_To_Rename set, then transform:
- or else (not Aliased_Present (N)
- and then (OK_To_Rename_Ref (Expr_Q)
- or else
- (Nkind (Expr_Q) = N_Slice
- and then
- OK_To_Rename_Ref (Prefix (Expr_Q))))))
+ -- Obj : Typ := Expr;
- -- The declaration cannot be rewritten if it has got constraints
- -- in other words the nominal subtype must be unconstrained.
+ -- into
+
+ -- Obj : Typ renames Expr;
- and then Is_Entity_Name (Original_Node (Obj_Def))
+ or else OK_To_Rename_Ref (Expr_Q)
- -- ??? Likewise if there are any aspect specifications, because
- -- otherwise we duplicate that corresponding implicit attribute
- -- definition and call Insert_Action, which has no place for the
- -- attribute definition. The attribute definition is stored in
- -- Aspect_Rep_Item, which is not a list.
+ -- Likewise if it is a slice of such a variable
- and then No (Aspect_Specifications (N));
+ or else (Nkind (Expr_Q) = N_Slice
+ and then OK_To_Rename_Ref (Prefix (Expr_Q))));
-- If the type needs finalization and is not inherently limited,
-- then the target is adjusted after the copy and attached to the
@@ -5048,41 +5048,6 @@ package body Sem_Ch3 is
end;
end if;
- -- Another optimization: if the nominal subtype is unconstrained and
- -- the expression is a function call that returns on the secondary
- -- stack, rewrite the declaration as a renaming of the result of the
- -- call. The exceptions below are cases where the copy is expected,
- -- either by the back end (Aliased case) or by the semantics, as for
- -- initializing controlled types or copying tags for class-wide types.
- -- ??? To be moved to Expand_N_Object_Declaration.Rewrite_As_Renaming.
-
- if Present (E)
- and then Nkind (E) = N_Explicit_Dereference
- and then Nkind (Original_Node (E)) = N_Function_Call
- and then not Is_Library_Level_Entity (Id)
- and then not Is_Aliased (Id)
- and then Needs_Secondary_Stack (T)
- and then not Is_Class_Wide_Type (T)
- and then not Needs_Finalization (T)
- and then Expander_Active
- then
- Rewrite (N,
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => Id,
- Access_Definition => Empty,
- Subtype_Mark => New_Occurrence_Of
- (Base_Type (Etype (Id)), Loc),
- Name => E));
-
- Set_Renamed_Object (Id, E);
-
- -- Force generation of debugging information for the constant and for
- -- the renamed function call.
-
- Set_Debug_Info_Needed (Id);
- Set_Debug_Info_Needed (Entity (Prefix (E)));
- end if;
-
if Present (Prev_Entity)
and then Is_Frozen (Prev_Entity)
and then not Error_Posted (Id)