[Ada] Spurious visibility error in a nested instance with formal package

This patch fixes a spurious visibility error with a nested instance of a
generic unit with a formal package, when the actual for it is a formal
package PA of an enclosing generic, and there are subsequent uses of the
formals of PA in that generic unit.

2018-05-22  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* einfo.ads, einfo.adb: New attribute Hidden_In_Formal_Instance,
	defined on packages that are actuals for formal packages, in order to
	set/reset the visibility of the formals of a formal package with given
	actuals, when there are subsequent uses of those formals in the
	enclosing generic, as required by RN 12.7 (10).
	* atree.ads, atree.adb: Add operations for Elist30.
	* atree.h: Add Elist30.
	* sem_ch12.adb (Analyze_Formal_Package_Instantiation): Collect formals
	that are not defaulted and are thus not visible within the current
	instance.
	(Check_Formal_Packages): Reset visibility of formals of a formal
	package that are not defaulted, on exit from current instance.

gcc/testsuite/

	* gnat.dg/gen_formal_pkg.adb, gnat.dg/gen_formal_pkg_a.ads,
	gnat.dg/gen_formal_pkg_b.ads, gnat.dg/gen_formal_pkg_w.ads: New
	testcase.

From-SVN: r260520

gcc/ada/ChangeLog

+2018-05-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.ads, einfo.adb: New attribute Hidden_In_Formal_Instance,
+	defined on packages that are actuals for formal packages, in order to
+	set/reset the visibility of the formals of a formal package with given
+	actuals, when there are subsequent uses of those formals in the
+	enclosing generic, as required by RN 12.7 (10).
+	* atree.ads, atree.adb: Add operations for Elist30.
+	* atree.h: Add Elist30.
+	* sem_ch12.adb (Analyze_Formal_Package_Instantiation): Collect formals
+	that are not defaulted and are thus not visible within the current
+	instance.
+	(Check_Formal_Packages): Reset visibility of formals of a formal
+	package that are not defaulted, on exit from current instance.
+
 2018-05-22  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_prag.adb (Analyze_Input_Output): Emit an error when a non-null,

gcc/ada/atree.adb

@@ -3408,6 +3408,17 @@ package body Atree is
          end if;
       end Elist29;
 
+      function Elist30 (N : Node_Id) return Elist_Id is
+         pragma Assert (Nkind (N) in N_Entity);
+         Value : constant Union_Id := Nodes.Table (N + 5).Field6;
+      begin
+         if Value = 0 then
+            return No_Elist;
+         else
+            return Elist_Id (Value);
+         end if;
+      end Elist30;
+
       function Elist36 (N : Node_Id) return Elist_Id is
          pragma Assert (Nkind (N) in N_Entity);
          Value : constant Union_Id := Nodes.Table (N + 6).Field6;
@@ -6318,6 +6329,13 @@ package body Atree is
          Nodes.Table (N + 4).Field11 := Union_Id (Val);
       end Set_Elist29;
 
+      procedure Set_Elist30 (N : Node_Id; Val : Elist_Id) is
+      begin
+         pragma Assert (not Locked);
+         pragma Assert (Nkind (N) in N_Entity);
+         Nodes.Table (N + 5).Field6 := Union_Id (Val);
+      end Set_Elist30;
+
       procedure Set_Elist36 (N : Node_Id; Val : Elist_Id) is
       begin
          pragma Assert (not Locked);

gcc/ada/atree.ads

@@ -1523,6 +1523,9 @@ package Atree is
       function Elist29 (N : Node_Id) return Elist_Id;
       pragma Inline (Elist29);
 
+      function Elist30 (N : Node_Id) return Elist_Id;
+      pragma Inline (Elist30);
+
       function Elist36 (N : Node_Id) return Elist_Id;
       pragma Inline (Elist36);
 
@@ -2889,6 +2892,9 @@ package Atree is
       procedure Set_Elist29 (N : Node_Id; Val : Elist_Id);
       pragma Inline (Set_Elist29);
 
+      procedure Set_Elist30 (N : Node_Id; Val : Elist_Id);
+      pragma Inline (Set_Elist30);
+
       procedure Set_Elist36 (N : Node_Id; Val : Elist_Id);
       pragma Inline (Set_Elist36);
 

gcc/ada/atree.h

@@ -530,6 +530,7 @@ extern Node_Id Current_Error_Node;
 #define Elist25(N)    Field25 (N)
 #define Elist26(N)    Field26 (N)
 #define Elist29(N)    Field29 (N)
+#define Elist30(N)    Field30 (N)
 #define Elist36(N)    Field36 (N)
 
 #define Name1(N)      Field1  (N)

gcc/ada/einfo.adb

@@ -255,6 +255,7 @@ package body Einfo is
    --    Corresponding_Equality          Node30
    --    Last_Aggregate_Assignment       Node30
    --    Static_Initialization           Node30
