* [Ada] Fix spurious visibility error for tagged type with inlining
@ 2019-07-22 14:16 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2019-07-22 14:16 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 854 bytes --]
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).
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
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.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 3122 bytes --]
--- gcc/ada/sem_ch8.adb
+++ 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));
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/inline17_pkg1.ads
@@ -0,0 +1,7 @@
+
+package Inline17_Pkg1 is
+
+ procedure Test;
+ pragma Inline (Test);
+
+end Inline17_Pkg1;
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2019-07-22 14:02 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-07-22 14:16 [Ada] Fix spurious visibility error for tagged type with inlining Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).