diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2023-04-07 09:16:12 +0200 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-05-29 10:23:22 +0200 |
commit | 47853d3acefbdedfad9ef693a3184093ceaab7fd (patch) | |
tree | 1dfee816c61e7c49af5f5a8fc05fbd9507493e2e /gcc/ada/sem_res.adb | |
parent | 9f29fc75351870da24c1a94986be031989a88509 (diff) | |
download | gcc-47853d3acefbdedfad9ef693a3184093ceaab7fd.zip gcc-47853d3acefbdedfad9ef693a3184093ceaab7fd.tar.gz gcc-47853d3acefbdedfad9ef693a3184093ceaab7fd.tar.bz2 |
ada: Fix bogus error on conditional expression with only user-defined literals
This implements the recursive resolution of conditional expressions whose
dependent expressions are (all) user-defined literals the same way it is
implemented for operators.
gcc/ada/
* sem_res.adb (Has_Applicable_User_Defined_Literal): Make it clear
that the predicate also checks the node itself.
(Try_User_Defined_Literal): Move current implementation to...
Deal only with literals, named numbers and conditional expressions
whose dependent expressions are literals or named numbers.
(Try_User_Defined_Literal_For_Operator): ...this. Remove multiple
return False statements and put a single one at the end.
(Resolve): Call Try_User_Defined_Literal instead of directly
Has_Applicable_User_Defined_Literal for all nodes. Call
Try_User_Defined_Literal_For_Operator for operator nodes.
Diffstat (limited to 'gcc/ada/sem_res.adb')
-rw-r--r-- | gcc/ada/sem_res.adb | 127 |
1 files changed, 98 insertions, 29 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 8a5f87b..899b5b5 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -111,10 +111,9 @@ package body Sem_Res is function Has_Applicable_User_Defined_Literal (N : Node_Id; Typ : Entity_Id) return Boolean; - -- If N is a literal or a named number, check whether Typ - -- has a user-defined literal aspect that can apply to N. - -- If present, replace N with a call to the corresponding - -- function and return True. + -- Check whether N is a literal or a named number, and whether Typ has a + -- user-defined literal aspect that may apply to N. In this case, replace + -- N with a call to the corresponding function and return True. procedure Check_Discriminant_Use (N : Node_Id); -- Enforce the restrictions on the use of discriminants when constraining @@ -306,11 +305,20 @@ package body Sem_Res is function Try_User_Defined_Literal (N : Node_Id; Typ : Entity_Id) return Boolean; - -- If an operator node has a literal operand, check whether the type - -- of the context, or the type of the other operand has a user-defined - -- literal aspect that can be applied to the literal to resolve the node. - -- If such aspect exists, replace literal with a call to the - -- corresponding function and return True, return false otherwise. + -- If the node is a literal or a named number or a conditional expression + -- whose dependent expressions are all literals or named numbers, and the + -- context type has a user-defined literal aspect, then rewrite the node + -- or its leaf nodes as calls to the corresponding function, which plays + -- the role of an implicit conversion. + + function Try_User_Defined_Literal_For_Operator + (N : Node_Id; + Typ : Entity_Id) return Boolean; + -- If an operator node has a literal operand, check whether the type of the + -- context, or that of the other operand has a user-defined literal aspect + -- that can be applied to the literal to resolve the node. If such aspect + -- exists, replace literal with a call to the corresponding function and + -- return True, return false otherwise. function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id; -- A universal_fixed expression in an universal context is unambiguous if @@ -600,6 +608,7 @@ package body Sem_Res is Analyze_And_Resolve (N, Typ); return True; + else return False; end if; @@ -3061,14 +3070,11 @@ package body Sem_Res is end; end if; - -- If node is a literal and context type has a user-defined - -- literal aspect, rewrite node as a call to the corresponding - -- function, which plays the role of an implicit conversion. + -- Check whether the node is a literal or a named number or a + -- conditional expression whose dependent expressions are all + -- literals or named numbers. - if Nkind (N) in N_Numeric_Or_String_Literal | N_Identifier - and then Has_Applicable_User_Defined_Literal (N, Typ) - then - Analyze_And_Resolve (N, Typ); + if Try_User_Defined_Literal (N, Typ) then return; end if; @@ -3179,7 +3185,7 @@ package body Sem_Res is -- its operands may be a user-defined literal. elsif Nkind (N) in N_Op and then No (Entity (N)) then - if Try_User_Defined_Literal (N, Typ) then + if Try_User_Defined_Literal_For_Operator (N, Typ) then return; else Unresolved_Operator (N); @@ -13323,6 +13329,78 @@ package body Sem_Res is Typ : Entity_Id) return Boolean is begin + if Has_Applicable_User_Defined_Literal (N, Typ) then + return True; + + elsif Nkind (N) = N_If_Expression then + -- Both dependent expressions must have the same type as the context + + declare + Condition : constant Node_Id := First (Expressions (N)); + Then_Expr : constant Node_Id := Next (Condition); + Else_Expr : constant Node_Id := Next (Then_Expr); + + begin + if Has_Applicable_User_Defined_Literal (Then_Expr, Typ) then + Resolve (Else_Expr, Typ); + Analyze_And_Resolve (N, Typ); + return True; + + elsif Has_Applicable_User_Defined_Literal (Else_Expr, Typ) then + Resolve (Then_Expr, Typ); + Analyze_And_Resolve (N, Typ); + return True; + end if; + end; + + elsif Nkind (N) = N_Case_Expression then + -- All dependent expressions must have the same type as the context + + declare + Alt : Node_Id; + + begin + Alt := First (Alternatives (N)); + + while Present (Alt) loop + if Has_Applicable_User_Defined_Literal (Expression (Alt), Typ) + then + declare + Other_Alt : Node_Id; + + begin + Other_Alt := First (Alternatives (N)); + + while Present (Other_Alt) loop + if Other_Alt /= Alt then + Resolve (Expression (Other_Alt), Typ); + end if; + + Next (Other_Alt); + end loop; + + Analyze_And_Resolve (N, Typ); + return True; + end; + end if; + + Next (Alt); + end loop; + end; + end if; + + return False; + end Try_User_Defined_Literal; + + ------------------------------------------- + -- Try_User_Defined_Literal_For_Operator -- + ------------------------------------------- + + function Try_User_Defined_Literal_For_Operator + (N : Node_Id; + Typ : Entity_Id) return Boolean + is + begin if Nkind (N) in N_Op_Add | N_Op_Divide | N_Op_Mod @@ -13348,9 +13426,6 @@ package body Sem_Res is Resolve (Right_Opnd (N), Typ); Analyze_And_Resolve (N, Typ); return True; - - else - return False; end if; elsif Nkind (N) in N_Binary_Op then @@ -13374,9 +13449,6 @@ package body Sem_Res is then Analyze_And_Resolve (N, Typ); return True; - - else - return False; end if; elsif Nkind (N) in N_Unary_Op @@ -13384,13 +13456,10 @@ package body Sem_Res is then Analyze_And_Resolve (N, Typ); return True; - - else - -- Other operators - - return False; end if; - end Try_User_Defined_Literal; + + return False; + end Try_User_Defined_Literal_For_Operator; ----------------------------- -- Unique_Fixed_Point_Type -- |