[Ada] Fix bogus "too late" error with nested generics and inlining

This prevents the compiler from issuing a bogus error about a constant
whose full declaration appears too late, if it is declared in a nested
generic package and instantiated in another nested instantiation, when
the instantiations are done in a unit withed from the main unit and
containing an inlined subprogram, and cross-unit inlining is enabled.

It turns out that, under these very peculiar conditions, the compiler
ends up instantiating the body of the generic package twice, which leads
to various semantic errors, in particular for declarations of constants.

2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* sem_ch12.adb (Instantiate_Package_Body): Check that the body
	has not already been instantiated when the body of the parent
	was being loaded.

gcc/testsuite/

	* gnat.dg/inline21.adb, gnat.dg/inline21_g.ads,
	gnat.dg/inline21_h.adb, gnat.dg/inline21_h.ads,
	gnat.dg/inline21_q.ads: New testcase.

From-SVN: r275953

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3d348b4..c10f7ff 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,11 @@
 2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * sem_ch12.adb (Instantiate_Package_Body): Check that the body
+       has not already been instantiated when the body of the parent
+       was being loaded.
+
+2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>
+
        * sem_util.adb (In_Instance): Test whether the current unit has
        been analyzed instead of being on the scope stack to detect the
        case of actuals of an instantiation of a generic child unit done

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 61a40eb..280c925 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -11442,6 +11442,68 @@ package body Sem_Ch12 is
          else
             Load_Parent_Of_Generic
               (Inst_Node, Specification (Gen_Decl), Body_Optional);
+
+            --  Surprisingly enough, loading the body of the parent can cause
+            --  the body to be instantiated and the double instantiation needs
+            --  to be prevented in order to avoid giving bogus semantic errors.
+
+            --  This case can occur because of the Collect_Previous_Instances
+            --  machinery of Load_Parent_Of_Generic, which will instantiate
+            --  bodies that are deemed to be ahead of the body of the parent
+            --  in the compilation unit. But the relative position of these
+            --  bodies is computed using the mere comparison of their Sloc.
+
+            --  Now suppose that you have two generic packages G and H, with
+            --  G containing a mere instantiation of H:
+
+            --    generic
+            --    package H is
+
+            --      generic
+            --      package Nested_G is
+            --         ...
+            --      end Nested_G;
+
+            --    end H;
+
+            --    with H;
+
+            --    generic
+            --    package G is
+
+            --      package My_H is new H;
+
+            --    end G;
+
+            --  and a third package Q instantiating G and Nested_G:
+
+            --    with G;
+
+            --    package Q is
+
+            --      package My_G is new G;
+
+            --      package My_Nested_G is new My_G.My_H.Nested_G;
+
+            --    end Q;
+
+            --  The body to be instantiated is that of My_Nested_G and its
+            --  parent is the instance My_G.My_H. This latter instantiation
+            --  is done when My_G is analyzed, i.e. after the declarations
+            --  of My_G and My_Nested_G have been parsed; as a result, the
+            --  Sloc of My_G.My_H is greater than the Sloc of My_Nested_G.
+
+            --  Therefore loading the body of My_G.My_H will cause the body
+            --  of My_Nested_G to be instantiated because it is deemed to be
+            --  ahead of My_G.My_H. This means that Load_Parent_Of_Generic
+            --  will again be invoked on My_G.My_H, but this time with the
+            --  Collect_Previous_Instances machinery disabled, so there is
+            --  no endless mutual recursion and things are done in order.
+
+            if Present (Corresponding_Body (Instance_Spec (Inst_Node))) then
+               goto Leave;
+            end if;
+
             Gen_Body_Id := Corresponding_Body (Gen_Decl);
          end if;
       end if;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f667897..c8eea78 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,11 @@
 2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gnat.dg/inline21.adb, gnat.dg/inline21_g.ads,
+       gnat.dg/inline21_h.adb, gnat.dg/inline21_h.ads,
+       gnat.dg/inline21_q.ads: New testcase.
+
+2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gnat.dg/inline20.adb, gnat.dg/inline20_g.adb,
        gnat.dg/inline20_g.ads, gnat.dg/inline20_h.ads,
        gnat.dg/inline20_i.ads, gnat.dg/inline20_q-io.ads,

diff --git a/gcc/testsuite/gnat.dg/inline21.adb b/gcc/testsuite/gnat.dg/inline21.adb
new file mode 100644 (file)
index 0000000..5df5691
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline21.adb
@@ -0,0 +1,9 @@
+--  { dg-compile }
+--  { dg-options "-O -gnatn" }
+
+with Inline21_Q;
+
+procedure Inline21 is
+begin
+  Inline21_Q.My_Nested_G.Proc;
+end;

diff --git a/gcc/testsuite/gnat.dg/inline21_g.ads b/gcc/testsuite/gnat.dg/inline21_g.ads
new file mode 100644 (file)
index 0000000..b4faf01
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline21_g.ads
@@ -0,0 +1,8 @@
+with Inline21_H;
+
+generic
+package Inline21_G is
+
+   package My_H is new Inline21_H;
+
+end Inline21_G;

diff --git a/gcc/testsuite/gnat.dg/inline21_h.adb b/gcc/testsuite/gnat.dg/inline21_h.adb
new file mode 100644 (file)
index 0000000..c6cf063
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline21_h.adb
@@ -0,0 +1,14 @@
+package body Inline21_H is
+
+   package body Nested_G is
+
+      C : constant Integer := 0;
+
+      procedure Proc is
+      begin
+         null;
+      end;
+
+   end Nested_G;
+
+end Inline21_H;
\ No newline at end of file

diff --git a/gcc/testsuite/gnat.dg/inline21_h.ads b/gcc/testsuite/gnat.dg/inline21_h.ads
new file mode 100644 (file)
index 0000000..494c544
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline21_h.ads
@@ -0,0 +1,10 @@
+generic
+package Inline21_H is
+
+   generic
+   package Nested_G is
+      procedure Proc;
+      pragma Inline (Proc);
+   end Nested_G;
+
+end Inline21_H;

diff --git a/gcc/testsuite/gnat.dg/inline21_q.ads b/gcc/testsuite/gnat.dg/inline21_q.ads
new file mode 100644 (file)
index 0000000..d3c2001
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline21_q.ads
@@ -0,0 +1,9 @@
+with Inline21_G;
+
+package Inline21_Q is
+
+   package My_G is new Inline21_G;
+
+   package My_Nested_G is new My_G.My_H.Nested_G;
+
+end Inline21_Q;