From: Eric Botcazou Date: Mon, 22 Jul 2019 13:57:37 +0000 (+0000) Subject: [Ada] Fix spurious visibility error for tagged type with inlining X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=116992570783944a12e64e63db9f5a2445e10016;p=gcc.git [Ada] Fix spurious visibility error for tagged type with inlining This fixes a spurious visibility error for the very peculiar case where an operator that operates on the class-wide type of a tagged type is declared in a package, the operator is renamed in another package where a subtype of the tagged type is declared, and both packages end up in the transititive closure of a unit compiled with optimization and inter-inlining (-gnatn). 2019-07-22 Eric Botcazou gcc/ada/ * sem_ch8.adb (End_Use_Type): Reset the In_Use flag on the class-wide type if the type is tagged. (Use_One_Type): Add commentary on the handling of the class-wide type. gcc/testsuite/ * gnat.dg/inline17.adb, gnat.dg/inline17_pkg1.adb, gnat.dg/inline17_pkg1.ads, gnat.dg/inline17_pkg2.ads, gnat.dg/inline17_pkg3.adb, gnat.dg/inline17_pkg3.ads: New testcase. From-SVN: r273683 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ace56e3bd82..06e6421c202 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-22 Eric Botcazou + + * sem_ch8.adb (End_Use_Type): Reset the In_Use flag on the + class-wide type if the type is tagged. + (Use_One_Type): Add commentary on the handling of the class-wide + type. + 2019-07-22 Eric Botcazou * einfo.ads (Is_For_Access_Subtype): Delete. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 9caddccf1e4..7185c40f68f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4836,6 +4836,13 @@ package body Sem_Ch8 is Set_In_Use (Base_Type (T), False); Set_Current_Use_Clause (T, Empty); Set_Current_Use_Clause (Base_Type (T), Empty); + + -- See Use_One_Type for the rationale. This is a bit on the naive + -- side, but should be good enough in practice. + + if Is_Tagged_Type (T) then + Set_In_Use (Class_Wide_Type (T), False); + end if; end if; end if; @@ -9985,7 +9992,10 @@ package body Sem_Ch8 is Set_In_Use (T); -- If T is tagged, primitive operators on class-wide operands are - -- also available. + -- also deemed available. Note that this is really necessary only + -- in semantics-only mode, because the primitive operators are not + -- fully constructed in this mode, but we do it in all modes for the + -- sake of uniformity, as this should not matter in practice. if Is_Tagged_Type (T) then Set_In_Use (Class_Wide_Type (T)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 94fc5796dea..0f8b798f0a5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2019-07-22 Eric Botcazou + + * gnat.dg/inline17.adb, gnat.dg/inline17_pkg1.adb, + gnat.dg/inline17_pkg1.ads, gnat.dg/inline17_pkg2.ads, + gnat.dg/inline17_pkg3.adb, gnat.dg/inline17_pkg3.ads: New + testcase. + 2019-07-22 Eric Botcazou * gnat.dg/iter5.adb, gnat.dg/iter5_pkg.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/inline17.adb b/gcc/testsuite/gnat.dg/inline17.adb new file mode 100644 index 00000000000..bb6e5c2563d --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline17.adb @@ -0,0 +1,10 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn" } +with Inline17_Pkg1; use Inline17_Pkg1; +with Inline17_Pkg2; use Inline17_Pkg2; + +procedure Inline17 is + use type SQL_Field; +begin + Test; +end; diff --git a/gcc/testsuite/gnat.dg/inline17_pkg1.adb b/gcc/testsuite/gnat.dg/inline17_pkg1.adb new file mode 100644 index 00000000000..80febe8be18 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline17_pkg1.adb @@ -0,0 +1,15 @@ +with Inline17_Pkg2; use Inline17_Pkg2; + +package body Inline17_Pkg1 is + + procedure Test is + begin + null; + end; + + function Get (Field : SQL_Field) return Integer is + begin + return +Field; + end; + +end Inline17_Pkg1; diff --git a/gcc/testsuite/gnat.dg/inline17_pkg1.ads b/gcc/testsuite/gnat.dg/inline17_pkg1.ads new file mode 100644 index 00000000000..78f26b160fb --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline17_pkg1.ads @@ -0,0 +1,7 @@ + +package Inline17_Pkg1 is + + procedure Test; + pragma Inline (Test); + +end Inline17_Pkg1; diff --git a/gcc/testsuite/gnat.dg/inline17_pkg2.ads b/gcc/testsuite/gnat.dg/inline17_pkg2.ads new file mode 100644 index 00000000000..bf89d5573ec --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline17_pkg2.ads @@ -0,0 +1,10 @@ +with Inline17_Pkg3; use Inline17_Pkg3; + +package Inline17_Pkg2 is + + subtype SQL_Field is Inline17_Pkg3.SQL_Field; + + function "+" (Field : SQL_Field'Class) return Integer renames + Inline17_Pkg3."+"; + +end Inline17_Pkg2; diff --git a/gcc/testsuite/gnat.dg/inline17_pkg3.adb b/gcc/testsuite/gnat.dg/inline17_pkg3.adb new file mode 100644 index 00000000000..411a509e83a --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline17_pkg3.adb @@ -0,0 +1,14 @@ + +package body Inline17_Pkg3 is + + function "+" (Field : SQL_Field'Class) return Integer is + begin + return 0; + end; + + function Unchecked_Get (Self : Ref) return Integer is + begin + return Self.Data; + end; + +end Inline17_Pkg3; diff --git a/gcc/testsuite/gnat.dg/inline17_pkg3.ads b/gcc/testsuite/gnat.dg/inline17_pkg3.ads new file mode 100644 index 00000000000..6f0c5a8e9df --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline17_pkg3.ads @@ -0,0 +1,16 @@ + +package Inline17_Pkg3 is + + type SQL_Field is tagged null record; + + function "+" (Field : SQL_Field'Class) return Integer; + + type Ref is record + Data : Integer; + end record; + + function Unchecked_Get (Self : Ref) return Integer with Inline_Always; + + function Get (Self : Ref) return Integer is (Unchecked_Get (Self)); + +end Inline17_Pkg3;