This patch removes a spurious bug on the use of the current instance of
a generic package G as the actual in a nested instantiation of a generic
unit GU that has a formal package whose generic_package name is G. This
is only legal if G has no generic formal part, and the formal package
declaration is declared with a box or without a formal_paxkage_actual
part.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-09 Ed Schonberg <schonb...@adacore.com>
gcc/ada/
* sem_ch12.adb (Instantiate_Formal_Package): Handle properly the
case where the actual for a formal package in an instance is the
current instance of an enclosing generic package.
(Check_Formal_Packages): If the formal package declaration is
box-initialized or lacks associations altogether, no internal
instance was created to verify conformance, and there is no
validating package to remove from tree.
gcc/testsuite/
* gnat.dg/generic_inst5.adb, gnat.dg/generic_inst6.adb,
gnat.dg/generic_inst6_g1-c.adb, gnat.dg/generic_inst6_g1-c.ads,
gnat.dg/generic_inst6_g1.ads, gnat.dg/generic_inst6_i1.ads,
gnat.dg/generic_inst6_i2.ads, gnat.dg/generic_inst6_x.ads: New
testcases.--- gcc/ada/sem_ch12.adb
+++ gcc/ada/sem_ch12.adb
@@ -6657,9 +6657,11 @@ package body Sem_Ch12 is
Formal_Decl := Parent (Associated_Formal_Package (E));
-- Nothing to check if the formal has a box or an others_clause
- -- (necessarily with a box).
+ -- (necessarily with a box), or no associations altogether
- if Box_Present (Formal_Decl) then
+ if Box_Present (Formal_Decl)
+ or else No (Generic_Associations (Formal_Decl))
+ then
null;
elsif Nkind (First (Generic_Associations (Formal_Decl))) =
@@ -10309,8 +10311,11 @@ package body Sem_Ch12 is
begin
Analyze (Actual);
+ -- The actual must be a package instance, or else a current instance
+ -- such as a parent generic within the body of a generic child.
+
if not Is_Entity_Name (Actual)
- or else Ekind (Entity (Actual)) /= E_Package
+ or else not Ekind_In (Entity (Actual), E_Package, E_Generic_Package)
then
Error_Msg_N
("expect package instance to instantiate formal", Actual);
@@ -10354,6 +10359,14 @@ package body Sem_Ch12 is
then
null;
+ -- If this is the current instance of an enclosing generic, that
+ -- unit is the generic package we need.
+
+ elsif In_Open_Scopes (Actual_Pack)
+ and then Ekind (Actual_Pack) = E_Generic_Package
+ then
+ null;
+
else
Error_Msg_NE
("actual parameter must be instance of&", Actual, Gen_Parent);
@@ -10487,6 +10500,17 @@ package body Sem_Ch12 is
Next_Entity (Actual_Ent);
end loop;
+
+ -- No conformance to check if the generic has no formal parameters
+ -- and the formal package has no generic associations.
+
+ if Is_Empty_List (Formals)
+ and then
+ (Box_Present (Formal)
+ or else No (Generic_Associations (Formal)))
+ then
+ return Decls;
+ end if;
end;
-- If the formal is not declared with a box, reanalyze it as an
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst5.adb
@@ -0,0 +1,20 @@
+-- { dg-do compile }
+
+procedure Generic_Inst5 is
+ generic
+ package G1 is
+ end G1;
+
+ generic
+ with package I1 is new G1;
+ package G2 is
+ end G2;
+
+ package body G1 is
+ package I2 is new G2 (I1 => G1);
+ end G1;
+
+ package I1 is new G1;
+begin
+ null;
+end;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst6.adb
@@ -0,0 +1,9 @@
+-- { dg-do run }
+with Text_IO; use Text_IO;
+with Generic_Inst6_I2;
+procedure Generic_Inst6 is
+begin
+ if Generic_Inst6_I2.Check /= 49 then
+ raise Program_Error;
+ end if;
+end;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst6_g1-c.adb
@@ -0,0 +1,6 @@
+with Generic_Inst6_X;
+package body Generic_Inst6_G1.C is
+ package N is new Generic_Inst6_X
+ (Generic_Inst6_G1, Generic_Inst6_G1);
+ function Check return Integer is (N.Result);
+end;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst6_g1-c.ads
@@ -0,0 +1,3 @@
+generic package Generic_Inst6_G1.C is
+ function Check return Integer;
+end;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst6_g1.ads
@@ -0,0 +1,3 @@
+generic package Generic_Inst6_G1 is
+ Val : Integer := 7;
+ end;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst6_i1.ads
@@ -0,0 +1,2 @@
+with Generic_Inst6_G1;
+package Generic_Inst6_I1 is new Generic_Inst6_G1;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst6_i2.ads
@@ -0,0 +1,2 @@
+with Generic_Inst6_I1, Generic_Inst6_G1.C;
+package Generic_Inst6_I2 is new Generic_Inst6_I1.C;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst6_x.ads
@@ -0,0 +1,7 @@
+with Generic_Inst6_G1;
+generic
+ with package G2 is new Generic_Inst6_G1 (<>);
+ with package G3 is new Generic_Inst6_G1 (<>);
+package Generic_Inst6_X is
+ Result : Integer := G2.Val * G3.Val;
+end;
