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.
Tested on x86-64/Linux, applied on the mainline.
2026-09-22 Eric Botcazou <[email protected]>
* 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.
--
Eric Botcazoudiff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index cf352d640a8..f7104930e72 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 a162371b436..67e1deb8869 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 6d81fcefd26..91385394754 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 9d0e054b05a..caf282df99b 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 cd46aef8e6f..50e9f454067 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 005c577f327..9803245a036 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;
