From 530b30d9b3c2b60a5dfc8b3323b886ef5fed41a1 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 18 May 2020 18:46:49 +0200 Subject: [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. --- gcc/ada/sem_ch13.adb | 44 ++++++++++++++++++++++++++++++++++++++++---- gcc/ada/sem_util.adb | 22 ++++++++++++++++++++-- gcc/ada/sem_util.ads | 6 +++--- 3 files changed, 63 insertions(+), 9 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 4c8c650..476503c 100644 --- 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 2c9e274..7751be7 100644 --- 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 fc8177c..817af3b 100644 --- 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. -- cgit v1.1