From 651822aec7caa0ed1aa8cb3dfb07a380b4595b08 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 22 May 2018 13:23:46 +0000 Subject: [PATCH] [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 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 | 15 ++++++++ gcc/ada/atree.adb | 18 ++++++++++ gcc/ada/atree.ads | 6 ++++ gcc/ada/atree.h | 1 + gcc/ada/einfo.adb | 13 +++++++ gcc/ada/einfo.ads | 12 +++++++ gcc/ada/sem_ch12.adb | 42 +++++++++++++++++----- gcc/testsuite/ChangeLog | 6 ++++ gcc/testsuite/gnat.dg/gen_formal_pkg.adb | 10 ++++++ gcc/testsuite/gnat.dg/gen_formal_pkg_a.ads | 3 ++ gcc/testsuite/gnat.dg/gen_formal_pkg_b.ads | 6 ++++ gcc/testsuite/gnat.dg/gen_formal_pkg_w.ads | 13 +++++++ 12 files changed, 136 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/gen_formal_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/gen_formal_pkg_a.ads create mode 100644 gcc/testsuite/gnat.dg/gen_formal_pkg_b.ads create mode 100644 gcc/testsuite/gnat.dg/gen_formal_pkg_w.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cef561e87fc..37615e9fd06 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2018-05-22 Ed Schonberg + + * 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 * sem_prag.adb (Analyze_Input_Output): Emit an error when a non-null, diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index f82ddbffda8..958cd5102a9 100644 --- a/gcc/ada/atree.adb +++ b/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); diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index c739f3a41d9..24d491852ef 100644 --- a/gcc/ada/atree.ads +++ b/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); diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h index 60ec64bcfff..338affe4eb6 100644 --- a/gcc/ada/atree.h +++ b/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) diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 4352f42ea88..a28cb4e2f73 100644 --- a/gcc/ada/einfo.adb +++ b/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); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 36967fd2632..76da3b9da6c 100644 --- a/gcc/ada/einfo.ads +++ b/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); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3d93619c685..d8721a548ee 100644 --- a/gcc/ada/sem_ch12.adb +++ b/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), diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 642200308cb..a0a57222bc6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-05-22 Ed Schonberg + + * 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 * gnat.dg/fixedpnt3.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/gen_formal_pkg.adb b/gcc/testsuite/gnat.dg/gen_formal_pkg.adb new file mode 100644 index 00000000000..b317e2b1c1e --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/gen_formal_pkg_a.ads b/gcc/testsuite/gnat.dg/gen_formal_pkg_a.ads new file mode 100644 index 00000000000..074129fec86 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/gen_formal_pkg_b.ads b/gcc/testsuite/gnat.dg/gen_formal_pkg_b.ads new file mode 100644 index 00000000000..60f7f946fb6 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/gen_formal_pkg_w.ads b/gcc/testsuite/gnat.dg/gen_formal_pkg_w.ads new file mode 100644 index 00000000000..d3100b74df7 --- /dev/null +++ b/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; -- 2.30.2