A class-wide type has anonymous discriminants, because type extensions can
add discriminants at will. A constraint on a class-wide type is thus a partial
constraint that applies only to the known discriminants of the root type. Such
a partial constraint is a language pathology that the ARG has decided not to
test. This patch simply discards such a constraint on an access type, so that
the designated type includes all (unconstrained) extensions of the root type.
The following must compile with the warning:
volumes.ads:9:24: warning: constraint on class-wide type ignored
---
package Volumes is
type VolumeWidgetType (Stereo : boolean) is tagged
record
IsStereo : boolean := Stereo;
end record;
type VolumeWidget is access all VolumeWidgetType'Class;
Mic1 : VolumeWidget (Stereo => False);
end Volumes;
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-09-10 Ed Schonberg <[email protected]>
* sem_ch3.adb (Process_Subtype): Discard constraint on access
to class-wide type. Such constraints are not supported and are
considered a language pathology.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 202461)
+++ sem_ch3.adb (working copy)
@@ -19043,6 +19043,27 @@
case Ekind (Base_Type (Subtype_Mark_Id)) is
when Access_Kind =>
+
+ -- If this is a constraint on a class-wide type, discard it.
+ -- There is currently no way to express a partial discriminant
+ -- constraint on a type with unknown discriminants. This is
+ -- a pathology that the ACATS wisely decides not to test.
+
+ if Is_Class_Wide_Type (Designated_Type (Subtype_Mark_Id)) then
+ if Comes_From_Source (S) then
+ Error_Msg_N
+ ("constraint on class-wide type ignored?",
+ Constraint (S));
+ end if;
+
+ if Nkind (P) = N_Subtype_Declaration then
+ Set_Subtype_Indication (P,
+ New_Occurrence_Of (Subtype_Mark_Id, Sloc (S)));
+ end if;
+
+ return Subtype_Mark_Id;
+ end if;
+
Constrain_Access (Def_Id, S, Related_Nod);
if Expander_Active
