-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
function Rewrite_As_Renaming return Boolean is
begin
- return not Aliased_Present (N)
- and then Is_Entity_Name (Expr_Q)
- and then Ekind (Entity (Expr_Q)) = E_Variable
- and then OK_To_Rename (Entity (Expr_Q))
- and then Is_Entity_Name (Obj_Def);
+ -- If the object declaration appears in the form
+
+ -- Obj : Ctrl_Typ := Func (...);
+
+ -- where Ctrl_Typ is controlled but not immutably limited type, then
+ -- the expansion of the function call should use a dereference of the
+ -- result to reference the value on the secondary stack.
+
+ -- Obj : Ctrl_Typ renames Func (...).all;
+
+ -- As a result, the call avoids an extra copy. This an optimization,
+ -- but it is required for passing ACATS tests in some cases where it
+ -- would otherwise make two copies. The RM allows removing redunant
+ -- Adjust/Finalize calls, but does not allow insertion of extra ones.
+
+ return (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 Nkind (Object_Definition (N)) in N_Has_Entity
+ and then (Needs_Finalization (Entity (Object_Definition (N)))))
+
+ -- If the initializing expression is for a variable with attribute
+ -- OK_To_Rename set, then transform:
+
+ -- Obj : Typ := Expr;
+
+ -- into
+
+ -- Obj : Typ renames Expr;
+
+ -- provided that Obj is not aliased. The aliased case has to be
+ -- excluded in general because Expr will not be aliased in
+ -- general.
+
+ or else
+ (not Aliased_Present (N)
+ and then Is_Entity_Name (Expr_Q)
+ and then Ekind (Entity (Expr_Q)) = E_Variable
+ and then OK_To_Rename (Entity (Expr_Q))
+ and then Is_Entity_Name (Obj_Def));
end Rewrite_As_Renaming;
-- Local variables
Insert_After_And_Analyze (Init_After, Stat);
end;
end if;
-
- -- Final transformation, if the initializing expression is an entity
- -- for a variable with OK_To_Rename set, then we transform:
-
- -- X : typ := expr;
-
- -- into
-
- -- X : typ renames expr
-
- -- provided that X is not aliased. The aliased case has to be
- -- excluded in general because Expr will not be aliased in general.
-
- if Rewrite_As_Renaming then
- Rewrite (N,
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => Defining_Identifier (N),
- Subtype_Mark => Obj_Def,
- Name => Expr_Q));
-
- -- We do not analyze this renaming declaration, because all its
- -- components have already been analyzed, and if we were to go
- -- ahead and analyze it, we would in effect be trying to generate
- -- another declaration of X, which won't do.
-
- Set_Renamed_Object (Defining_Identifier (N), Expr_Q);
- Set_Analyzed (N);
-
- -- We do need to deal with debug issues for this renaming
-
- -- First, if entity comes from source, then mark it as needing
- -- debug information, even though it is defined by a generated
- -- renaming that does not come from source.
-
- if Comes_From_Source (Defining_Identifier (N)) then
- Set_Debug_Info_Needed (Defining_Identifier (N));
- end if;
-
- -- Now call the routine to generate debug info for the renaming
-
- declare
- Decl : constant Node_Id := Debug_Renaming_Declaration (N);
- begin
- if Present (Decl) then
- Insert_Action (N, Decl);
- end if;
- end;
- end if;
end if;
- if Nkind (N) = N_Object_Declaration
- and then Nkind (Obj_Def) = N_Access_Definition
+ if Nkind (Obj_Def) = N_Access_Definition
and then not Is_Local_Anonymous_Access (Etype (Def_Id))
then
-- An Ada 2012 stand-alone object of an anonymous access type
end;
end if;
+ -- Final transformation - turn the object declaration into a renaming if
+ -- appropriate.
+
+ if Present (Expr) then
+ if Rewrite_As_Renaming then
+ Rewrite (N,
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => Defining_Identifier (N),
+ Subtype_Mark => Obj_Def,
+ Name => Expr_Q));
+
+ -- We do not analyze this renaming declaration, because all its
+ -- components have already been analyzed, and if we were to go
+ -- ahead and analyze it, we would in effect be trying to generate
+ -- another declaration of X, which won't do.
+
+ Set_Renamed_Object (Defining_Identifier (N), Expr_Q);
+ Set_Analyzed (N);
+
+ -- We do need to deal with debug issues for this renaming
+
+ -- First, if entity comes from source, then mark it as needing
+ -- debug information, even though it is defined by a generated
+ -- renaming that does not come from source.
+
+ if Comes_From_Source (Defining_Identifier (N)) then
+ Set_Debug_Info_Needed (Defining_Identifier (N));
+ end if;
+
+ -- Now call the routine to generate debug info for the renaming
+
+ declare
+ Decl : constant Node_Id := Debug_Renaming_Declaration (N);
+ begin
+ if Present (Decl) then
+ Insert_Action (N, Decl);
+ end if;
+ end;
+ end if;
+ end if;
+
-- Exception on library entity not available
exception
projects / platform / upstream / gcc.git / commitdiff