diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 62 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/inline21.adb | 9 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/inline21_g.ads | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/inline21_h.adb | 14 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/inline21_h.ads | 10 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/inline21_q.ads | 9 |
8 files changed, 124 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3d348b4..c10f7ff 100644 --- 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 --- 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 --- 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 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 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 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 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 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; |