[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  <ebotcazou@adacore.com>

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a204c285d4c91cb797b0a7eeb8bb669c3d8ab0c9..3d348b4e36b99b4478cc21eda838002393ab3f40 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+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
+       as a compilation unit.
+
 2019-09-19  Dmitriy Anisimkov  <anisimko@adacore.com>
 
        * libgnat/g-socket.ads, libgnat/g-socket.adb

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b276fd2bb897a90711700d37eb857df72e66ea21..95699199e3febd94c6beb9786a2eac3adac57c01 100644 (file)
--- 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 a3534f1442f7fb0504df947262c60f84eb0137be..f667897bd33bf8c345cc0053be0bb0daec2a0d3b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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,
+       gnat.dg/inline20_q.ads, gnat.dg/inline20_r.ads: New testcase.
+
 2019-09-19  Ed Schonberg  <schonberg@adacore.com>
 
        * 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 (file)
index 0000000..dde9a53
--- /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 (file)
index 0000000..dbae596
--- /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 (file)
index 0000000..adf2df6
--- /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 (file)
index 0000000..5937798
--- /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 (file)
index 0000000..d946375
--- /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 (file)
index 0000000..8e81887
--- /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 (file)
index 0000000..08c81cd
--- /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 (file)
index 0000000..4b96f75
--- /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;