diff mbox series

[Ada] Fix bogus visibility error with nested generics and inlining

Message ID 20190919132819.GA41865@adacore.com
State New
Headers show
Series [Ada] Fix bogus visibility error with nested generics and inlining | expand

Commit Message

Pierre-Marie de Rodat Sept. 19, 2019, 1:28 p.m. UTC 
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.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.
diff mbox series

Patch

--- gcc/ada/sem_util.adb
+++ 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

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/inline20_q-io.ads
@@ -0,0 +1 @@ 
+package Inline20_Q.IO is new Inline20_Q.Generic_IO;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/inline20_q.ads
@@ -0,0 +1,3 @@ 
+with Inline20_I;
+
+package Inline20_Q is new Inline20_I;

--- /dev/null
new file mode 100644
+++ 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;