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 <schonb...@adacore.com> * 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