[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 <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
This commit is contained in:
parent
ff9d220ede
commit
1169925707
@ -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.
|
||||
|
@ -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));
|
||||
|
@ -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.
|
||||
|
10
gcc/testsuite/gnat.dg/inline17.adb
Normal file
10
gcc/testsuite/gnat.dg/inline17.adb
Normal file
@ -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;
|
15
gcc/testsuite/gnat.dg/inline17_pkg1.adb
Normal file
15
gcc/testsuite/gnat.dg/inline17_pkg1.adb
Normal file
@ -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;
|
7
gcc/testsuite/gnat.dg/inline17_pkg1.ads
Normal file
7
gcc/testsuite/gnat.dg/inline17_pkg1.ads
Normal file
@ -0,0 +1,7 @@
|
||||
|
||||
package Inline17_Pkg1 is
|
||||
|
||||
procedure Test;
|
||||
pragma Inline (Test);
|
||||
|
||||
end Inline17_Pkg1;
|
10
gcc/testsuite/gnat.dg/inline17_pkg2.ads
Normal file
10
gcc/testsuite/gnat.dg/inline17_pkg2.ads
Normal file
@ -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;
|
14
gcc/testsuite/gnat.dg/inline17_pkg3.adb
Normal file
14
gcc/testsuite/gnat.dg/inline17_pkg3.adb
Normal file
@ -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;
|
16
gcc/testsuite/gnat.dg/inline17_pkg3.ads
Normal file
16
gcc/testsuite/gnat.dg/inline17_pkg3.ads
Normal file
@ -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;
|
Loading…
x
Reference in New Issue
Block a user