When the Class attribute is applied in one package that has a limited view of
a tagged type with an untagged incomplete type in its own package, then when
another unit with a nonlimited with clause for the type's package is compiled,
the compiler issues an error complaining that the prefix must be tagged. The
Available_View of the type must be tested as a condition for issuing this error.
The following test must compile quietly:
gcc -c -gnat05 ltd_with_class_attr_bug.ads
--
package Pkg1 is
type Typ;
type Ref is access all Typ'Class;
type Typ is tagged null record;
end Pkg1;
package Pkg2 is
type Typ;
type Ref is access all Typ'Class;
type Typ is tagged null record;
end Pkg2;
limited with Pkg1;
limited with Pkg2;
package Pkg_Ltd_With is
procedure Proc1 (X : access Pkg1.Typ'Class);
procedure Proc2 (Y : Pkg1.Typ'Class);
procedure Proc3 (X : access Pkg2.Typ'Class);
procedure Proc4 (Y : Pkg2.Typ'Class);
end Pkg_Ltd_With;
with Pkg1;
with Pkg_Ltd_With;
package Ltd_With_Class_Attr_Bug is
end Ltd_With_Class_Attr_Bug;
--
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-12-20 Gary Dismukes <dismu...@adacore.com>
* sem_ch8.adb (Find_Type): Test taggedness
of the Available_Type when checking for an illegal use of an
incomplete type, when the incomplete view is a limited view of
a type. Remove redundant Is_Tagged test.
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 182532)
+++ sem_ch8.adb (working copy)
@@ -6119,10 +6119,16 @@
-- is completed in the current scope, and not for a limited
-- view of a type.
- if not Is_Tagged_Type (T)
- and then Ada_Version >= Ada_2005
- then
- if From_With_Type (T) then
+ if Ada_Version >= Ada_2005 then
+
+ -- Test whether the Available_View of a limited type view
+ -- is tagged, since the limited view may not be marked as
+ -- tagged if the type itself has an untagged incomplete
+ -- type view in its package.
+
+ if From_With_Type (T)
+ and then not Is_Tagged_Type (Available_View (T))
+ then
Error_Msg_N
("prefix of Class attribute must be tagged", N);
Set_Etype (N, Any_Type);
