https://gcc.gnu.org/g:5cdc41c0893c374038f28a9f709ff6bac52a8c67
commit r17-4571-g5cdc41c0893c374038f28a9f709ff6bac52a8c67 Author: Eric Botcazou <[email protected]> Date: Tue Sep 22 19:46:03 2026 +0200 Ada: Implement 3.10.2(9.1) accessibility rule in Accessibility package This is the rule giving the accessibility level of a conditional expression. It is implemented only in a few contexts and for anonymous access types, and the implementation is scattered over several places. This replaces it with a centralized implementation handling both static and dynamic levels, fixing the anonymous access discriminant case in the process. gcc/ada/ * accessibility.ads (Needs_Accessibility_Level_Temp_Or_Check): Delete. * accessibility.adb: Add clauses for Sem_Eval. (Accessibility_Level): Add support for conditional expressions. (Needs_Accessibility_Level_Temp_Or_Check): Delete. * exp_ch4.adb (Expand_N_If_Expression): Do not force expansion for the sake of accessibility checks. * exp_ch6.adb (Create_Extra_Actuals): Remove specific support of extra accessibility formal for conditional expressions. * sem_eval.ads (Match_Result): New enumeration type moved from... (Choices_Match): New function declaration moved from... (Set_Checking_Potentially_Static_Expression): Alphabetize. * sem_eval.adb (Match_Result): ...here. (Choices_Match): ...here. (Eval_Case_Expression): Replace loop with call to Choices_Match. Diff: --- gcc/ada/accessibility.adb | 157 +++++++++++++++++++++++++++++--------- gcc/ada/accessibility.ads | 8 -- gcc/ada/exp_ch4.adb | 92 ++--------------------- gcc/ada/exp_ch6.adb | 186 ---------------------------------------------- gcc/ada/sem_eval.adb | 65 +++++----------- gcc/ada/sem_eval.ads | 21 +++++- 6 files changed, 168 insertions(+), 361 deletions(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index cf352d640a88..f7104930e72d 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -43,6 +43,7 @@ with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Ch8; use Sem_Ch8; +with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sinfo.Nodes; use Sinfo.Nodes; @@ -65,18 +66,22 @@ package body Accessibility is -- level to obtain. -- When Level is Dynamic_Level, a defining identifier associated with an - -- access parameter, an access result, or an SAOOAAAT, may be returned, - -- and an N_Integer_Literal node in the other cases. + -- access parameter, an access result, or an SAOOAAAT, may be returned. + -- For a conditional expression, another conditional expression may be + -- returned. An N_Integer_Literal node is returned in the other cases. -- When Level is Object_Decl_Level, an N_Integer_Literal node whose value -- is the level of the declaration of the object is returned in the cases - -- where Dynamic_Level returns a defining identifier; in the other cases, - -- an N_Integer_Literal is returned like for Dynamic_Level. + -- where Dynamic_Level returns a defining identifier. For a conditional + -- expression whose dependent expression is *not* statically selected, an + -- assertion failure is raised. In the other cases, an N_Integer_Literal + -- node is returned like for Dynamic_Level. -- When Level is Library_On_Dynamic_Level, an N_Integer_Literal node whose -- value is the library level is returned in the cases where Dynamic_Level - -- returns a defining identifier; in the other cases, an N_Integer_Literal - -- is returned like for Dynamic_Level. + -- returns a defining identifier. Likewise for a conditional expression + -- whose dependent expression is *not* statically selected. In the other + -- cases, an N_Integer_Literal node is returned like for Dynamic_Level. -- Note that this description does not take into account the dynamic offset -- that may be added by Offset_Static_Level to an N_Integer_Literal node. @@ -674,10 +679,20 @@ package body Accessibility is E := Param_Entity (Expr); -- Use the original node unless it is an unanalyzed identifier, as we - -- don't want to reason on unanalyzed expressions from predicates. - - elsif Nkind (Original_Node (Expr)) /= N_Identifier - or else Analyzed (Original_Node (Expr)) + -- don't want to reason on unanalyzed expressions from predicates, or + -- a folded conditional expression, since its level is ultimately that + -- of the dependent expression evaluated statically in this case. + + elsif not (Nkind (Original_Node (Expr)) = N_Identifier + and then not Analyzed (Original_Node (Expr))) + and then not (Nkind (Original_Node (Expr)) = N_Case_Expression + and then + Is_Static_Expression + (Expression (Original_Node (Expr)))) + and then not (Nkind (Original_Node (Expr)) = N_If_Expression + and then + Is_Static_Expression + (First (Expressions (Original_Node (Expr))))) then E := Original_Node (Expr); @@ -1105,6 +1120,103 @@ package body Accessibility is return Accessibility_Level (Prefix (E)); end if; + -- Conditional expressions: the accessibility level is the level of + -- the evaluated dependent expression (RM 3.10.2(9.1)). + + when N_Case_Expression => + -- If the expression is static, perform a static computation + + if Is_Static_Expression (Expression (E)) then + declare + Alt : Node_Id; + + begin + Alt := First (Alternatives (E)); + while Present (Alt) loop + if Choices_Match (Expression (E), Discrete_Choices (Alt)) + = Match + then + return Accessibility_Level (Expression (Alt)); + end if; + + Next (Alt); + end loop; + + raise Program_Error; + end; + + -- Or else, the expression is dynamic so, if the level is also + -- dynamic, we can perform a dynamic computation. + + elsif Level = Dynamic_Level then + declare + New_Alts : constant List_Id := New_List; + New_Case : constant Node_Id := + Make_Case_Expression (Loc, + Expression => Duplicate_Subexpr (Expression (E)), + Alternatives => New_Alts); + + Alt : Node_Id; + + begin + Alt := First (Alternatives (E)); + while Present (Alt) loop + Append_To (New_Alts, + Make_Case_Expression_Alternative (Sloc (Alt), + Discrete_Choices => Discrete_Choices (Alt), + Expression => + Accessibility_Level (Expression (Alt)).N)); + + Next (Alt); + end loop; + + return (S => False, N => New_Case); + end; + + -- Otherwise, the expression is dynamic but the level is static, + -- so return the library level to null out the check. + + else + pragma Assert (Level = Library_On_Dynamic_Level); + return Library_Level; + end if; + + when N_If_Expression => + declare + Condition : constant Node_Id := First (Expressions (E)); + Then_Expr : constant Node_Id := Next (Condition); + Else_Expr : constant Node_Id := Next (Then_Expr); + + begin + -- If the condition is static, perform a static computation + + if Is_Static_Expression (Condition) then + return + (if Is_True (Expr_Value (Condition)) + then Accessibility_Level (Then_Expr) + else Accessibility_Level (Else_Expr)); + + -- Or else, the condition is dynamic so, if the level is also + -- dynamic, we can perform a dynamic computation. + + elsif Level = Dynamic_Level then + return + (S => False, + N => Make_If_Expression (Loc, + Expressions => New_List ( + Duplicate_Subexpr (Condition), + Accessibility_Level (Then_Expr).N, + Accessibility_Level (Else_Expr).N))); + + -- Otherwise, the condition is dynamic but the level is static, + -- so return the library level to null out the check. + + else + pragma Assert (Level = Library_On_Dynamic_Level); + return Library_Level; + end if; + end; + -- Qualified expressions when N_Qualified_Expression => @@ -2621,31 +2733,6 @@ package body Accessibility is return False; end Has_Unconstrained_Access_Discriminants; - --------------------------------------------- - -- Needs_Accessibility_Level_Temp_Or_Check -- - --------------------------------------------- - - function Needs_Accessibility_Level_Temp_Or_Check - (Conditional_Expr : Node_Id) return Boolean - is - Par : Node_Id; - begin - if Ekind (Etype (Conditional_Expr)) /= E_Anonymous_Access_Type then - return False; - end if; - - Par := Parent (Conditional_Expr); - while Present (Par) - and then Nkind (Par) in N_Case_Expression - | N_If_Expression - | N_Parameter_Association - loop - Par := Parent (Par); - end loop; - - return Nkind (Par) in N_Subprogram_Call | N_Assignment_Statement; - end Needs_Accessibility_Level_Temp_Or_Check; - -------------------------------------- -- Needs_Result_Accessibility_Level -- -------------------------------------- diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads index a162371b4360..67e1deb88698 100644 --- a/gcc/ada/accessibility.ads +++ b/gcc/ada/accessibility.ads @@ -156,14 +156,6 @@ package Accessibility is -- Returns True if the given subtype is unconstrained and has one or more -- access discriminants. - function Needs_Accessibility_Level_Temp_Or_Check - (Conditional_Expr : Node_Id) return Boolean; - -- Determine whether a conditional expression occurs in a context that - -- requires either an associated accessibility-level-valued temp (which - -- is assigned to in each arm of the conditional expression) or an - -- accessibility level check (which is pushed down into each arm of the - -- conditional expression). - function Needs_Result_Accessibility_Level (Func_Id : Entity_Id) return Boolean; -- Ada 2012 (AI05-0234): Return True if the function needs an implicit diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 6d81fcefd266..913853947543 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5700,8 +5700,6 @@ package body Exp_Ch4 is -- Expand_N_If_Expression -- ---------------------------- - -- Deal with limited types and condition actions - procedure Expand_N_If_Expression (N : Node_Id) is Cond : constant Node_Id := First (Expressions (N)); Loc : constant Source_Ptr := Sloc (N); @@ -5710,17 +5708,6 @@ package body Exp_Ch4 is Par : constant Node_Id := Parent (N); Typ : constant Entity_Id := Etype (N); - Force_Expand : constant Boolean - := Needs_Accessibility_Level_Temp_Or_Check (N); - -- Determine if we are dealing with a special case of a conditional - -- expression used as an actual for an anonymous access type which - -- forces us to transform the if expression into an expression with - -- actions in order to create a temporary to capture the level of the - -- expression in each branch. Also True if the conditional - -- expression is the RHS of an assignment to a saooaaat (so the - -- accessibility level temp associated with the saooaaat also needs - -- to be updated as part of the assignment). - function OK_For_Single_Subtype (T1, T2 : Entity_Id) return Boolean; -- Return true if it is acceptable to use a single subtype for two -- dependent expressions of subtype T1 and T2 respectively, which are @@ -6428,16 +6415,9 @@ package body Exp_Ch4 is Prefix => New_Occurrence_Of (Target, Loc)); end; - -- For other types, we only need to expand if there are other actions - -- associated with either branch or we need to force expansion to deal - -- with if expressions used as an actual of an anonymous access type. - - elsif Present (Then_Actions (N)) - or else Present (Else_Actions (N)) - or else Force_Expand - then - -- We now wrap the actions into the appropriate expression + -- For other types, we just wrap the actions into an EWA node, if any + elsif Present (Then_Actions (N)) or else Present (Else_Actions (N)) then -- We do not need to call Process_Transients_In_Expression on -- the list of actions in this case, because the expansion of -- Expression_With_Actions will do it. @@ -6462,62 +6442,6 @@ package body Exp_Ch4 is Analyze_And_Resolve (Elsex, Typ); end if; - -- We must force expansion into an expression with actions when - -- an if expression gets used directly as an actual for an - -- anonymous access type. - - if Force_Expand then - declare - Cnn : constant Entity_Id := Make_Temporary (Loc, 'C'); - Acts : List_Id; - begin - Acts := New_List; - - -- Generate: - -- Cnn : Ann; - - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Cnn, - Object_Definition => New_Occurrence_Of (Typ, Loc)); - Append_To (Acts, Decl); - - Set_No_Initialization (Decl); - - -- Generate: - -- if Cond then - -- Cnn := <Thenx>; - -- else - -- Cnn := <Elsex>; - -- end if; - - If_Stmt := - Make_Implicit_If_Statement (N, - Condition => Relocate_Node (Cond), - Then_Statements => New_List ( - Make_Assignment_Statement (Sloc (Thenx), - Name => New_Occurrence_Of (Cnn, Sloc (Thenx)), - Expression => Relocate_Node (Thenx))), - - Else_Statements => New_List ( - Make_Assignment_Statement (Sloc (Elsex), - Name => New_Occurrence_Of (Cnn, Sloc (Elsex)), - Expression => Relocate_Node (Elsex)))); - Append_To (Acts, If_Stmt); - - -- Generate: - -- do - -- ... - -- in Cnn end; - - Rewrite (N, - Make_Expression_With_Actions (Loc, - Expression => New_Occurrence_Of (Cnn, Loc), - Actions => Acts)); - Analyze_And_Resolve (N, Typ); - end; - end if; - return; -- For the sake of GNATcoverage, generate an intermediate temporary in @@ -6567,11 +6491,11 @@ package body Exp_Ch4 is return; end if; - -- Fall through here for either the limited expansion, or the case of - -- inserting actions for nonlimited types. In both these cases, we must - -- move the SLOC of the parent If statement to the newly created one and - -- change it to the SLOC of the expression which, after expansion, will - -- correspond to what is being evaluated. + -- Fall through here when the if_expression is to be replaced with an + -- if_statement. If the parent itself is an if_statement, we move the + -- SLOC of the parent to the newly created one, and replace it by the + -- SLOC of the expression which, after expansion, will correspond to + -- what is being evaluated. if Present (Par) and then Nkind (Par) = N_If_Statement then Set_Sloc (If_Stmt, Sloc (Par)); @@ -6588,7 +6512,7 @@ package body Exp_Ch4 is Prepend_List (Else_Actions (N), Else_Statements (If_Stmt)); end if; - -- Rewrite the parent statement as an if statement + -- Rewrite the parent statement as an if statement in specific cases if Optimize_Assignment_Stmt or else Optimize_Return_Stmt then Rewrite (Par, If_Stmt); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 9d0e054b05a3..caf282df99b0 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2907,15 +2907,6 @@ package body Exp_Ch6 is -- default parameters and for extra actuals (for Extra_Formals). The -- argument is an N_Parameter_Association node. - procedure Add_Cond_Expression_Extra_Actual (Formal : Entity_Id); - -- Adds extra accessibility actuals in the case of a conditional - -- expression corresponding to Formal. - - -- Note: Conditional expressions used as actuals for anonymous access - -- formals complicate the process of propagating extra accessibility - -- actuals and must be handled in a recursive fashion since they can - -- be embedded within each other. - procedure Add_Dummy_Build_In_Place_Actuals (Function_Id : Entity_Id; Num_Added_Extra_Actuals : Nat := 0); @@ -2928,175 +2919,6 @@ package body Exp_Ch6 is -- expression for the value of the actual, EF is the entity for the -- extra formal. - -------------------------------------- - -- Add_Cond_Expression_Extra_Actual -- - -------------------------------------- - - procedure Add_Cond_Expression_Extra_Actual - (Formal : Entity_Id) - is - Decl : Node_Id; - Lvl : Entity_Id; - - procedure Insert_Level_Assign (Branch : Node_Id); - -- Recursively add assignment of the level temporary on each branch - -- while moving through nested conditional expressions. - - ------------------------- - -- Insert_Level_Assign -- - ------------------------- - - procedure Insert_Level_Assign (Branch : Node_Id) is - - procedure Expand_Branch (Res_Assn : Node_Id); - -- Perform expansion or iterate further within nested - -- conditionals given the object declaration or assignment to - -- result object created during expansion which represents a - -- branch of the conditional expression. - - ------------------- - -- Expand_Branch -- - ------------------- - - procedure Expand_Branch (Res_Assn : Node_Id) is - begin - pragma Assert (Nkind (Res_Assn) in - N_Assignment_Statement | - N_Object_Declaration); - - -- There are more nested conditional expressions so we must go - -- deeper. - - if Nkind (Expression (Res_Assn)) = N_Expression_With_Actions - and then - Nkind (Original_Node (Expression (Res_Assn))) - in N_Case_Expression | N_If_Expression - then - Insert_Level_Assign - (Expression (Res_Assn)); - - -- Add the level assignment - - else - Insert_Before_And_Analyze (Res_Assn, - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Lvl, Loc), - Expression => - Dynamic_Accessibility_Level - (Expression (Res_Assn), Allow_Alt_Model => False))); - end if; - end Expand_Branch; - - Cond : Node_Id; - Alt : Node_Id; - - -- Start of processing for Insert_Level_Assign - - begin - -- Examine further nested conditionals - - pragma Assert (Nkind (Branch) = - N_Expression_With_Actions); - - -- Find the relevant statement in the actions - - Cond := First (Actions (Branch)); - while Present (Cond) loop - exit when Nkind (Cond) in N_Case_Statement | N_If_Statement; - Next (Cond); - end loop; - - -- The conditional expression may have been optimized away, so - -- examine the actions in the branch. - - if No (Cond) then - Expand_Branch (Last (Actions (Branch))); - - -- Iterate through if expression branches - - elsif Nkind (Cond) = N_If_Statement then - Expand_Branch (Last (Then_Statements (Cond))); - Expand_Branch (Last (Else_Statements (Cond))); - - -- Iterate through case alternatives - - elsif Nkind (Cond) = N_Case_Statement then - - Alt := First (Alternatives (Cond)); - while Present (Alt) loop - Expand_Branch (Last (Statements (Alt))); - Next (Alt); - end loop; - end if; - end Insert_Level_Assign; - - -- Start of processing for cond expression case - - begin - -- Create declaration of a temporary to store the accessibility - -- level of each branch of the conditional expression. - - Lvl := Make_Temporary (Loc, 'L'); - Decl := Make_Object_Declaration (Loc, - Defining_Identifier => Lvl, - Object_Definition => - New_Occurrence_Of (Standard_Natural, Loc)); - - -- Install the declaration and perform necessary expansion if we - -- are dealing with a procedure call. - - if Nkind (Call_Node) = N_Procedure_Call_Statement then - -- Generate: - -- Lvl : Natural; - -- Call ( - -- {do - -- If_Exp_Res : Typ; - -- if Cond then - -- Lvl := 0; -- Access level - -- If_Exp_Res := Exp; - -- ... - -- in If_Exp_Res end;}, - -- Lvl, - -- ... - -- ) - - Insert_Before_And_Analyze (Call_Node, Decl); - - -- Ditto for a function call. Note that we do not wrap the function - -- call into an expression with action to avoid bad interactions with - -- Exp_Ch4.Process_Transient_In_Expression. - - else - -- Generate: - -- Lvl : Natural; -- placed above the function call - -- ... - -- Func_Call ( - -- {do - -- If_Exp_Res : Typ - -- if Cond then - -- Lvl := 0; -- Access level - -- If_Exp_Res := Exp; - -- in If_Exp_Res end;}, - -- Lvl, - -- ... - -- ) - - Insert_Action (Call_Node, Decl); - Analyze (Call_Node); - end if; - - -- Decorate the conditional expression with assignments to our level - -- temporary. - - Insert_Level_Assign (Prev); - - -- Make our level temporary the passed actual - - Add_Extra_Actual - (Expr => New_Occurrence_Of (Lvl, Loc), - EF => Extra_Accessibility (Formal)); - end Add_Cond_Expression_Extra_Actual; - -------------------------------------- -- Add_Dummy_Build_In_Place_Actuals -- -------------------------------------- @@ -3418,14 +3240,6 @@ package body Exp_Ch6 is EF => Extra_Accessibility (Formal)); end; - -- Conditional expressions - - elsif Nkind (Prev) = N_Expression_With_Actions - and then Nkind (Original_Node (Prev)) in - N_If_Expression | N_Case_Expression - then - Add_Cond_Expression_Extra_Actual (Formal); - -- Internal constant generated to remove side effects (normally -- from the expansion of dispatching calls). diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index cd46aef8e6fa..50e9f4540672 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -124,11 +124,6 @@ package body Sem_Eval is V : Uint; end record; - type Match_Result is (Match, No_Match, Non_Static); - -- Result returned from functions that test for a matching result. If the - -- operands are not OK_Static then Non_Static will be returned. Otherwise - -- Match/No_Match is returned depending on whether the match succeeds. - type CV_Cache_Array is array (CV_Range) of CV_Entry; CV_Cache : CV_Cache_Array; @@ -179,16 +174,6 @@ package body Sem_Eval is -- a reference to a type, one of whose bounds raises Constraint_Error, then -- it also sets the Raises_Constraint_Error flag on the Choice itself. - function Choices_Match - (Expr : Node_Id; - Choices : List_Id) return Match_Result; - -- This function applies Choice_Matches to each element of Choices. If the - -- result is No_Match, then it continues and checks the next element. If - -- the result is Match or Non_Static, this result is immediately given - -- as the result without checking the rest of the list. Expr can be of - -- discrete, real, or string type and must be a compile-time-known value - -- (it is an error to make the call if these conditions are not met). - procedure Eval_Intrinsic_Call (N : Node_Id; E : Entity_Id); -- Evaluate a call N to an intrinsic subprogram E @@ -2242,8 +2227,7 @@ package body Sem_Eval is -- expressions raise CE, except for the one that will be selected. procedure Eval_Case_Expression (N : Node_Id) is - Alt : Node_Id; - Choice : Node_Id; + Alt : Node_Id; begin Set_Is_Static_Expression (N, False); @@ -2298,44 +2282,35 @@ package body Sem_Eval is if Raises_Constraint_Error (Expression (N)) then Set_Raises_Constraint_Error (N); + return; + end if; -- Otherwise we need to check the alternatives to find the matching -- one. CE's in other than the matching one are not relevant. But we -- do need to check the matching one. Unlike the first loop, we do not -- have to go all the way through, when we find the matching one, quit. - else - Alt := First (Alternatives (N)); - Search : loop - - -- We must find a match among the alternatives. If not, this must - -- be due to other errors, so just ignore, leaving as non-static. - - if No (Alt) then - Set_Is_Static_Expression (N, False); - return; - end if; - - -- Otherwise loop through choices of this alternative - - Choice := First (Discrete_Choices (Alt)); - while Present (Choice) loop + Alt := First (Alternatives (N)); + loop + -- We must find a match among the alternatives. If not, this must + -- be due to other errors, so just ignore, leaving as non-static. - -- If we find a matching choice, then the Expression of this - -- alternative replaces N (Raises_Constraint_Error flag is - -- included, so we don't have to special case that). + if No (Alt) then + Set_Is_Static_Expression (N, False); + return; + end if; - if Choice_Matches (Expression (N), Choice) = Match then - Rewrite (N, Relocate_Node (Expression (Alt))); - return; - end if; + -- If we find a matching choice, then the Expression of this + -- alternative replaces N (Raises_Constraint_Error flag is + -- included, so we don't have to special case that). - Next (Choice); - end loop; + if Choices_Match (Expression (N), Discrete_Choices (Alt)) = Match then + Rewrite (N, Relocate_Node (Expression (Alt))); + return; + end if; - Next (Alt); - end loop Search; - end if; + Next (Alt); + end loop; end Eval_Case_Expression; ------------------------ diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads index 005c577f3273..9803245a036a 100644 --- a/gcc/ada/sem_eval.ads +++ b/gcc/ada/sem_eval.ads @@ -168,9 +168,20 @@ package Sem_Eval is -- Returns True if the checking for potentially static expressions is -- enabled; otherwise returns False. - procedure Set_Checking_Potentially_Static_Expression (Value : Boolean); - -- Enables checking for potentially static expressions if Value is True, - -- and disables such checking if Value is False. + type Match_Result is (Match, No_Match, Non_Static); + -- Result returned from functions that test for a matching result. If the + -- operands are not OK_Static then Non_Static will be returned. Otherwise + -- Match/No_Match is returned depending on whether the match succeeds. + + function Choices_Match + (Expr : Node_Id; + Choices : List_Id) return Match_Result; + -- This function applies Choice_Matches to each element of Choices. If the + -- result is No_Match, then it continues and checks the next element. If + -- the result is Match or Non_Static, this result is immediately given + -- as the result without checking the rest of the list. Expr can be of + -- discrete, real, or string type and must be a compile-time-known value + -- (it is an error to make the call if these conditions are not met). type Compare_Result is (LT, LE, EQ, GT, GE, NE, Unknown); subtype Compare_GE is Compare_Result range EQ .. GE; @@ -479,6 +490,10 @@ package Sem_Eval is -- match. Separated out from Subtypes_Statically_Match so that it can -- be used in specializing error messages. + procedure Set_Checking_Potentially_Static_Expression (Value : Boolean); + -- Enables checking for potentially static expressions if Value is True, + -- and disables such checking if Value is False. + function Subtypes_Statically_Compatible (T1 : Entity_Id; T2 : Entity_Id;
