[Ada] Fix spurious visibility error for tagged type with inlining
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 22 Jul 2019 13:57:37 +0000 (13:57 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Mon, 22 Jul 2019 13:57:37 +0000 (13:57 +0000)
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  <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.

From-SVN: r273683

gcc/ada/ChangeLog
gcc/ada/sem_ch8.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/inline17.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/inline17_pkg1.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/inline17_pkg1.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/inline17_pkg2.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/inline17_pkg3.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/inline17_pkg3.ads [new file with mode: 0644]

index ace56e3bd82f8f45a86d8ec90eda92ad0f1f0675..06e6421c20234f079fe61b9d2fe5acd869822b35 100644 (file)
@@ -1,3 +1,10 @@
+2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * 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  <ebotcazou@adacore.com>
 
        * einfo.ads (Is_For_Access_Subtype): Delete.
index 9caddccf1e47ec43ec9e5a3e7f152866293056b7..7185c40f68fc964c01d054791387484bbc8b206b 100644 (file)
@@ -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));
index 94fc5796deaef6c38dc2274e53a63945a4ad69c3..0f8b798f0a58ebda8b469537c888fba0280d41b4 100644 (file)
@@ -1,3 +1,10 @@
+2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * 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  <ebotcazou@adacore.com>
 
        * 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 (file)
index 0000000..bb6e5c2
--- /dev/null
@@ -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 (file)
index 0000000..80febe8
--- /dev/null
@@ -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 (file)
index 0000000..78f26b1
--- /dev/null
@@ -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 (file)
index 0000000..bf89d55
--- /dev/null
@@ -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 (file)
index 0000000..411a509
--- /dev/null
@@ -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 (file)
index 0000000..6f0c5a8
--- /dev/null
@@ -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;