[Ada] Spurious visibility error in inlined function
This patch corrects the use of tree replication when inlining a function that returns an unconstrained result, and its sole statement is an extended return statement. The use of New_Copy_Tree ensires that global references saved in a generic template are properly carried over when the function is instantiated and inlined. 2019-07-03 Hristian Kirtchev <kirtchev@adacore.com> gcc/ada/ * inline.adb (Build_Return_Object_Formal): New routine. (Can_Split_Unconstrained_Function): Code clean up. (Copy_Formals,Copy_Return_Object): New routines. (Split_Unconstrained_Function): Code clean up and refactoring. gcc/testsuite/ * gnat.dg/inline15.adb, gnat.dg/inline15_gen.adb, gnat.dg/inline15_gen.ads, gnat.dg/inline15_types.ads: New testcase. From-SVN: r272980
This commit is contained in:
parent
866000e7fb
commit
abc856cf22
|
@ -1,3 +1,10 @@
|
|||
2019-07-03 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* inline.adb (Build_Return_Object_Formal): New routine.
|
||||
(Can_Split_Unconstrained_Function): Code clean up.
|
||||
(Copy_Formals,Copy_Return_Object): New routines.
|
||||
(Split_Unconstrained_Function): Code clean up and refactoring.
|
||||
|
||||
2019-07-03 Gary Dismukes <dismukes@adacore.com>
|
||||
|
||||
* bindo-augmentors.adb, bindo-augmentors.ads,
|
||||
|
|
|
@ -1706,11 +1706,29 @@ package body Inline is
|
|||
-- Use generic machinery to build an unexpanded body for the subprogram.
|
||||
-- This body is subsequently used for inline expansions at call sites.
|
||||
|
||||
procedure Build_Return_Object_Formal
|
||||
(Loc : Source_Ptr;
|
||||
Obj_Decl : Node_Id;
|
||||
Formals : List_Id);
|
||||
-- Create a formal parameter for return object declaration Obj_Decl of
|
||||
-- an extended return statement and add it to list Formals.
|
||||
|
||||
function Can_Split_Unconstrained_Function (N : Node_Id) return Boolean;
|
||||
-- Return true if we generate code for the function body N, the function
|
||||
-- body N has no local declarations and its unique statement is a single
|
||||
-- extended return statement with a handled statements sequence.
|
||||
|
||||
procedure Copy_Formals
|
||||
(Loc : Source_Ptr;
|
||||
Subp_Id : Entity_Id;
|
||||
Formals : List_Id);
|
||||
-- Create new formal parameters from the formal parameters of subprogram
|
||||
-- Subp_Id and add them to list Formals.
|
||||
|
||||
function Copy_Return_Object (Obj_Decl : Node_Id) return Node_Id;
|
||||
-- Create a copy of return object declaration Obj_Decl of an extended
|
||||
-- return statement.
|
||||
|
||||
procedure Split_Unconstrained_Function
|
||||
(N : Node_Id;
|
||||
Spec_Id : Entity_Id);
|
||||
|
@ -1757,6 +1775,9 @@ package body Inline is
|
|||
Body_To_Inline :=
|
||||
Copy_Generic_Node (N, Empty, Instantiating => True);
|
||||
else
|
||||
-- ??? Shouldn't this use New_Copy_Tree? What about global
|
||||
-- references captured in the body to inline?
|
||||
|
||||
Body_To_Inline := Copy_Separate_Tree (N);
|
||||
end if;
|
||||
|
||||
|
@ -1845,30 +1866,70 @@ package body Inline is
|
|||
Set_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id));
|
||||
end Build_Body_To_Inline;
|
||||
|
||||
--------------------------------
|
||||
-- Build_Return_Object_Formal --
|
||||
--------------------------------
|
||||
|
||||
procedure Build_Return_Object_Formal
|
||||
(Loc : Source_Ptr;
|
||||
Obj_Decl : Node_Id;
|
||||
Formals : List_Id)
|
||||
is
|
||||
Obj_Def : constant Node_Id := Object_Definition (Obj_Decl);
|
||||
Obj_Id : constant Entity_Id := Defining_Entity (Obj_Decl);
|
||||
Typ_Def : Node_Id;
|
||||
|
||||
begin
|
||||
-- Build the type definition of the formal parameter. The use of
|
||||
-- New_Copy_Tree ensures that global references preserved in the
|
||||
-- case of generics.
|
||||
|
||||
if Is_Entity_Name (Obj_Def) then
|
||||
Typ_Def := New_Copy_Tree (Obj_Def);
|
||||
else
|
||||
Typ_Def := New_Copy_Tree (Subtype_Mark (Obj_Def));
|
||||
end if;
|
||||
|
||||
-- Generate:
|
||||
--
|
||||
-- Obj_Id : [out] Typ_Def
|
||||
|
||||
-- Mode OUT should not be used when the return object is declared as
|
||||
-- a constant. Check the definition of the object declaration because
|
||||
-- the object has not been analyzed yet.
|
||||
|
||||
Append_To (Formals,
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier =>
|
||||
Make_Defining_Identifier (Loc, Chars (Obj_Id)),
|
||||
In_Present => False,
|
||||
Out_Present => not Constant_Present (Obj_Decl),
|
||||
Null_Exclusion_Present => False,
|
||||
Parameter_Type => Typ_Def));
|
||||
end Build_Return_Object_Formal;
|
||||
|
||||
--------------------------------------
|
||||
-- Can_Split_Unconstrained_Function --
|
||||
--------------------------------------
|
||||
|
||||
function Can_Split_Unconstrained_Function (N : Node_Id) return Boolean is
|
||||
Ret_Node : constant Node_Id :=
|
||||
First (Statements (Handled_Statement_Sequence (N)));
|
||||
D : Node_Id;
|
||||
Stmt : constant Node_Id :=
|
||||
First (Statements (Handled_Statement_Sequence (N)));
|
||||
Decl : Node_Id;
|
||||
|
||||
begin
|
||||
-- No user defined declarations allowed in the function except inside
|
||||
-- the unique return statement; implicit labels are the only allowed
|
||||
-- declarations.
|
||||
|
||||
if not Is_Empty_List (Declarations (N)) then
|
||||
D := First (Declarations (N));
|
||||
while Present (D) loop
|
||||
if Nkind (D) /= N_Implicit_Label_Declaration then
|
||||
return False;
|
||||
end if;
|
||||
Decl := First (Declarations (N));
|
||||
while Present (Decl) loop
|
||||
if Nkind (Decl) /= N_Implicit_Label_Declaration then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
Next (D);
|
||||
end loop;
|
||||
end if;
|
||||
Next (Decl);
|
||||
end loop;
|
||||
|
||||
-- We only split the inlined function when we are generating the code
|
||||
-- of its body; otherwise we leave duplicated split subprograms in
|
||||
|
@ -1876,12 +1937,71 @@ package body Inline is
|
|||
-- time.
|
||||
|
||||
return In_Extended_Main_Code_Unit (N)
|
||||
and then Present (Ret_Node)
|
||||
and then Nkind (Ret_Node) = N_Extended_Return_Statement
|
||||
and then No (Next (Ret_Node))
|
||||
and then Present (Handled_Statement_Sequence (Ret_Node));
|
||||
and then Present (Stmt)
|
||||
and then Nkind (Stmt) = N_Extended_Return_Statement
|
||||
and then No (Next (Stmt))
|
||||
and then Present (Handled_Statement_Sequence (Stmt));
|
||||
end Can_Split_Unconstrained_Function;
|
||||
|
||||
------------------
|
||||
-- Copy_Formals --
|
||||
------------------
|
||||
|
||||
procedure Copy_Formals
|
||||
(Loc : Source_Ptr;
|
||||
Subp_Id : Entity_Id;
|
||||
Formals : List_Id)
|
||||
is
|
||||
Formal : Entity_Id;
|
||||
Spec : Node_Id;
|
||||
|
||||
begin
|
||||
Formal := First_Formal (Subp_Id);
|
||||
while Present (Formal) loop
|
||||
Spec := Parent (Formal);
|
||||
|
||||
-- Create an exact copy of the formal parameter. The use of
|
||||
-- New_Copy_Tree ensures that global references are preserved
|
||||
-- in case of generics.
|
||||
|
||||
Append_To (Formals,
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier =>
|
||||
Make_Defining_Identifier (Sloc (Formal), Chars (Formal)),
|
||||
In_Present => In_Present (Spec),
|
||||
Out_Present => Out_Present (Spec),
|
||||
Null_Exclusion_Present => Null_Exclusion_Present (Spec),
|
||||
Parameter_Type =>
|
||||
New_Copy_Tree (Parameter_Type (Spec)),
|
||||
Expression => New_Copy_Tree (Expression (Spec))));
|
||||
|
||||
Next_Formal (Formal);
|
||||
end loop;
|
||||
end Copy_Formals;
|
||||
|
||||
------------------------
|
||||
-- Copy_Return_Object --
|
||||
------------------------
|
||||
|
||||
function Copy_Return_Object (Obj_Decl : Node_Id) return Node_Id is
|
||||
Obj_Id : constant Entity_Id := Defining_Entity (Obj_Decl);
|
||||
|
||||
begin
|
||||
-- The use of New_Copy_Tree ensures that global references are
|
||||
-- preserved in case of generics.
|
||||
|
||||
return
|
||||
Make_Object_Declaration (Sloc (Obj_Decl),
|
||||
Defining_Identifier =>
|
||||
Make_Defining_Identifier (Sloc (Obj_Id), Chars (Obj_Id)),
|
||||
Aliased_Present => Aliased_Present (Obj_Decl),
|
||||
Constant_Present => Constant_Present (Obj_Decl),
|
||||
Null_Exclusion_Present => Null_Exclusion_Present (Obj_Decl),
|
||||
Object_Definition =>
|
||||
New_Copy_Tree (Object_Definition (Obj_Decl)),
|
||||
Expression => New_Copy_Tree (Expression (Obj_Decl)));
|
||||
end Copy_Return_Object;
|
||||
|
||||
----------------------------------
|
||||
-- Split_Unconstrained_Function --
|
||||
----------------------------------
|
||||
|
@ -1891,10 +2011,10 @@ package body Inline is
|
|||
Spec_Id : Entity_Id)
|
||||
is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Ret_Node : constant Node_Id :=
|
||||
Ret_Stmt : constant Node_Id :=
|
||||
First (Statements (Handled_Statement_Sequence (N)));
|
||||
Ret_Obj : constant Node_Id :=
|
||||
First (Return_Object_Declarations (Ret_Node));
|
||||
First (Return_Object_Declarations (Ret_Stmt));
|
||||
|
||||
procedure Build_Procedure
|
||||
(Proc_Id : out Entity_Id;
|
||||
|
@ -1910,63 +2030,35 @@ package body Inline is
|
|||
(Proc_Id : out Entity_Id;
|
||||
Decl_List : out List_Id)
|
||||
is
|
||||
Formal : Entity_Id;
|
||||
Formal_List : constant List_Id := New_List;
|
||||
Proc_Spec : Node_Id;
|
||||
Proc_Body : Node_Id;
|
||||
Subp_Name : constant Name_Id := New_Internal_Name ('F');
|
||||
Body_Decl_List : List_Id := No_List;
|
||||
Param_Type : Node_Id;
|
||||
Formals : constant List_Id := New_List;
|
||||
Subp_Name : constant Name_Id := New_Internal_Name ('F');
|
||||
|
||||
Body_Decls : List_Id := No_List;
|
||||
Decl : Node_Id;
|
||||
Proc_Body : Node_Id;
|
||||
Proc_Spec : Node_Id;
|
||||
|
||||
begin
|
||||
if Nkind (Object_Definition (Ret_Obj)) = N_Identifier then
|
||||
Param_Type :=
|
||||
New_Copy (Object_Definition (Ret_Obj));
|
||||
else
|
||||
Param_Type :=
|
||||
New_Copy (Subtype_Mark (Object_Definition (Ret_Obj)));
|
||||
end if;
|
||||
-- Create formal parameters for the return object and all formals
|
||||
-- of the unconstrained function in order to pass their values to
|
||||
-- the procedure.
|
||||
|
||||
Append_To (Formal_List,
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier =>
|
||||
Make_Defining_Identifier (Loc,
|
||||
Chars => Chars (Defining_Identifier (Ret_Obj))),
|
||||
In_Present => False,
|
||||
Out_Present => True,
|
||||
Null_Exclusion_Present => False,
|
||||
Parameter_Type => Param_Type));
|
||||
Build_Return_Object_Formal
|
||||
(Loc => Loc,
|
||||
Obj_Decl => Ret_Obj,
|
||||
Formals => Formals);
|
||||
|
||||
Formal := First_Formal (Spec_Id);
|
||||
|
||||
-- Note that we copy the parameter type rather than creating
|
||||
-- a reference to it, because it may be a class-wide entity
|
||||
-- that will not be retrieved by name.
|
||||
|
||||
while Present (Formal) loop
|
||||
Append_To (Formal_List,
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier =>
|
||||
Make_Defining_Identifier (Sloc (Formal),
|
||||
Chars => Chars (Formal)),
|
||||
In_Present => In_Present (Parent (Formal)),
|
||||
Out_Present => Out_Present (Parent (Formal)),
|
||||
Null_Exclusion_Present =>
|
||||
Null_Exclusion_Present (Parent (Formal)),
|
||||
Parameter_Type =>
|
||||
New_Copy_Tree (Parameter_Type (Parent (Formal))),
|
||||
Expression =>
|
||||
Copy_Separate_Tree (Expression (Parent (Formal)))));
|
||||
|
||||
Next_Formal (Formal);
|
||||
end loop;
|
||||
Copy_Formals
|
||||
(Loc => Loc,
|
||||
Subp_Id => Spec_Id,
|
||||
Formals => Formals);
|
||||
|
||||
Proc_Id := Make_Defining_Identifier (Loc, Chars => Subp_Name);
|
||||
|
||||
Proc_Spec :=
|
||||
Make_Procedure_Specification (Loc,
|
||||
Defining_Unit_Name => Proc_Id,
|
||||
Parameter_Specifications => Formal_List);
|
||||
Parameter_Specifications => Formals);
|
||||
|
||||
Decl_List := New_List;
|
||||
|
||||
|
@ -1978,37 +2070,30 @@ package body Inline is
|
|||
-- Copy these declarations to the built procedure.
|
||||
|
||||
if Present (Declarations (N)) then
|
||||
Body_Decl_List := New_List;
|
||||
Body_Decls := New_List;
|
||||
|
||||
declare
|
||||
D : Node_Id;
|
||||
New_D : Node_Id;
|
||||
Decl := First (Declarations (N));
|
||||
while Present (Decl) loop
|
||||
pragma Assert (Nkind (Decl) = N_Implicit_Label_Declaration);
|
||||
|
||||
begin
|
||||
D := First (Declarations (N));
|
||||
while Present (D) loop
|
||||
pragma Assert (Nkind (D) = N_Implicit_Label_Declaration);
|
||||
Append_To (Body_Decls,
|
||||
Make_Implicit_Label_Declaration (Loc,
|
||||
Make_Defining_Identifier (Loc,
|
||||
Chars => Chars (Defining_Identifier (Decl))),
|
||||
Label_Construct => Empty));
|
||||
|
||||
New_D :=
|
||||
Make_Implicit_Label_Declaration (Loc,
|
||||
Make_Defining_Identifier (Loc,
|
||||
Chars => Chars (Defining_Identifier (D))),
|
||||
Label_Construct => Empty);
|
||||
Append_To (Body_Decl_List, New_D);
|
||||
|
||||
Next (D);
|
||||
end loop;
|
||||
end;
|
||||
Next (Decl);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
pragma Assert (Present (Handled_Statement_Sequence (Ret_Node)));
|
||||
pragma Assert (Present (Handled_Statement_Sequence (Ret_Stmt)));
|
||||
|
||||
Proc_Body :=
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification => Copy_Separate_Tree (Proc_Spec),
|
||||
Declarations => Body_Decl_List,
|
||||
Specification => Copy_Subprogram_Spec (Proc_Spec),
|
||||
Declarations => Body_Decls,
|
||||
Handled_Statement_Sequence =>
|
||||
Copy_Separate_Tree (Handled_Statement_Sequence (Ret_Node)));
|
||||
New_Copy_Tree (Handled_Statement_Sequence (Ret_Stmt)));
|
||||
|
||||
Set_Defining_Unit_Name (Specification (Proc_Body),
|
||||
Make_Defining_Identifier (Loc, Subp_Name));
|
||||
|
@ -2018,10 +2103,10 @@ package body Inline is
|
|||
|
||||
-- Local variables
|
||||
|
||||
New_Obj : constant Node_Id := Copy_Separate_Tree (Ret_Obj);
|
||||
New_Obj : constant Node_Id := Copy_Return_Object (Ret_Obj);
|
||||
Blk_Stmt : Node_Id;
|
||||
Proc_Id : Entity_Id;
|
||||
Proc_Call : Node_Id;
|
||||
Proc_Id : Entity_Id;
|
||||
|
||||
-- Start of processing for Split_Unconstrained_Function
|
||||
|
||||
|
@ -2089,7 +2174,7 @@ package body Inline is
|
|||
New_Occurrence_Of
|
||||
(Defining_Identifier (New_Obj), Loc)))));
|
||||
|
||||
Rewrite (Ret_Node, Blk_Stmt);
|
||||
Rewrite (Ret_Stmt, Blk_Stmt);
|
||||
end Split_Unconstrained_Function;
|
||||
|
||||
-- Local variables
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2019-07-03 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* gnat.dg/inline15.adb, gnat.dg/inline15_gen.adb,
|
||||
gnat.dg/inline15_gen.ads, gnat.dg/inline15_types.ads: New
|
||||
testcase.
|
||||
|
||||
2019-07-03 Bob Duff <duff@adacore.com>
|
||||
|
||||
* gnat.dg/warn20.adb, gnat.dg/warn20_pkg.adb,
|
||||
|
|
|
@ -0,0 +1,11 @@
|
|||
-- { dg-do compile }
|
||||
-- { dg-options "-O2" }
|
||||
|
||||
with Inline15_Gen;
|
||||
|
||||
procedure Inline15 is
|
||||
package Inst is new Inline15_Gen;
|
||||
|
||||
begin
|
||||
Inst.Call_Func;
|
||||
end Inline15;
|
|
@ -0,0 +1,27 @@
|
|||
package body Inline15_Gen is
|
||||
function Initialize (Val : Inline15_Types.Enum) return Inline15_Types.Rec;
|
||||
procedure Print (Val : Inline15_Types.Rec);
|
||||
|
||||
procedure Call_Func is
|
||||
Result : constant Inline15_Types.Rec := Func (Inline15_Types.Two);
|
||||
begin
|
||||
null;
|
||||
end Call_Func;
|
||||
|
||||
function Func (Val : Inline15_Types.Enum) return Inline15_Types.Rec is
|
||||
begin
|
||||
return Result : constant Inline15_Types.Rec := Initialize (Val) do
|
||||
Print (Result);
|
||||
end return;
|
||||
end Func;
|
||||
|
||||
function Initialize (Val : Inline15_Types.Enum) return Inline15_Types.Rec is
|
||||
pragma Warnings (Off);
|
||||
Result : Inline15_Types.Rec (Val);
|
||||
pragma Warnings (On);
|
||||
begin
|
||||
return Result;
|
||||
end Initialize;
|
||||
|
||||
procedure Print (Val : Inline15_Types.Rec) is begin null; end Print;
|
||||
end Inline15_Gen;
|
|
@ -0,0 +1,11 @@
|
|||
|
||||
-- gen.ads
|
||||
|
||||
with Inline15_Types;
|
||||
|
||||
generic
|
||||
package Inline15_Gen is
|
||||
function Func (Val : Inline15_Types.Enum) return Inline15_Types.Rec with Inline;
|
||||
|
||||
procedure Call_Func with Inline;
|
||||
end Inline15_Gen;
|
|
@ -0,0 +1,17 @@
|
|||
package Inline15_Types is
|
||||
type Enum is (One, Two, Three, Four);
|
||||
|
||||
type Rec (Discr : Enum) is record
|
||||
Comp_1 : Integer;
|
||||
|
||||
case Discr is
|
||||
when One =>
|
||||
Comp_2 : Float;
|
||||
when Two =>
|
||||
Comp_3 : Boolean;
|
||||
Comp_4 : Long_Float;
|
||||
when others =>
|
||||
null;
|
||||
end case;
|
||||
end record;
|
||||
end Inline15_Types;
|
Loading…
Reference in New Issue