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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-22 Ed Schonberg <schonb...@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.--- gcc/ada/atree.adb
+++ 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
+++ 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
+++ 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
+++ 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
+++ 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
+++ 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),
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/gen_formal_pkg.adb
@@ -0,0 +1,10 @@
+-- { 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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/gen_formal_pkg_a.ads
@@ -0,0 +1,3 @@
+generic
+ type T1 is private;
+package Gen_Formal_Pkg_A is end;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/gen_formal_pkg_b.ads
@@ -0,0 +1,6 @@
+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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/gen_formal_pkg_w.ads
@@ -0,0 +1,13 @@
+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;
