[Ada] Fix problematic conversion of real literal in static context
Commit Message
This gets rid of a bogus error issued for the conversion to a static
floating-point subtype of a named number which is not a machine number
of this floating-point subtype but happens to be very close (or equal)
to one of the nominal bounds of the subtype.
This conversion may not change the value of this named number in a
static context but needs to take into account the stored bounds of
the subtype, which are machine numbers, to raise Constraint_Error.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_eval.adb (Eval_Type_Conversion): If the target subtype is
a static floating-point subtype and the result is a real literal,
consider its machine-rounded value to raise Constraint_Error.
(Test_In_Range): Turn local variables into constants.
@@ -4352,7 +4352,25 @@ package body Sem_Eval is
Fold_Uint (N, Expr_Value (Operand), Stat);
end if;
- if Is_Out_Of_Range (N, Etype (N), Assume_Valid => True) then
+ -- If the target is a static floating-point subtype, then its bounds
+ -- are machine numbers so we must consider the machine-rounded value.
+
+ if Is_Floating_Point_Type (Target_Type)
+ and then Nkind (N) = N_Real_Literal
+ and then not Is_Machine_Number (N)
+ then
+ declare
+ Lo : constant Node_Id := Type_Low_Bound (Target_Type);
+ Hi : constant Node_Id := Type_High_Bound (Target_Type);
+ Valr : constant Ureal :=
+ Machine_Number (Target_Type, Expr_Value_R (N), N);
+ begin
+ if Valr < Expr_Value_R (Lo) or else Valr > Expr_Value_R (Hi) then
+ Out_Of_Range (N);
+ end if;
+ end;
+
+ elsif Is_Out_Of_Range (N, Etype (N), Assume_Valid => True) then
Out_Of_Range (N);
end if;
end Eval_Type_Conversion;
@@ -7342,19 +7360,12 @@ package body Sem_Eval is
elsif Compile_Time_Known_Value (N) then
declare
- Lo : Node_Id;
- Hi : Node_Id;
-
- LB_Known : Boolean;
- HB_Known : Boolean;
+ Lo : constant Node_Id := Type_Low_Bound (Typ);
+ Hi : constant Node_Id := Type_High_Bound (Typ);
+ LB_Known : constant Boolean := Compile_Time_Known_Value (Lo);
+ HB_Known : constant Boolean := Compile_Time_Known_Value (Hi);
begin
- Lo := Type_Low_Bound (Typ);
- Hi := Type_High_Bound (Typ);
-
- LB_Known := Compile_Time_Known_Value (Lo);
- HB_Known := Compile_Time_Known_Value (Hi);
-
-- Fixed point types should be considered as such only if flag
-- Fixed_Int is set to False.