+2015-10-26 Bob Duff <duff@adacore.com>
+
+ * 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 <miranda@adacore.com>
* exp_ch6.adb (Expand_N_Subprogram_Declaration): Skip the frontend
-- 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
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;
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;
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;
--------------------------------
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 --
---------------------------------
-- 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
projects / gcc.git / commitdiff