Skip to content

R
riscv-gcc-1
Commit 24d2fbbe by Bob Duff Committed by Arnaud Charlet
Options

exp_ch3.adb (Expand_N_Object_Declaration): Rewrite an object declaration of the form "X ... 

2016-04-27  Bob Duff  <duff@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Rewrite an object
	declaration of the form "X : T := Func (...);", where T is
	controlled, as a renaming.
	* a-strunb-shared.adb (Finalize): Set the Unbounded_String Object
	to be an empty string, instead of null-ing out the Reference.
	* exp_util.adb (Needs_Finalization): Remove redundant code.

From-SVN: r235488
parent 45e20696
Showing with 100 additions and 63 deletions
gcc/ada/ChangeLog
2016-04-27 Bob Duff <duff@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): Rewrite an object
declaration of the form "X : T := Func (...);", where T is
controlled, as a renaming.
* a-strunb-shared.adb (Finalize): Set the Unbounded_String Object
to be an empty string, instead of null-ing out the Reference.
* exp_util.adb (Needs_Finalization): Remove redundant code.
2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.ads Aspects Export and Import do not require delay. They
......
gcc/ada/a-strunb-shared.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, 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- --
......@@ -795,7 +795,10 @@ package body Ada.Strings.Unbounded is
-- so we need to add a guard for the case of finalizing the same
-- object twice.
Object.Reference := null;
-- We set the Object to the empty string so there will be no ill
-- effects if a program references an already-finalized object.
Object.Reference := Null_Unbounded_String.Reference;
Unreference (SR);
end if;
end Finalize;
......
gcc/ada/exp_ch3.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -6336,11 +6336,46 @@ package body Exp_Ch3 is
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
......@@ -6993,58 +7028,9 @@ package body Exp_Ch3 is
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
......@@ -7122,6 +7108,47 @@ package body Exp_Ch3 is
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
......
gcc/ada/exp_util.adb
......@@ -6995,11 +6995,10 @@ package body Exp_Util is
return False;
elsif Is_Array_Type (Rec) then
return Needs_Finalization (Component_Type (Rec));
else
return Has_Controlled_Component (Rec);
return
Is_Array_Type (Rec)
and then Needs_Finalization (Component_Type (Rec));
end if;
else
return False;
......@@ -7032,7 +7031,6 @@ package body Exp_Util is
return Is_Class_Wide_Type (T)
or else Is_Controlled (T)
or else Has_Controlled_Component (T)
or else Has_Some_Controlled_Component (T)
or else
(Is_Concurrent_Type (T)
......
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