[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

gcc/ada/ChangeLog

+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,

gcc/ada/inline.adb

@@ -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');
 
-         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;
+            Body_Decls : List_Id := No_List;
+            Decl       : Node_Id;
+            Proc_Body  : Node_Id;
+            Proc_Spec  : Node_Id;
 
-            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));
-
-            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.
+         begin
+            --  Create formal parameters for the return object and all formals
+            --  of the unconstrained function in order to pass their values to
+            --  the procedure.
 
-            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)))));
+            Build_Return_Object_Formal
+              (Loc      => Loc,
+               Obj_Decl => Ret_Obj,
+               Formals  => Formals);
 
-               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);
-
-                     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;
+                  Append_To (Body_Decls,
+                    Make_Implicit_Label_Declaration (Loc,
+                      Make_Defining_Identifier (Loc,
+                        Chars => Chars (Defining_Identifier (Decl))),
+                      Label_Construct => Empty));
+
+                  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

gcc/testsuite/ChangeLog

+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,

gcc/testsuite/gnat.dg/inline15.adb

+--  { dg-do compile }
+--  { dg-options "-O2" }
+
+with Inline15_Gen;
+
+procedure Inline15 is
+   package Inst is new Inline15_Gen;
+
+begin
+   Inst.Call_Func;
+end Inline15;

gcc/testsuite/gnat.dg/inline15_gen.adb

+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;

gcc/testsuite/gnat.dg/inline15_gen.ads

+
+--  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;

gcc/testsuite/gnat.dg/inline15_types.ads

+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;