@@ -2304,12 +2304,48 @@ package body Sem_Ch13 is
if Nkind (Expr) = N_Aggregate then
- -- Component associations are not allowed in the
- -- aspect expression aggregate.
+ -- Component associations in the aggregate must be a
+ -- parameter name followed by a static boolean
+ -- expression.
if Present (Component_Associations (Expr)) then
- Error_Msg_N ("illegal aspect % expression", Expr);
- else
+ declare
+ Assoc : Node_Id :=
+ First (Component_Associations (Expr));
+ begin
+ while Present (Assoc) loop
+ if List_Length (Choices (Assoc)) = 1 then
+ Analyze_Relaxed_Parameter
+ (E, First (Choices (Assoc)), Seen);
+
+ if Inside_A_Generic then
+ Preanalyze_And_Resolve
+ (Expression (Assoc), Any_Boolean);
+ else
+ Analyze_And_Resolve
+ (Expression (Assoc), Any_Boolean);
+ end if;
+
+ if not Is_OK_Static_Expression
+ (Expression (Assoc))
+ then
+ Error_Msg_N
+ ("expression of aspect %" &
+ "must be static", Aspect);
+ end if;
+
+ else
+ Error_Msg_N
+ ("illegal aspect % expression", Expr);
+ end if;
+ Next (Assoc);
+ end loop;
+ end;
+ end if;
+
+ -- Expressions of the aggregate are parameter names
+
+ if Present (Expressions (Expr)) then
declare
Param : Node_Id := First (Expressions (Expr));
@@ -12525,6 +12525,7 @@ package body Sem_Util is
Subp_Id : Entity_Id;
Aspect_Expr : Node_Id;
Param_Expr : Node_Id;
+ Assoc : Node_Id;
begin
if Is_Formal (E) then
@@ -12538,13 +12539,30 @@ package body Sem_Util is
Find_Value_Of_Aspect
(Subp_Id, Aspect_Relaxed_Initialization);
- -- Aspect expression is either an aggregate, e.g.:
+ -- Aspect expression is either an aggregate with an optional
+ -- Boolean expression (which defaults to True), e.g.:
--
-- function F (X : Integer) return Integer
- -- with Relaxed_Initialization => (X, F'Result);
+ -- with Relaxed_Initialization => (X => True, F'Result);
if Nkind (Aspect_Expr) = N_Aggregate then
+ if Present (Component_Associations (Aspect_Expr)) then
+ Assoc := First (Component_Associations (Aspect_Expr));
+
+ while Present (Assoc) loop
+ if Denotes_Relaxed_Parameter
+ (First (Choices (Assoc)), E)
+ then
+ return
+ Is_True
+ (Static_Boolean (Expression (Assoc)));
+ end if;
+
+ Next (Assoc);
+ end loop;
+ end if;
+
Param_Expr := First (Expressions (Aspect_Expr));
while Present (Param_Expr) loop
@@ -1383,9 +1383,9 @@ package Sem_Util is
function Has_Relaxed_Initialization (E : Entity_Id) return Boolean;
-- Returns True iff entity E is subject to the Relaxed_Initialization
- -- aspect. Entity E can be either type, variable, constant, function,
- -- or abstract state. For private types and deferred constants E should
- -- be the private view, because aspect can only be attached there.
+ -- aspect. Entity E can be either type, variable, constant, subprogram,
+ -- entry or an abstract state. For private types and deferred constants
+ -- E should be the private view, because aspect can only be attached there.
function Has_Signed_Zeros (E : Entity_Id) return Boolean;
-- Determines if the floating-point type E supports signed zeros.