[Ada] Spurious error when instance of generic is used as formal package

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.

2019-07-09  Ed Schonberg  <schonberg@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.

From-SVN: r273275

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b74910d..c80c9e4 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2019-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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.
+
 2019-07-09  Yannick Moy  <moy@adacore.com>
 
        * freeze.adb (Build_Renamed_Body): Do not set body to inline in

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 0df4d96..9afa095 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2941e43..af4a009 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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.
+
 2019-07-08  Martin Sebor  <msebor@redhat.com>
 
        PR middle-end/71924

diff --git a/gcc/testsuite/gnat.dg/generic_inst5.adb b/gcc/testsuite/gnat.dg/generic_inst5.adb
new file mode 100644 (file)
index 0000000..25e92f0
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/generic_inst6.adb b/gcc/testsuite/gnat.dg/generic_inst6.adb
new file mode 100644 (file)
index 0000000..780fae9
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/generic_inst6_g1-c.adb b/gcc/testsuite/gnat.dg/generic_inst6_g1-c.adb
new file mode 100644 (file)
index 0000000..ed671f1
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/generic_inst6_g1-c.ads b/gcc/testsuite/gnat.dg/generic_inst6_g1-c.ads
new file mode 100644 (file)
index 0000000..c00d19d
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/generic_inst6_g1.ads b/gcc/testsuite/gnat.dg/generic_inst6_g1.ads
new file mode 100644 (file)
index 0000000..9beeb21
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_inst6_g1.ads
@@ -0,0 +1,3 @@
+generic package Generic_Inst6_G1 is
+    Val : Integer := 7;
+ end;

diff --git a/gcc/testsuite/gnat.dg/generic_inst6_i1.ads b/gcc/testsuite/gnat.dg/generic_inst6_i1.ads
new file mode 100644 (file)
index 0000000..016dfb7
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/generic_inst6_i2.ads b/gcc/testsuite/gnat.dg/generic_inst6_i2.ads
new file mode 100644 (file)
index 0000000..03abe22
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/generic_inst6_x.ads b/gcc/testsuite/gnat.dg/generic_inst6_x.ads
new file mode 100644 (file)
index 0000000..657dc41
--- /dev/null
+++ b/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;