+   --    Hidden_In_Formal_Instance       Elist30
 
    --    Derived_Type_Link               Node31
    --    Thunk_Entity                    Node31
@@ -1989,6 +1990,12 @@ package body Einfo is
       return Node8 (Id);
    end Hiding_Loop_Variable;
 
+   function Hidden_In_Formal_Instance (Id : E) return L is
+   begin
+      pragma Assert (Ekind (Id) = E_Package);
+      return Elist30 (Id);
+   end Hidden_In_Formal_Instance;
+
    function Homonym (Id : E) return E is
    begin
       return Node4 (Id);
@@ -5167,6 +5174,12 @@ package body Einfo is
       Set_Node8 (Id, V);
    end Set_Hiding_Loop_Variable;
 
+   procedure Set_Hidden_In_Formal_Instance (Id : E; V : L) is
+   begin
+      pragma Assert (Ekind (Id) = E_Package);
+      Set_Elist30 (Id, V);
+   end Set_Hidden_In_Formal_Instance;
+
    procedure Set_Homonym (Id : E; V : E) is
    begin
       pragma Assert (Id /= V);

gcc/ada/einfo.ads

@@ -2172,6 +2172,14 @@ package Einfo is
 --       warning messages if the hidden variable turns out to be unused
 --       or is referenced without being set.
 
+--    Hidden_In_Formal_Instance (Elist30)
+--       Defined on actuals for formal packages. Entities on the list are
+--       formals that are hidden outside of the formal package when this
+--       package is not declared with a box, or the formal itself is not
+--       defaulted (see RM 12.7 (10)). Their visibility is restored on exit
+--       from the current generic, because the actual for the formal package
+--       may be used subsequently in the current unit.
+
 --    Homonym (Node4)
 --       Defined in all entities. Link for list of entities that have the
 --       same source name and that are declared in the same or enclosing
@@ -7210,6 +7218,7 @@ package Einfo is
    function Has_Volatile_Components             (Id : E) return B;
    function Has_Xref_Entry                      (Id : E) return B;
    function Hiding_Loop_Variable                (Id : E) return E;
+   function Hidden_In_Formal_Instance           (Id : E) return L;
    function Homonym                             (Id : E) return E;
    function Ignore_SPARK_Mode_Pragmas           (Id : E) return B;
    function Import_Pragma                       (Id : E) return E;
@@ -7904,6 +7913,7 @@ package Einfo is
    procedure Set_Has_Volatile_Components         (Id : E; V : B := True);
    procedure Set_Has_Xref_Entry                  (Id : E; V : B := True);
    procedure Set_Hiding_Loop_Variable            (Id : E; V : E);
+   procedure Set_Hidden_In_Formal_Instance       (Id : E; V : L);
    procedure Set_Homonym                         (Id : E; V : E);
    procedure Set_Ignore_SPARK_Mode_Pragmas       (Id : E; V : B := True);
    procedure Set_Import_Pragma                   (Id : E; V : E);
@@ -8717,6 +8727,7 @@ package Einfo is
    pragma Inline (Has_Volatile_Components);
    pragma Inline (Has_Xref_Entry);
    pragma Inline (Hiding_Loop_Variable);
+   pragma Inline (Hidden_In_Formal_Instance);
    pragma Inline (Homonym);
    pragma Inline (Ignore_SPARK_Mode_Pragmas);
    pragma Inline (Import_Pragma);
@@ -9247,6 +9258,7 @@ package Einfo is
    pragma Inline (Set_Has_Volatile_Components);
    pragma Inline (Set_Has_Xref_Entry);
    pragma Inline (Set_Hiding_Loop_Variable);
+   pragma Inline (Set_Hidden_In_Formal_Instance);
    pragma Inline (Set_Homonym);
    pragma Inline (Set_Ignore_SPARK_Mode_Pragmas);
    pragma Inline (Set_Import_Pragma);

gcc/ada/sem_ch12.adb

@@ -500,7 +500,10 @@ package body Sem_Ch12 is
    --  check on Ada version and the presence of an access definition in N.
 
    procedure Check_Formal_Packages (P_Id : Entity_Id);
