* sem_ch3.adb (Check_Or_Process_Discriminants): In Ada 2012, allow
limited tagged types to have defaulted discriminants. Customize the
error message for the Ada 2012 case.
(Process_Discriminants): In Ada 2012, allow limited tagged types to have
defaulted discriminants. Customize the error message for the Ada 2012
case.
* sem_ch6.adb (Create_Extra_Formals): Suppress creation of the extra
formal for out formals of discriminated types in the case where the
underlying type is a limited tagged type.
* exp_attr.adb (Expand_N_Attribute_Reference, case
Attribute_Constrained): Return True for 'Constrained when the
underlying type of the prefix is a limited tagged type.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165819
138bc75d-0d04-0410-961f-
82ee72b054a4
+2010-10-22 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch3.adb (Check_Or_Process_Discriminants): In Ada 2012, allow
+ limited tagged types to have defaulted discriminants. Customize the
+ error message for the Ada 2012 case.
+ (Process_Discriminants): In Ada 2012, allow limited tagged types to have
+ defaulted discriminants. Customize the error message for the Ada 2012
+ case.
+ * sem_ch6.adb (Create_Extra_Formals): Suppress creation of the extra
+ formal for out formals of discriminated types in the case where the
+ underlying type is a limited tagged type.
+ * exp_attr.adb (Expand_N_Attribute_Reference, case
+ Attribute_Constrained): Return True for 'Constrained when the
+ underlying type of the prefix is a limited tagged type.
+
2010-10-22 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb (Complete_Private_Subtype): The full view of the subtype
-- internally for passing to the Extra_Constrained parameter.
else
- Res := Is_Constrained (Underlying_Type (Etype (Ent)));
+ -- In Ada 2012, test for case of a limited tagged type, in
+ -- which case the attribute is always required to return
+ -- True. The underlying type is tested, to make sure we also
+ -- return True for cases where there is an unconstrained
+ -- object with an untagged limited partial view which has
+ -- defaulted discriminants (such objects always produce a
+ -- False in earlier versions of Ada). (Ada 2012: AI05-0214)
+
+ Res := Is_Constrained (Underlying_Type (Etype (Ent)))
+ or else
+ (Ada_Version >= Ada_2012
+ and then Is_Tagged_Type (Underlying_Type (Ptyp))
+ and then Is_Limited_Type (Ptyp));
end if;
- Rewrite (N,
- New_Reference_To (Boolean_Literals (Res), Loc));
+ Rewrite (N, New_Reference_To (Boolean_Literals (Res), Loc));
end;
-- Prefix is not an entity name. These are also cases where we can
-- always tell at compile time by looking at the form and type of the
-- prefix. If an explicit dereference of an object with constrained
- -- partial view, this is unconstrained (Ada 2005 AI-363).
+ -- partial view, this is unconstrained (Ada 2005: AI95-0363). If the
+ -- underlying type is a limited tagged type, then Constrained is
+ -- required to always return True (Ada 2012: AI05-0214).
else
Rewrite (N,
not Is_Variable (Pref)
or else
(Nkind (Pref) = N_Explicit_Dereference
- and then
- not Has_Constrained_Partial_View (Base_Type (Ptyp)))
- or else Is_Constrained (Underlying_Type (Ptyp))),
+ and then
+ not Has_Constrained_Partial_View (Base_Type (Ptyp)))
+ or else Is_Constrained (Underlying_Type (Ptyp))
+ or else (Ada_Version >= Ada_2012
+ and then Is_Tagged_Type (Underlying_Type (Ptyp))
+ and then Is_Limited_Type (Ptyp))),
Loc));
end if;
-- Handle the case where there is an untagged partial view and
-- the full view is tagged: must disallow discriminants with
- -- defaults. However suppress the error here if it was already
- -- reported on the default expression of the partial view.
+ -- defaults, unless compiling for Ada 2012, which allows a
+ -- limited tagged type to have defaulted discriminants (see
+ -- AI05-0214). However, suppress the error here if it was
+ -- already reported on the default expression of the partial
+ -- view.
if Is_Tagged_Type (T)
and then Present (Expression (Parent (D)))
+ and then (not Is_Limited_Type (Current_Scope)
+ or else Ada_Version < Ada_2012)
and then not Error_Posted (Expression (Parent (D)))
then
- Error_Msg_N
- ("discriminants of tagged type cannot have defaults",
- Expression (New_D));
+ if Ada_Version >= Ada_2012 then
+ Error_Msg_N
+ ("discriminants of nonlimited tagged type cannot have"
+ & " defaults",
+ Expression (New_D));
+ else
+ Error_Msg_N
+ ("discriminants of tagged type cannot have defaults",
+ Expression (New_D));
+ end if;
end if;
-- Ada 2005 (AI-230): Access discriminant allowed in
("discriminant defaults not allowed for formal type",
Expression (Discr));
+ -- Flag an error for a tagged type with defaulted discriminants,
+ -- excluding limited tagged types when compiling for Ada 2012
+ -- (see AI05-0214).
+
elsif Is_Tagged_Type (Current_Scope)
+ and then (not Is_Limited_Type (Current_Scope)
+ or else Ada_Version < Ada_2012)
and then Comes_From_Source (N)
then
-- Note: see similar test in Check_Or_Process_Discriminants, to
-- handle the (illegal) case of the completion of an untagged
-- view with discriminants with defaults by a tagged full view.
- -- We skip the check if Discr does not come from source to
+ -- We skip the check if Discr does not come from source, to
-- account for the case of an untagged derived type providing
- -- defaults for a renamed discriminant from a private nontagged
+ -- defaults for a renamed discriminant from a private untagged
-- ancestor with a tagged full view (ACATS B460006).
- Error_Msg_N
- ("discriminants of tagged type cannot have defaults",
- Expression (Discr));
+ if Ada_Version >= Ada_2012 then
+ Error_Msg_N
+ ("discriminants of nonlimited tagged type cannot have"
+ & " defaults",
+ Expression (Discr));
+ else
+ Error_Msg_N
+ ("discriminants of tagged type cannot have defaults",
+ Expression (Discr));
+ end if;
else
Default_Present := True;
Formal_Type := Underlying_Type (Formal_Type);
end if;
+ -- Suppress the extra formal if formal's subtype is constrained or
+ -- indefinite, or we're compiling for Ada 2012 and the underlying
+ -- type is tagged and limited. In Ada 2012, a limited tagged type
+ -- can have defaulted discriminants, but 'Constrained is required
+ -- to return True, so the formal is never needed (see AI05-0214).
+ -- Note that this ensures consistency of calling sequences for
+ -- dispatching operations when some types in a class have defaults
+ -- on discriminants and others do not (and requiring the extra
+ -- formal would introduce distributed overhead).
+
if Has_Discriminants (Formal_Type)
and then not Is_Constrained (Formal_Type)
and then not Is_Indefinite_Subtype (Formal_Type)
+ and then (Ada_Version < Ada_2012
+ or else
+ not (Is_Tagged_Type (Underlying_Type (Formal_Type))
+ and then Is_Limited_Type (Formal_Type)))
then
Set_Extra_Constrained
(Formal, Add_Extra_Formal (Formal, Standard_Boolean, E, "O"));
projects / platform / upstream / linaro-gcc.git / commitdiff