From: charlet Date: Fri, 22 Oct 2010 10:28:52 +0000 (+0000) Subject: 2010-10-22 Gary Dismukes X-Git-Tag: upstream/4.9.2~25529 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=e8b5ac674b44d769c4aaea6560e0ab345f5efc88;p=platform%2Fupstream%2Flinaro-gcc.git 2010-10-22 Gary Dismukes * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ca316fd..8028ecb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2010-10-22 Gary Dismukes + + * 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 * sem_ch3.adb (Complete_Private_Subtype): The full view of the subtype diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 9b0d3b7..3f47a30 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1644,17 +1644,30 @@ package body Exp_Attr is -- 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, @@ -1663,9 +1676,12 @@ package body Exp_Attr is 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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0c82011..5322387 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -9639,16 +9639,28 @@ package body Sem_Ch3 is -- 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 @@ -16442,20 +16454,33 @@ package body Sem_Ch3 is ("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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 98cb237..a4d65d8 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -5697,9 +5697,23 @@ package body Sem_Ch6 is 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"));