-   --  Apply the following to all formal packages in generic associations
+   --  Apply the following to all formal packages in generic associations.
+   --  Restore the visibility of the formals of the instance that are not
+   --  defaulted (see RM 12.7 (10)). Remove the anonymous package declaration
+   --  created for formal instances that are not defaulted.
 
    procedure Check_Formal_Package_Instance
      (Formal_Pack : Entity_Id;
@@ -6561,7 +6564,6 @@ package body Sem_Ch12 is
       E           : Entity_Id;
       Formal_P    : Entity_Id;
       Formal_Decl : Node_Id;
-
    begin
       --  Iterate through the declarations in the instance, looking for package
       --  renaming declarations that denote instances of formal packages. Stop
@@ -6611,6 +6613,21 @@ package body Sem_Ch12 is
                      Check_Formal_Package_Instance (Formal_P, E);
                   end if;
 
+                  --  Restore the visibility of formals of the formal instance
+                  --  that are not defaulted, and are hidden within the current
+                  --  generic. These formals may be visible within an enclosing
+                  --  generic.
+
+                  declare
+                     Elmt : Elmt_Id;
+                  begin
+                     Elmt := First_Elmt (Hidden_In_Formal_Instance (Formal_P));
+                     while Present (Elmt) loop
+                        Set_Is_Hidden (Node (Elmt), False);
+                        Next_Elmt (Elmt);
+                     end loop;
+                  end;
+
                   --  After checking, remove the internal validating package.
                   --  It is only needed for semantic checks, and as it may
                   --  contain generic formal declarations it should not reach
@@ -9953,13 +9970,14 @@ package body Sem_Ch12 is
       Actual          : Node_Id;
       Analyzed_Formal : Node_Id) return List_Id
    is
-      Loc         : constant Source_Ptr := Sloc (Actual);
-      Actual_Pack : Entity_Id;
-      Formal_Pack : Entity_Id;
-      Gen_Parent  : Entity_Id;
-      Decls       : List_Id;
-      Nod         : Node_Id;
-      Parent_Spec : Node_Id;
+      Loc            : constant Source_Ptr := Sloc (Actual);
+      Hidden_Formals : constant Elist_Id   := New_Elmt_List;
+      Actual_Pack    : Entity_Id;
+      Formal_Pack    : Entity_Id;
+      Gen_Parent     : Entity_Id;
+      Decls          : List_Id;
+      Nod            : Node_Id;
+      Parent_Spec    : Node_Id;
 
       procedure Find_Matching_Actual
        (F    : Node_Id;
@@ -10351,6 +10369,10 @@ package body Sem_Ch12 is
                         end if;
 
                      else
+                        if not Is_Hidden (Actual_Ent) then
+                           Append_Elmt (Actual_Ent, Hidden_Formals);
+                        end if;
+
                         Set_Is_Hidden (Actual_Ent);
                         Set_Is_Potentially_Use_Visible (Actual_Ent, False);
                      end if;
@@ -10409,6 +10431,8 @@ package body Sem_Ch12 is
 
             begin
                Set_Is_Internal (I_Pack);
+               Set_Ekind (I_Pack, E_Package);
+               Set_Hidden_In_Formal_Instance (I_Pack, Hidden_Formals);
 
                Append_To (Decls,
                  Make_Package_Instantiation (Sloc (Actual),

gcc/testsuite/ChangeLog

 2018-05-22  Ed Schonberg  <schonberg@adacore.com>
 
+	* gnat.dg/gen_formal_pkg.adb, gnat.dg/gen_formal_pkg_a.ads,
+	gnat.dg/gen_formal_pkg_b.ads, gnat.dg/gen_formal_pkg_w.ads: New
+	testcase.
+
+2018-05-22  Ed Schonberg  <schonberg@adacore.com>
+
 	* gnat.dg/fixedpnt3.adb: New testcase.
 
 2018-05-22  Justin Squirek  <squirek@adacore.com>

gcc/testsuite/gnat.dg/gen_formal_pkg.adb

+--  { dg-do compile }
+
+with Gen_Formal_Pkg_A, Gen_Formal_Pkg_B, Gen_Formal_Pkg_W;
+
+procedure Gen_Formal_Pkg is
+  package AI is new Gen_Formal_Pkg_A (Long_Float);
+  package WI is new Gen_Formal_Pkg_W (AI);
+begin
+   null;
+end;

gcc/testsuite/gnat.dg/gen_formal_pkg_a.ads

+generic
+   type T1 is private;
+package Gen_Formal_Pkg_A is end;

gcc/testsuite/gnat.dg/gen_formal_pkg_b.ads

+with Gen_Formal_Pkg_A;
+
+generic
+   type T1 is private;
+   with package Ai is new Gen_Formal_Pkg_A (T1);
+package Gen_Formal_Pkg_B is end;

gcc/testsuite/gnat.dg/gen_formal_pkg_w.ads

+with Gen_Formal_Pkg_A, Gen_Formal_Pkg_B;
+
+generic
+   with package Ai is new Gen_Formal_Pkg_A (<>);
+package Gen_Formal_Pkg_W is
+
+   procedure P1 (T : Ai.T1) is null;
+
+   package Bi is new Gen_Formal_Pkg_B (Ai.T1, Ai);
+
+   procedure P2 (T : Ai.T1) is null;
+
+end Gen_Formal_Pkg_W;