@@ -1740,6 +1740,70 @@ package body Sem_Ch4 is
return;
end if;
+ -- The expression must be of a discrete type which must be determinable
+ -- independently of the context in which the expression occurs, but
+ -- using the fact that the expression must be of a discrete type.
+ -- Moreover, the type this expression must not be a character literal
+ -- (which is always ambiguous).
+
+ -- If error already reported by Resolve, nothing more to do
+
+ if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then
+ return;
+
+ -- Special case message for character literal
+
+ elsif Exp_Btype = Any_Character then
+ Error_Msg_N
+ ("character literal as case expression is ambiguous", Expr);
+ return;
+ end if;
+
+ -- If the case expression is a formal object of mode in out, then
+ -- treat it as having a nonstatic subtype by forcing use of the base
+ -- type (which has to get passed to Check_Case_Choices below). Also
+ -- use base type when the case expression is parenthesized.
+
+ if Paren_Count (Expr) > 0
+ or else (Is_Entity_Name (Expr)
+ and then Ekind (Entity (Expr)) = E_Generic_In_Out_Parameter)
+ then
+ Exp_Type := Exp_Btype;
+ end if;
+
+ -- The case expression alternatives cover the range of a static subtype
+ -- subject to aspect Static_Predicate. Do not check the choices when the
+ -- case expression has not been fully analyzed yet because this may lead
+ -- to bogus errors.
+
+ if Is_OK_Static_Subtype (Exp_Type)
+ and then Has_Static_Predicate_Aspect (Exp_Type)
+ and then In_Spec_Expression
+ then
+ null;
+
+ -- Call Analyze_Choices and Check_Choices to do the rest of the work
+
+ else
+ Analyze_Choices (Alternatives (N), Exp_Type);
+ Check_Choices (N, Alternatives (N), Exp_Type, Others_Present);
+
+ if Exp_Type = Universal_Integer and then not Others_Present then
+ Error_Msg_N
+ ("case on universal integer requires OTHERS choice", Expr);
+ return;
+ end if;
+ end if;
+
+ -- RM 4.5.7(10/3): If the case_expression is the operand of a type
+ -- conversion, the type of the case_expression is the target type
+ -- of the conversion.
+
+ if Nkind (Parent (N)) = N_Type_Conversion then
+ Set_Etype (N, Etype (Parent (N)));
+ return;
+ end if;
+
-- Loop through the interpretations of the first expression and check
-- the other expressions if present.
@@ -1763,25 +1827,6 @@ package body Sem_Ch4 is
end loop;
end if;
- -- The expression must be of a discrete type which must be determinable
- -- independently of the context in which the expression occurs, but
- -- using the fact that the expression must be of a discrete type.
- -- Moreover, the type this expression must not be a character literal
- -- (which is always ambiguous).
-
- -- If error already reported by Resolve, nothing more to do
-
- if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then
- return;
-
- -- Special casee message for character literal
-
- elsif Exp_Btype = Any_Character then
- Error_Msg_N
- ("character literal as case expression is ambiguous", Expr);
- return;
- end if;
-
-- If no possible interpretation has been found, the type of the wrong
-- alternative doesn't match any interpretation of the FIRST expression.
@@ -1829,43 +1874,6 @@ package body Sem_Ch4 is
Etype (Second_Expr));
end if;
end if;
-
- return;
- end if;
-
- -- If the case expression is a formal object of mode in out, then
- -- treat it as having a nonstatic subtype by forcing use of the base
- -- type (which has to get passed to Check_Case_Choices below). Also
- -- use base type when the case expression is parenthesized.
-
- if Paren_Count (Expr) > 0
- or else (Is_Entity_Name (Expr)
- and then Ekind (Entity (Expr)) = E_Generic_In_Out_Parameter)
- then
- Exp_Type := Exp_Btype;
- end if;
-
- -- The case expression alternatives cover the range of a static subtype
- -- subject to aspect Static_Predicate. Do not check the choices when the
- -- case expression has not been fully analyzed yet because this may lead
- -- to bogus errors.
-
- if Is_OK_Static_Subtype (Exp_Type)
- and then Has_Static_Predicate_Aspect (Exp_Type)
- and then In_Spec_Expression
- then
- null;
-
- -- Call Analyze_Choices and Check_Choices to do the rest of the work
-
- else
- Analyze_Choices (Alternatives (N), Exp_Type);
- Check_Choices (N, Alternatives (N), Exp_Type, Others_Present);
-
- if Exp_Type = Universal_Integer and then not Others_Present then
- Error_Msg_N
- ("case on universal integer requires OTHERS choice", Expr);
- end if;
end if;
end Analyze_Case_Expression;
@@ -2555,6 +2563,15 @@ package body Sem_Ch4 is
Analyze_Expression (Else_Expr);
end if;
+ -- RM 4.5.7(10/3): If the if_expression is the operand of a type
+ -- conversion, the type of the if_expression is the target type
+ -- of the conversion.
+
+ if Nkind (Parent (N)) = N_Type_Conversion then
+ Set_Etype (N, Etype (Parent (N)));
+ return;
+ end if;
+
-- Loop through the interpretations of the THEN expression and check the
-- ELSE expression if present.
@@ -171,6 +171,13 @@ package body Sem_Res is
-- of the task, it must be replaced with a reference to the discriminant
-- of the task being called.
+ procedure Resolve_Dependent_Expression
+ (N : Node_Id;
+ Expr : Node_Id;
+ Typ : Entity_Id);
+ -- Internal procedure to resolve the dependent expression Expr of the
+ -- conditional expression N with type Typ.
+
procedure Resolve_Op_Concat_Arg
(N : Node_Id;
Arg : Node_Id;
@@ -291,12 +298,6 @@ package body Sem_Res is
-- Called after N has been resolved and evaluated, but before range checks
-- have been applied. This rewrites the conversion into a simpler form.
- function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
- -- A universal_fixed expression in an universal context is unambiguous if
- -- there is only one applicable fixed point type. Determining whether there
- -- is only one requires a search over all visible entities, and happens
- -- only in very pathological cases (see 6115-006).
-
function Try_User_Defined_Literal
(N : Node_Id;
Typ : Entity_Id) return Boolean;
@@ -306,6 +307,12 @@ package body Sem_Res is
-- 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
+ -- there is only one applicable fixed point type. Determining whether there
+ -- is only one requires a search over all visible entities, and happens
+ -- only in very pathological cases (see 6115-006).
+
-------------------------
-- Ambiguous_Character --
-------------------------
@@ -2461,6 +2468,15 @@ package body Sem_Res is
Found := True;
Expr_Type := Etype (Expression (N));
+ -- The resolution of a conditional expression that is the operand of a
+ -- type conversion is determined by the conversion (RM 4.5.7(10/3)).
+
+ elsif Nkind (N) in N_Case_Expression | N_If_Expression
+ and then Nkind (Parent (N)) = N_Type_Conversion
+ then
+ Found := True;
+ Expr_Type := Etype (Parent (N));
+
-- If not overloaded, then we know the type, and all that needs doing
-- is to check that this type is compatible with the context.
@@ -7390,7 +7406,8 @@ package body Sem_Res is
return;
end if;
- Resolve (Alt_Expr, Typ);
+ Resolve_Dependent_Expression (N, Alt_Expr, Typ);
+
Check_Unset_Reference (Alt_Expr);
Alt_Typ := Etype (Alt_Expr);
@@ -7671,6 +7688,34 @@ package body Sem_Res is
Check_Unset_Reference (Expr);
end Resolve_Declare_Expression;
+ -----------------------------------
+ -- Resolve_Dependent_Expression --
+ -----------------------------------
+
+ procedure Resolve_Dependent_Expression
+ (N : Node_Id;
+ Expr : Node_Id;
+ Typ : Entity_Id)
+ is
+ begin
+ -- RM 4.5.7(8/3) says that the expected type of dependent expressions is
+ -- that of the conditional expression but RM 4.5.7(10/3) forces the type
+ -- of the conditional expression without changing the expected type (the
+ -- expected type of the operand of a type conversion is any type), so we
+ -- may have a gap between these two types that is bridged by the dynamic
+ -- semantics specified by RM 4.5.7(20/3) with the associated legality
+ -- rule RM 4.5.7(16/3) that will be automatically enforced.
+
+ if Nkind (Parent (N)) = N_Type_Conversion
+ and then Nkind (Expr) /= N_Raise_Expression
+ then
+ Convert_To_And_Rewrite (Typ, Expr);
+ Analyze_And_Resolve (Expr);
+ else
+ Resolve (Expr, Typ);
+ end if;
+ end Resolve_Dependent_Expression;
+
-----------------------------------------
-- Resolve_Discrete_Subtype_Indication --
-----------------------------------------
@@ -9307,7 +9352,9 @@ package body Sem_Res is
---------------------------
procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id) is
- procedure Apply_Check (Expr : Node_Id);
+ Condition : constant Node_Id := First (Expressions (N));
+
+ procedure Apply_Check (Expr : Node_Id; Result_Type : Entity_Id);
-- When a dependent expression is of a subtype different from
-- the context subtype, then insert a qualification to ensure
-- the generation of a constraint check. This was previously
@@ -9315,21 +9362,11 @@ package body Sem_Res is
-- that the context in general allows sliding, while a qualified
-- expression forces equality of bounds.
- Result_Type : Entity_Id := Typ;
- -- So in most cases the type of the If_Expression and of its
- -- dependent expressions is that of the context. However, if
- -- the expression is the index of an Indexed_Component, we must
- -- ensure that a proper index check is applied, rather than a
- -- range check on the index type (which might be discriminant
- -- dependent). In this case we resolve with the base type of the
- -- index type, and the index check is generated in the resolution
- -- of the indexed_component above.
-
-----------------
-- Apply_Check --
-----------------
- procedure Apply_Check (Expr : Node_Id) is
+ procedure Apply_Check (Expr : Node_Id; Result_Type : Entity_Id) is
Expr_Typ : constant Entity_Id := Etype (Expr);
Loc : constant Source_Ptr := Sloc (Expr);
@@ -9357,10 +9394,19 @@ package body Sem_Res is
-- Local variables
- Condition : constant Node_Id := First (Expressions (N));
Else_Expr : Node_Id;
Then_Expr : Node_Id;
+ Result_Type : Entity_Id;
+ -- So in most cases the type of the if_expression and of its
+ -- dependent expressions is that of the context. However, if
+ -- the expression is the index of an Indexed_Component, we must
+ -- ensure that a proper index check is applied, rather than a
+ -- range check on the index type (which might be discriminant
+ -- dependent). In this case we resolve with the base type of the
+ -- index type, and the index check is generated in the resolution
+ -- of the indexed_component above.
+
-- Start of processing for Resolve_If_Expression
begin
@@ -9375,6 +9421,9 @@ package body Sem_Res is
or else Nkind (Parent (Parent (N))) = N_Indexed_Component)
then
Result_Type := Base_Type (Typ);
+
+ else
+ Result_Type := Typ;
end if;
Then_Expr := Next (Condition);
@@ -9383,21 +9432,23 @@ package body Sem_Res is
return;
end if;
- Else_Expr := Next (Then_Expr);
-
Resolve (Condition, Any_Boolean);
- Resolve (Then_Expr, Result_Type);
Check_Unset_Reference (Condition);
+
+ Resolve_Dependent_Expression (N, Then_Expr, Result_Type);
+
Check_Unset_Reference (Then_Expr);
+ Apply_Check (Then_Expr, Result_Type);
- Apply_Check (Then_Expr);
+ Else_Expr := Next (Then_Expr);
-- If ELSE expression present, just resolve using the determined type
if Present (Else_Expr) then
- Resolve (Else_Expr, Result_Type);
+ Resolve_Dependent_Expression (N, Else_Expr, Result_Type);
+
Check_Unset_Reference (Else_Expr);
- Apply_Check (Else_Expr);
+ Apply_Check (Else_Expr, Result_Type);
-- Apply RM 4.5.7 (17/3): whether the expression is statically or
-- dynamically tagged must be known statically.
@@ -12158,6 +12209,12 @@ package body Sem_Res is
then
null;
+ -- Never give a warning if the operand is a conditional expression
+ -- because RM 4.5.7(10/3) forces its type to be the target type.
+
+ elsif Nkind (Orig_N) in N_Case_Expression | N_If_Expression then
+ null;
+
-- Finally, if this type conversion occurs in a context requiring
-- a prefix, and the expression is a qualified expression then the
-- type conversion is not redundant, since a qualified expression