Source_Base_Type : constant Entity_Id := Base_Type (Source_Type);
Target_Base_Type : constant Entity_Id := Base_Type (Target_Type);
+ procedure Convert_And_Check_Range;
+ -- Convert the conversion operand to the target base type and save in
+ -- a temporary. Then check the converted value against the range of the
+ -- target subtype.
+
+ procedure Convert_And_Check_Range is
+ -- To what does the following comment belong???
+ -- We make a temporary to hold the value of the converted value
+ -- (converted to the base type), and then we will do the test against
+ -- this temporary.
+ --
+ -- Tnn : constant Target_Base_Type := Target_Base_Type (N);
+ -- [constraint_error when Tnn not in Target_Type]
+ --
+ -- The conversion itself is replaced by an occurrence of Tnn
+
+ Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
+
+ -- To what does the following comment belong???
+ -- Follow the conversion with the explicit range check. Note that we
+ -- suppress checks for this code, since we don't want a recursive
+ -- range check popping up.
+
+ begin
+ Insert_Actions (N, New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Tnn,
+ Object_Definition => New_Occurrence_Of (Target_Base_Type, Loc),
+ Constant_Present => True,
+ Expression =>
+ Make_Type_Conversion (Loc,
+ Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc),
+ Expression => Duplicate_Subexpr (N))),
+
+ Make_Raise_Constraint_Error (Loc,
+ Condition =>
+ Make_Not_In (Loc,
+ Left_Opnd => New_Occurrence_Of (Tnn, Loc),
+ Right_Opnd => New_Occurrence_Of (Target_Type, Loc)),
+ Reason => Reason)),
+ Suppress => All_Checks);
+
+ Rewrite (N, New_Occurrence_Of (Tnn, Loc));
+
+ -- Set the type of N, because the declaration for Tnn might not
+ -- be analyzed yet, as is the case if N appears within a record
+ -- declaration, as a discriminant constraint or expression.
+
+ Set_Etype (N, Target_Base_Type);
+ end Convert_And_Check_Range;
+
+ -- Start of processing for Generate_Range_Check
+
begin
-- First special case, if the source type is already within the range
-- of the target type, then no check is needed (probably we should have
-- Insert the explicit range check. Note that we suppress checks for
-- this code, since we don't want a recursive range check popping up.
- Insert_Action (N,
- Make_Raise_Constraint_Error (Loc,
- Condition =>
- Make_Not_In (Loc,
- Left_Opnd => Duplicate_Subexpr (N),
+ if Is_Discrete_Type (Source_Base_Type)
+ and then
+ Is_Discrete_Type (Target_Base_Type)
+ then
+ Insert_Action (N,
+ Make_Raise_Constraint_Error (Loc,
+ Condition =>
+ Make_Not_In (Loc,
+ Left_Opnd => Duplicate_Subexpr (N),
- Right_Opnd =>
- Make_Range (Loc,
- Low_Bound =>
- Unchecked_Convert_To (Source_Base_Type,
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Target_Type, Loc),
- Attribute_Name => Name_First)),
-
- High_Bound =>
- Unchecked_Convert_To (Source_Base_Type,
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Target_Type, Loc),
- Attribute_Name => Name_Last)))),
- Reason => Reason),
- Suppress => All_Checks);
+ Right_Opnd =>
+ Make_Range (Loc,
+ Low_Bound =>
+ Unchecked_Convert_To (Source_Base_Type,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Target_Type, Loc),
+ Attribute_Name => Name_First)),
+
+ High_Bound =>
+ Unchecked_Convert_To (Source_Base_Type,
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Target_Type, Loc),
+ Attribute_Name => Name_Last)))),
+ Reason => Reason),
+ Suppress => All_Checks);
+
+ -- For conversions involving at least one type that is not discrete,
+ -- first convert to target type and then generate the range check.
+ -- This avoids problems with values that are close to a bound of the
+ -- target type that would fail a range check when done in a larger
+ -- source type before converting but would pass if converted with
+ -- rounding and then checked (such as in float-to-float conversions).
+
+ else
+ Convert_And_Check_Range;
+ end if;
-- Note that at this stage we now that the Target_Base_Type is not in
-- the range of the Source_Base_Type (since even the Target_Type itself
-- and then test the target result against the bounds.
elsif In_Subrange_Of (Source_Type, Target_Base_Type) then
-
- -- We make a temporary to hold the value of the converted value
- -- (converted to the base type), and then we will do the test against
- -- this temporary.
-
- -- Tnn : constant Target_Base_Type := Target_Base_Type (N);
- -- [constraint_error when Tnn not in Target_Type]
-
- -- Then the conversion itself is replaced by an occurrence of Tnn
-
- -- Insert the explicit range check. Note that we suppress checks for
- -- this code, since we don't want a recursive range check popping up.
-
- declare
- Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
-
- begin
- Insert_Actions (N, New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier => Tnn,
- Object_Definition =>
- New_Occurrence_Of (Target_Base_Type, Loc),
- Constant_Present => True,
- Expression =>
- Make_Type_Conversion (Loc,
- Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc),
- Expression => Duplicate_Subexpr (N))),
-
- Make_Raise_Constraint_Error (Loc,
- Condition =>
- Make_Not_In (Loc,
- Left_Opnd => New_Occurrence_Of (Tnn, Loc),
- Right_Opnd => New_Occurrence_Of (Target_Type, Loc)),
-
- Reason => Reason)),
- Suppress => All_Checks);
-
- Rewrite (N, New_Occurrence_Of (Tnn, Loc));
-
- -- Set the type of N, because the declaration for Tnn might not
- -- be analyzed yet, as is the case if N appears within a record
- -- declaration, as a discriminant constraint or expression.
-
- Set_Etype (N, Target_Base_Type);
- end;
+ Convert_And_Check_Range;
-- At this stage, we know that we have two scalar types, which are
-- directly convertible, and where neither scalar type has a base
-- The only remaining step is to generate a range check if we still have
-- a type conversion at this stage and Do_Range_Check is set. For now we
- -- do this only for conversions of discrete types and for floating-point
- -- conversions where the base types of source and target are the same.
+ -- do this only for conversions of discrete types and for float-to-float
+ -- conversions.
if Nkind (N) = N_Type_Conversion then
- -- For now we only support floating-point cases where the base types
- -- of the target type and source expression are the same, so there's
- -- potentially only a range check. Conversions where the source and
- -- target have different base types are still TBD. ???
+ -- For now we only support floating-point cases where both source
+ -- and target are floating-point types. Conversions where the source
+ -- and target involve integer or fixed-point types are still TBD,
+ -- though not clear whether those can even happen at this point, due
+ -- to transformations above. ???
if Is_Floating_Point_Type (Etype (N))
- and then
- Base_Type (Etype (N)) = Base_Type (Etype (Expression (N)))
+ and then Is_Floating_Point_Type (Etype (Expression (N)))
then
if Do_Range_Check (Expression (N))
and then Is_Floating_Point_Type (Target_Type)
(Expression (N), Target_Type, CE_Range_Check_Failed);
end if;
+ -- Discrete-to-discrete conversions
+
elsif Is_Discrete_Type (Etype (N)) then
declare
Expr : constant Node_Id := Expression (N);