end if;
-- Return if we know expression is definitely in the range of the target
- -- type as determined by Determine_Range. Right now we only do this for
- -- discrete types, and not fixed-point or floating-point types.
-
- -- The additional less-precise tests below catch these cases
-
- -- In GNATprove_Mode, also deal with the case of a conversion from
- -- floating-point to integer. It is only possible because analysis
- -- in GNATprove rules out the possibility of a NaN or infinite value.
+ -- type as determined by Determine_Range_To_Discrete. Right now we only
+ -- do this for discrete target types, i.e. neither for fixed-point nor
+ -- for floating-point types. But the additional less precise tests below
+ -- catch these cases.
-- Note: skip this if we are given a source_typ, since the point of
-- supplying a Source_Typ is to stop us looking at the expression.
-- We could sharpen this test to be out parameters only ???
if Is_Discrete_Type (Target_Typ)
- and then (Is_Discrete_Type (Etype (Expr))
- or else (GNATprove_Mode
- and then Is_Floating_Point_Type (Etype (Expr))))
and then not Is_Unconstrained_Subscr_Ref
and then No (Source_Typ)
then
-- Otherwise determine range of value
- if Is_Discrete_Type (Etype (Expr)) then
- Determine_Range
- (Expr, OK, Lo, Hi, Assume_Valid => True);
-
- -- When converting a float to an integer type, determine the
- -- range in real first, and then convert the bounds using
- -- UR_To_Uint which correctly rounds away from zero when
- -- half way between two integers, as required by normal
- -- Ada 95 rounding semantics. It is only possible because
- -- analysis in GNATprove rules out the possibility of a NaN
- -- or infinite value.
-
- elsif GNATprove_Mode
- and then Is_Floating_Point_Type (Etype (Expr))
- then
- declare
- Hir : Ureal;
- Lor : Ureal;
-
- begin
- Determine_Range_R
- (Expr, OK, Lor, Hir, Assume_Valid => True);
-
- if OK then
- Lo := UR_To_Uint (Lor);
- Hi := UR_To_Uint (Hir);
- end if;
- end;
- end if;
+ Determine_Range_To_Discrete
+ (Expr, OK, Lo, Hi, Fixed_Int, Assume_Valid => True);
if OK then
-- Check if we can determine at compile time whether Expr is in the
-- range of the target type. Note that if S_Typ is within the bounds
-- of Target_Typ then this must be the case. This check is meaningful
- -- only if this is not a conversion between integer and real types.
+ -- only if this is not a conversion between integer and real types,
+ -- unless for a fixed-point type if Fixed_Int is set.
if not Is_Unconstrained_Subscr_Ref
- and then Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ)
+ and then (Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ)
+ or else (Fixed_Int and then Is_Discrete_Type (Target_Typ)))
and then
(In_Subrange_Of (S_Typ, Target_Typ, Fixed_Int)
then
Apply_Float_Conversion_Check (Expr, Target_Type);
else
- -- Conversions involving fixed-point types are expanded
- -- separately, and do not need a Range_Check flag, except
- -- in GNATprove_Mode, where the explicit constraint check
- -- will not be generated.
+ -- Raw conversions involving fixed-point types are expanded
+ -- separately and do not need a Range_Check flag yet, except
+ -- in GNATprove_Mode where this expansion is not performed.
+ -- This does not apply to conversion where fixed-point types
+ -- are treated as integers, which are precisely generated by
+ -- this expansion.
if GNATprove_Mode
+ or else Conv_OK
or else (not Is_Fixed_Point_Type (Expr_Type)
and then not Is_Fixed_Point_Type (Target_Type))
then
end case;
when N_Type_Conversion =>
+ -- For a type conversion, we can try to refine the range using the
+ -- converted value.
- -- For type conversion from one discrete type to another, we can
- -- refine the range using the converted value.
-
- if Is_Discrete_Type (Etype (Expression (N))) then
- Determine_Range (Expression (N), OK1, Lor, Hir, Assume_Valid);
-
- -- When converting a float to an integer type, determine the range
- -- in real first, and then convert the bounds using UR_To_Uint
- -- which correctly rounds away from zero when half way between two
- -- integers, as required by normal Ada 95 rounding semantics. It
- -- is only possible because analysis in GNATprove rules out the
- -- possibility of a NaN or infinite value.
-
- elsif GNATprove_Mode
- and then Is_Floating_Point_Type (Etype (Expression (N)))
- then
- declare
- Lor_Real, Hir_Real : Ureal;
- begin
- Determine_Range_R (Expression (N), OK1, Lor_Real, Hir_Real,
- Assume_Valid);
-
- if OK1 then
- Lor := UR_To_Uint (Lor_Real);
- Hir := UR_To_Uint (Hir_Real);
- end if;
- end;
-
- else
- OK1 := False;
- end if;
+ Determine_Range_To_Discrete
+ (Expression (N), OK1, Lor, Hir, Conversion_OK (N), Assume_Valid);
-- Nothing special to do for all other expression kinds
end if;
end Determine_Range_R;
+ ---------------------------------
+ -- Determine_Range_To_Discrete --
+ ---------------------------------
+
+ procedure Determine_Range_To_Discrete
+ (N : Node_Id;
+ OK : out Boolean;
+ Lo : out Uint;
+ Hi : out Uint;
+ Fixed_Int : Boolean := False;
+ Assume_Valid : Boolean := False)
+ is
+ Typ : constant Entity_Id := Etype (N);
+
+ begin
+ -- For a discrete type, simply defer to Determine_Range
+
+ if Is_Discrete_Type (Typ) then
+ Determine_Range (N, OK, Lo, Hi, Assume_Valid);
+
+ -- For a fixed point type treated as an integer, we can determine the
+ -- range using the Corresponding_Integer_Value of the bounds of the
+ -- type or base type. This is done by the calls to Expr_Value below.
+
+ elsif Is_Fixed_Point_Type (Typ) and then Fixed_Int then
+ declare
+ Btyp, Ftyp : Entity_Id;
+ Bound : Node_Id;
+
+ begin
+ if Assume_Valid then
+ Ftyp := Typ;
+ else
+ Ftyp := Underlying_Type (Base_Type (Typ));
+ end if;
+
+ Btyp := Base_Type (Ftyp);
+
+ -- First the low bound
+
+ Bound := Type_Low_Bound (Ftyp);
+
+ if Compile_Time_Known_Value (Bound) then
+ Lo := Expr_Value (Bound);
+ else
+ Lo := Expr_Value (Type_Low_Bound (Btyp));
+ end if;
+
+ -- Then the high bound
+
+ Bound := Type_High_Bound (Ftyp);
+
+ if Compile_Time_Known_Value (Bound) then
+ Hi := Expr_Value (Bound);
+ else
+ Hi := Expr_Value (Type_High_Bound (Btyp));
+ end if;
+
+ OK := True;
+ end;
+
+ -- For a floating-point type, we can determine the range in real first,
+ -- and then convert the bounds using UR_To_Uint, which correctly rounds
+ -- away from zero when half way between two integers, as required by
+ -- normal Ada 95 rounding semantics. But this is only possible because
+ -- GNATprove's analysis rules out the possibility of a NaN or infinite.
+
+ elsif GNATprove_Mode and then Is_Floating_Point_Type (Typ) then
+ declare
+ Lo_Real, Hi_Real : Ureal;
+
+ begin
+ Determine_Range_R (N, OK, Lo_Real, Hi_Real, Assume_Valid);
+
+ if OK then
+ Lo := UR_To_Uint (Lo_Real);
+ Hi := UR_To_Uint (Hi_Real);
+ else
+ Lo := No_Uint;
+ Hi := No_Uint;
+ end if;
+ end;
+
+ else
+ Lo := No_Uint;
+ Hi := No_Uint;
+ OK := False;
+ end if;
+ end Determine_Range_To_Discrete;
+
------------------------------------
-- Discriminant_Checks_Suppressed --
------------------------------------
-- Start of processing for Discrete_Range_Check
begin
- -- Clear the Do_Range_Check flag on N if needed: this can occur when
- -- e.g. a trivial type conversion is rewritten by its expression.
-
- Set_Do_Range_Check (N, False);
-
-- Nothing more to do if conversion was rewritten
if Nkind (N) /= N_Type_Conversion then
Expr := Expression (N);
- -- Nothing to do if no range check flag set
-
- if not Do_Range_Check (Expr) then
- return;
- end if;
-
-- Clear the Do_Range_Check flag on Expr
Set_Do_Range_Check (Expr, False);
Tnn : Entity_Id;
begin
- -- Clear the Do_Range_Check flag on N if needed: this can occur when
- -- e.g. a trivial type conversion is rewritten by its expression.
-
- Set_Do_Range_Check (N, False);
-
-- Nothing more to do if conversion was rewritten
if Nkind (N) /= N_Type_Conversion then
-- Nothing at all to do if conversion is to the identical type so remove
-- the conversion completely, it is useless, except that it may carry
-- an Assignment_OK attribute, which must be propagated to the operand
- -- and the Do_Range_Check flag on Operand should be taken into account.
+ -- and the Do_Range_Check flag on the operand must be cleared, if any.
if Operand_Type = Target_Type then
if Assignment_OK (N) then
Set_Assignment_OK (Operand);
end if;
- Rewrite (N, Relocate_Node (Operand));
-
- if Do_Range_Check (Operand) then
- pragma Assert (Is_Discrete_Type (Operand_Type));
+ Set_Do_Range_Check (Operand, False);
- Discrete_Range_Check;
- end if;
+ Rewrite (N, Relocate_Node (Operand));
goto Done;
end if;
if Is_Fixed_Point_Type (Target_Type) then
Expand_Convert_Fixed_To_Fixed (N);
- Real_Range_Check;
-
elsif Is_Integer_Type (Target_Type) then
Expand_Convert_Fixed_To_Integer (N);
- Discrete_Range_Check;
-
else
pragma Assert (Is_Floating_Point_Type (Target_Type));
Expand_Convert_Fixed_To_Float (N);
- Real_Range_Check;
end if;
-- Case of conversions to a fixed-point type
then
if Is_Integer_Type (Operand_Type) then
Expand_Convert_Integer_To_Fixed (N);
- Real_Range_Check;
else
pragma Assert (Is_Floating_Point_Type (Operand_Type));
Expand_Convert_Float_To_Fixed (N);
- Real_Range_Check;
end if;
-- Case of array conversions
-- Here at end of processing
<<Done>>
- pragma Assert (not Do_Range_Check (N));
-
-- Apply predicate check if required. Note that we can't just call
-- Apply_Predicate_Check here, because the type looks right after
-- the conversion and it would omit the check. The Comes_From_Source
Simplify_Type_Conversion (N);
-- If after evaluation we still have a type conversion, then we may need
- -- to apply checks required for a subtype conversion.
-
- -- Skip these type conversion checks if universal fixed operands
- -- are involved, since range checks are handled separately for
- -- these cases (in the appropriate Expand routines in unit Exp_Fixd).
+ -- to apply checks required for a subtype conversion. But skip them if
+ -- universal fixed operands are involved, since range checks are handled
+ -- separately for these cases, after the expansion done by Exp_Fixd.
if Nkind (N) = N_Type_Conversion
and then not Is_Generic_Type (Root_Type (Target_Typ))
and then Target_Typ /= Universal_Fixed
- and then Operand_Typ /= Universal_Fixed
+ and then Etype (Operand) /= Universal_Fixed
then
Apply_Type_Conversion_Checks (N);
end if;
(N, Target_Typ, Static_Failure_Is_Error => True);
end if;
- -- If at this stage we have a fixed point to integer conversion, make
- -- sure that the Do_Range_Check flag is set which is not always done
- -- by exp_fixd.adb.
+ -- If at this stage we have a fixed to integer conversion, make sure the
+ -- Do_Range_Check flag is set, because such conversions in general need
+ -- a range check. We only need this if expansion is off, see above why.
if Nkind (N) = N_Type_Conversion
+ and then not Expander_Active
and then Is_Integer_Type (Target_Typ)
and then Is_Fixed_Point_Type (Operand_Typ)
and then not Range_Checks_Suppressed (Target_Typ)
projects / gcc.git / commitdiff