[Ada] Allow boolean expressions in aspect Relaxed_Initialization

gcc/ada/

	* sem_ch13.adb (Analyze_Aspect_Relaxed_Initialization): Analyze
	optional boolean expressions.
	* sem_util.ads, sem_util.adb (Has_Relaxed_Initialization): Adapt
	query; update comment.

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 4c8c650b427984001948d0639727e4b565ed4e1c..476503c2e78938ef09669f8f4445b902118ffe1d 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -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));
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 2c9e274478e794007962a868198d071b50e49d6c..7751be7b9db312decf7695608405334d368bcd5c 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index fc8177c838517cd6d41512d5e23643e87b4ae81b..817af3baa61b62946920c3d2a20e3335a0fda36e 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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.