[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
This commit is contained in:
Eric Botcazou 2019-09-19 08:14:23 +00:00 committed by Pierre-Marie de Rodat
parent fd0d7b4e3b
commit 9e0746fcd5
11 changed files with 112 additions and 3 deletions

View File

@ -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

View File

@ -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

View File

@ -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,

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -0,0 +1 @@
package Inline20_Q.IO is new Inline20_Q.Generic_IO;

View File

@ -0,0 +1,3 @@
with Inline20_I;
package Inline20_Q is new Inline20_I;

View File

@ -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;