From: Eric Botcazou Date: Thu, 19 Sep 2019 08:14:28 +0000 (+0000) Subject: [Ada] Fix bogus "too late" error with nested generics and inlining X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d53301c91fe9cfffaa06880ea1e32a9fc9246709;p=gcc.git [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 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 3d348b4e36b..c10f7fffa79 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-09-19 Eric Botcazou + + * 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 * sem_util.adb (In_Instance): Test whether the current unit has diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 61a40ebcb94..280c9258e18 100644 --- 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 f667897bd33..c8eea78877b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-09-19 Eric Botcazou + + * 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 * gnat.dg/inline20.adb, gnat.dg/inline20_g.adb, diff --git a/gcc/testsuite/gnat.dg/inline21.adb b/gcc/testsuite/gnat.dg/inline21.adb new file mode 100644 index 00000000000..5df569158eb --- /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 index 00000000000..b4faf013073 --- /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 index 00000000000..c6cf063c2b3 --- /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 index 00000000000..494c54425f4 --- /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 index 00000000000..d3c20013a92 --- /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;