diff mbox series

[Ada] Fix problematic conversion of real literal in static context

Message ID 20211020192755.GA3154314@adacore.com
State New
Headers show
Series [Ada] Fix problematic conversion of real literal in static context | expand

Commit Message

Pierre-Marie de Rodat Oct. 20, 2021, 7:27 p.m. UTC 
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.
diff mbox series

Patch

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -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.