From 3ba1a9eb6ec22706bdb084db2f1ab31a32d4dde8 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 2 May 2016 11:08:44 +0200 Subject: [multiple changes] 2016-05-02 Ed Schonberg * sem_ch4.adb (Analyze_Allocator): If the expression does not have a subtype indication and the type is an unconstrained tagged type with defaulted discriminants, create an explicit constraint for it during analysis to prevent out-of-order freezing actions on generated classwide types. 2016-05-02 Javier Miranda * exp_ch5.adb (Expand_N_Assignment_Statement): In the runtime check that ensures that the tags of source an target match, add missing displacement of the pointer to the objects if they cover interface types. 2016-05-02 Ed Schonberg * sem_attr.adb (Analyze_Attribute, case 'Old): Do not use base type for attribute when type is discrete: transformation is not needed for such types, and leads to spurious errors if the context is a case construct. From-SVN: r235709 --- gcc/ada/sem_ch4.adb | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) (limited to 'gcc/ada/sem_ch4.adb') diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 719e4ed..9982708 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -583,6 +583,45 @@ package body Sem_Ch4 is -- so that the bounds of the subtype indication are attached to -- the tree in case the allocator is inside a generic unit. + -- Finally, if there is no subtype indication and the type is + -- a tagged unconstrained type with discriminants, the designated + -- object is constrained by their default values, and it is + -- simplest to introduce an explicit constraint now. In some cases + -- this is done during expansion, but freeze actions are certain + -- to be emitted in the proper order if constraint is explicit. + + if Is_Entity_Name (E) and then Expander_Active then + Find_Type (E); + Type_Id := Entity (E); + + if Is_Tagged_Type (Type_Id) + and then Has_Discriminants (Type_Id) + and then not Is_Constrained (Type_Id) + and then Present + (Discriminant_Default_Value (First_Discriminant (Type_Id))) + then + declare + Loc : constant Source_Ptr := Sloc (E); + Discr : Entity_Id := First_Discriminant (Type_Id); + Constr : constant List_Id := New_List; + + begin + if Present (Discriminant_Default_Value (Discr)) then + while Present (Discr) loop + Append (Discriminant_Default_Value (Discr), Constr); + Next_Discriminant (Discr); + end loop; + + Rewrite (E, Make_Subtype_Indication (Loc, + Subtype_Mark => New_Occurrence_Of (Type_Id, Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constr))); + end if; + end; + end if; + end if; + if Nkind (E) = N_Subtype_Indication then -- A constraint is only allowed for a composite type in Ada -- cgit v1.1