From: Bob Duff Date: Mon, 26 Oct 2015 12:05:58 +0000 (+0000) Subject: s-rident.ads (No_Dynamic_Sized_Objects): New restriction name. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2f7ae2aa904ddd130485196be47193a1f9ca54c1;p=gcc.git s-rident.ads (No_Dynamic_Sized_Objects): New restriction name. 2015-10-26 Bob Duff * s-rident.ads (No_Dynamic_Sized_Objects): New restriction name. * sem_util.ads, sem_util.adb (All_Composite_Constraints_Static): New function to check that all relevant constraints are static. * sem_aggr.adb (Resolve_Array_Aggregate): Call All_Composite_Constraints_Static on the bounds of named array aggregates. * sem_ch3.adb (Analyze_Subtype_Declaration): Call All_Composite_Constraints_Static if the type is composite and the subtype is constrained. From-SVN: r229351 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1da9491fcb4..47f60b5201b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2015-10-26 Bob Duff + + * s-rident.ads (No_Dynamic_Sized_Objects): New restriction name. + * sem_util.ads, sem_util.adb (All_Composite_Constraints_Static): + New function to check that all relevant constraints are static. + * sem_aggr.adb (Resolve_Array_Aggregate): Call + All_Composite_Constraints_Static on the bounds of named array + aggregates. + * sem_ch3.adb (Analyze_Subtype_Declaration): Call + All_Composite_Constraints_Static if the type is composite and + the subtype is constrained. + 2015-10-26 Javier Miranda * exp_ch6.adb (Expand_N_Subprogram_Declaration): Skip the frontend diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 4fd71eb9bad..446ddb9f412 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -171,6 +171,7 @@ package System.Rident is -- units, it applies to all units in this extended main source. Immediate_Reclamation, -- (RM H.4(10)) + No_Dynamic_Sized_Objects, -- GNAT No_Implementation_Aspect_Specifications, -- Ada 2012 AI-241 No_Implementation_Attributes, -- Ada 2005 AI-257 No_Implementation_Identifiers, -- Ada 2012 AI-246 diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 44d89f5edf8..60cd1319872 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -42,6 +42,7 @@ with Nmake; use Nmake; with Nlists; use Nlists; with Opt; use Opt; with Restrict; use Restrict; +with Rident; use Rident; with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Cat; use Sem_Cat; @@ -1967,6 +1968,14 @@ package body Sem_Aggr is return Failure; end if; + if not (All_Composite_Constraints_Static (Low) + and then All_Composite_Constraints_Static (High) + and then All_Composite_Constraints_Static (S_Low) + and then All_Composite_Constraints_Static (S_High)) + then + Check_Restriction (No_Dynamic_Sized_Objects, Choice); + end if; + Nb_Discrete_Choices := Nb_Discrete_Choices + 1; Table (Nb_Discrete_Choices).Lo := Low; Table (Nb_Discrete_Choices).Hi := High; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e1eadd19d52..be4373678f3 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5227,6 +5227,31 @@ package body Sem_Ch3 is end if; Analyze_Dimension (N); + + -- Check No_Dynamic_Sized_Objects restriction, which disallows subtype + -- indications on composite types where the constraints are dynamic. + -- Note that object declarations and aggregates generate implicit + -- subtype declarations, which this covers. One special case is that the + -- implicitly generated "=" for discriminated types includes an + -- offending subtype declaration, which is harmless, so we ignore it + -- here. + + if Nkind (Subtype_Indication (N)) = N_Subtype_Indication then + declare + Cstr : constant Node_Id := Constraint (Subtype_Indication (N)); + begin + if Nkind (Cstr) = N_Index_Or_Discriminant_Constraint + and then not (Is_Internal (Defining_Identifier (N)) + and then Is_TSS (Scope (Defining_Identifier (N)), + TSS_Composite_Equality)) + and then not Within_Init_Proc + then + if not All_Composite_Constraints_Static (Cstr) then + Check_Restriction (No_Dynamic_Sized_Objects, Cstr); + end if; + end if; + end; + end if; end Analyze_Subtype_Declaration; -------------------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index cf7c57e3c01..f27b855437e 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -434,6 +434,77 @@ package body Sem_Util is return Alignment (E) * System_Storage_Unit; end Alignment_In_Bits; + -------------------------------------- + -- All_Composite_Constraints_Static -- + -------------------------------------- + + function All_Composite_Constraints_Static + (Constr : Node_Id) return Boolean + is + begin + if No (Constr) or else Error_Posted (Constr) then + return True; + end if; + + case Nkind (Constr) is + when N_Subexpr => + if Nkind (Constr) in N_Has_Entity + and then Present (Entity (Constr)) + then + if Is_Type (Entity (Constr)) then + return not Is_Discrete_Type (Entity (Constr)) + or else Is_OK_Static_Subtype (Entity (Constr)); + end if; + + elsif Nkind (Constr) = N_Range then + return Is_OK_Static_Expression (Low_Bound (Constr)) + and then Is_OK_Static_Expression (High_Bound (Constr)); + + elsif Nkind (Constr) = N_Attribute_Reference + and then Attribute_Name (Constr) = Name_Range + then + return Is_OK_Static_Expression + (Type_Low_Bound (Etype (Prefix (Constr)))) + and then Is_OK_Static_Expression + (Type_High_Bound (Etype (Prefix (Constr)))); + end if; + + return not Present (Etype (Constr)) -- previous error + or else not Is_Discrete_Type (Etype (Constr)) + or else Is_OK_Static_Expression (Constr); + + when N_Discriminant_Association => + return All_Composite_Constraints_Static (Expression (Constr)); + + when N_Range_Constraint => + return All_Composite_Constraints_Static + (Range_Expression (Constr)); + + when N_Index_Or_Discriminant_Constraint => + declare + One_Cstr : Entity_Id; + begin + One_Cstr := First (Constraints (Constr)); + while Present (One_Cstr) loop + if not All_Composite_Constraints_Static (One_Cstr) then + return False; + end if; + + Next (One_Cstr); + end loop; + end; + + return True; + + when N_Subtype_Indication => + return All_Composite_Constraints_Static (Subtype_Mark (Constr)) + and then All_Composite_Constraints_Static (Constraint (Constr)); + + when others => + raise Program_Error; + end case; + end All_Composite_Constraints_Static; + --------------------------------- -- Append_Inherited_Subprogram -- --------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 570ecf80d35..c68eb086b5a 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -85,6 +85,19 @@ package Sem_Util is -- Otherwise Uint_0 is returned, indicating that the alignment of the -- entity is not yet known to the compiler. + function All_Composite_Constraints_Static (Constr : Node_Id) return Boolean; + -- Used to implement pragma Restrictions (No_Dynamic_Sized_Objects). + -- Given a constraint or subtree of a constraint on a composite + -- subtype/object, returns True if there are no nonstatic constraints, + -- which might cause objects to be created with dynamic size. + -- Called for subtype declarations (including implicit ones created for + -- subtype indications in object declarations, as well as discriminated + -- record aggregate cases). For record aggregates, only records containing + -- discriminant-dependent arrays matter, because the discriminants must be + -- static when governing a variant part. Access discriminants are + -- irrelevant. Also called for array aggregates, but only named notation, + -- because those are the only dynamic cases. + procedure Append_Inherited_Subprogram (S : Entity_Id); -- If the parent of the operation is declared in the visible part of -- the current scope, the inherited operation is visible even though the