From 9e0746fcd5bb14d164d3686b0940ae7129d05231 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 19 Sep 2019 08:14:23 +0000 Subject: [PATCH] [Ada] Fix bogus visibility error with nested generics and inlining This prevents the compiler from issuing a bogus error about the visibility of an operator in an instantiation of a nested generic package which is itself used as an actual of an instantiation of another generic package, when the instantiations are done in a unit withed from the main unit and containing an inlined subprogram, and cross-unit inlining is enabled. In most cases, the compiler does not check the visibility of operators in an instantiation context because this has already been done when the generic package has been analyzed. However, there are exceptions like the actuals of an instantiation of a generic child unit which is done as a compilation unit and the In_Instance predicate has a special check for these cases. This check would incorrectly trigger here and needs to be tightened. 2019-09-19 Eric Botcazou gcc/ada/ * 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 as a compilation unit. gcc/testsuite/ * 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, gnat.dg/inline20_q.ads, gnat.dg/inline20_r.ads: New testcase. From-SVN: r275952 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_util.adb | 6 +++--- gcc/testsuite/ChangeLog | 7 +++++++ gcc/testsuite/gnat.dg/inline20.adb | 9 +++++++++ gcc/testsuite/gnat.dg/inline20_g.adb | 18 ++++++++++++++++++ gcc/testsuite/gnat.dg/inline20_g.ads | 18 ++++++++++++++++++ gcc/testsuite/gnat.dg/inline20_h.ads | 15 +++++++++++++++ gcc/testsuite/gnat.dg/inline20_i.ads | 19 +++++++++++++++++++ gcc/testsuite/gnat.dg/inline20_q-io.ads | 1 + gcc/testsuite/gnat.dg/inline20_q.ads | 3 +++ gcc/testsuite/gnat.dg/inline20_r.ads | 12 ++++++++++++ 11 files changed, 112 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/inline20.adb create mode 100644 gcc/testsuite/gnat.dg/inline20_g.adb create mode 100644 gcc/testsuite/gnat.dg/inline20_g.ads create mode 100644 gcc/testsuite/gnat.dg/inline20_h.ads create mode 100644 gcc/testsuite/gnat.dg/inline20_i.ads create mode 100644 gcc/testsuite/gnat.dg/inline20_q-io.ads create mode 100644 gcc/testsuite/gnat.dg/inline20_q.ads create mode 100644 gcc/testsuite/gnat.dg/inline20_r.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a204c285d4c..3d348b4e36b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-09-19 Eric Botcazou + + * 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 + as a compilation unit. + 2019-09-19 Dmitriy Anisimkov * libgnat/g-socket.ads, libgnat/g-socket.adb diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b276fd2bb89..95699199e3f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12380,15 +12380,15 @@ package body Sem_Util is if Is_Generic_Instance (S) then -- A child instance is always compiled in the context of a parent - -- instance. Nevertheless, the actuals are not analyzed in an + -- instance. Nevertheless, its actuals must not be analyzed in an -- instance context. We detect this case by examining the current -- compilation unit, which must be a child instance, and checking - -- that it is not currently on the scope stack. + -- that it has not been analyzed yet. if Is_Child_Unit (Curr_Unit) and then Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Instantiation - and then not In_Open_Scopes (Curr_Unit) + and then Ekind (Curr_Unit) = E_Void then return False; else diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a3534f1442f..f667897bd33 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2019-09-19 Eric Botcazou + + * 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, + gnat.dg/inline20_q.ads, gnat.dg/inline20_r.ads: New testcase. + 2019-09-19 Ed Schonberg * gnat.dg/generic2-child.ads, gnat.dg/generic2-io_any.adb, diff --git a/gcc/testsuite/gnat.dg/inline20.adb b/gcc/testsuite/gnat.dg/inline20.adb new file mode 100644 index 00000000000..dde9a539faa --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline20.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn2" } +with Inline20_Q.IO; +with Inline20_R; + +procedure Inline20 is +begin + Inline20_R.Log (Inline20_Q.IO.F); +end; diff --git a/gcc/testsuite/gnat.dg/inline20_g.adb b/gcc/testsuite/gnat.dg/inline20_g.adb new file mode 100644 index 00000000000..dbae5962a1e --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline20_g.adb @@ -0,0 +1,18 @@ +with Ada.Streams; use Ada.Streams; + +package body Inline20_G is + + package body Nested_G is + + procedure Get (Data : T; Into : out Offset_Type) is + begin + Into := (T'Descriptor_Size + Data'Size) / Standard'Storage_Unit; + end; + + function F return Integer is + begin + return 0; + end; + end Nested_G; + +end Inline20_G; diff --git a/gcc/testsuite/gnat.dg/inline20_g.ads b/gcc/testsuite/gnat.dg/inline20_g.ads new file mode 100644 index 00000000000..adf2df6914f --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline20_g.ads @@ -0,0 +1,18 @@ +with Ada.Streams; + +generic +package Inline20_G is + + subtype Offset_Type is Ada.Streams.Stream_Element_Offset; + + generic + type T is private; + package Nested_G is + + procedure Get (Data : T; Into : out Offset_Type); + + function F return Integer with Inline; + + end Nested_G; + +end Inline20_G; diff --git a/gcc/testsuite/gnat.dg/inline20_h.ads b/gcc/testsuite/gnat.dg/inline20_h.ads new file mode 100644 index 00000000000..59377986e25 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline20_h.ads @@ -0,0 +1,15 @@ +with Inline20_G; + +generic + with package Msg is new Inline20_G (<>); +package Inline20_H is + + generic + type T is private; + with function Image (Data : T) return String; + package Nested_H is + package My_Nested_G is new Msg.Nested_G (T); + function F return Integer renames My_Nested_G.F; + end Nested_H; + +end Inline20_H; diff --git a/gcc/testsuite/gnat.dg/inline20_i.ads b/gcc/testsuite/gnat.dg/inline20_i.ads new file mode 100644 index 00000000000..d946375388e --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline20_i.ads @@ -0,0 +1,19 @@ +with Inline20_R; + +generic +package Inline20_I is + + type Rec is null record; + + generic + package Generic_IO is + + function Image (Quote : Rec) return String; + + package My_Nested_H is new Inline20_R.My_H.Nested_H (Rec, Image); + + function F return Integer renames My_Nested_H.F; + + end Generic_IO; + +end Inline20_I; \ No newline at end of file diff --git a/gcc/testsuite/gnat.dg/inline20_q-io.ads b/gcc/testsuite/gnat.dg/inline20_q-io.ads new file mode 100644 index 00000000000..8e8188733ed --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline20_q-io.ads @@ -0,0 +1 @@ +package Inline20_Q.IO is new Inline20_Q.Generic_IO; diff --git a/gcc/testsuite/gnat.dg/inline20_q.ads b/gcc/testsuite/gnat.dg/inline20_q.ads new file mode 100644 index 00000000000..08c81cde0a5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline20_q.ads @@ -0,0 +1,3 @@ +with Inline20_I; + +package Inline20_Q is new Inline20_I; diff --git a/gcc/testsuite/gnat.dg/inline20_r.ads b/gcc/testsuite/gnat.dg/inline20_r.ads new file mode 100644 index 00000000000..4b96f751d20 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline20_r.ads @@ -0,0 +1,12 @@ +with Inline20_G; +with Inline20_H; + +package Inline20_R is + + package My_G is new Inline20_G; + + package My_H is new Inline20_H (My_G); + + procedure Log (I : Integer); + +end Inline20_R; -- 2.30.2