diff mbox

[Ada] Better range checking in GNATprove mode for float-to-int conversions

Message ID 20170425100939.GA71339@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet April 25, 2017, 10:09 a.m. UTC
Range checks are now optimized away on float-to-int conversions when
bound analysis can determine that the value is always in range. This is
only possible in GNATprove mode, where NaN and infinite values are ruled
out by the analysis. Also improve the computation of bounds for
expressions that involve conversions from float to int, also only in
GNATprove mode.

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-04-25  Yannick Moy  <moy@adacore.com>

	* checks.adb (Apply_Scalar_Range_Check): Analyze precisely
	conversions from float to integer in GNATprove mode.
	(Apply_Type_Conversion_Checks): Make sure in GNATprove mode
	to call Apply_Type_Conversion_Checks, so that range checks
	are properly positioned when needed on conversions, including
	when converting from float to integer.	(Determine_Range): In
	GNATprove mode, take into account the possibility of conversion
	from float to integer.
	* sem_res.adb (Resolve_Type_Conversion): Only enforce range
	check on conversions from fixed-point to integer, not anymore
	on conversions from floating-point to integer, when in GNATprove
	mode.
diff mbox

Patch

Index: checks.adb
===================================================================
--- checks.adb	(revision 247172)
+++ checks.adb	(working copy)
@@ -2943,20 +2943,24 @@ 
 
       --  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.
+
       --  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))
+        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
          declare
             Tlo : constant Node_Id := Type_Low_Bound  (Target_Typ);
             Thi : constant Node_Id := Type_High_Bound (Target_Typ);
-            Lo  : Uint;
-            Hi  : Uint;
 
          begin
             if Compile_Time_Known_Value (Tlo)
@@ -2965,6 +2969,8 @@ 
                declare
                   Lov : constant Uint := Expr_Value (Tlo);
                   Hiv : constant Uint := Expr_Value (Thi);
+                  Lo  : Uint;
+                  Hi  : Uint;
 
                begin
                   --  If range is null, we for sure have a constraint error
@@ -2991,8 +2997,35 @@ 
 
                   --  Otherwise determine range of value
 
-                  Determine_Range (Expr, OK, Lo, Hi, Assume_Valid => True);
+                  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
+                        Lor : Ureal;
+                        Hir : 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;
+
                   if OK then
 
                      --  If definitely in range, all OK
@@ -3449,7 +3482,9 @@ 
             if not Range_Checks_Suppressed (Target_Type)
               and then not Range_Checks_Suppressed (Expr_Type)
             then
-               if Float_To_Int then
+               if Float_To_Int
+                 and then not GNATprove_Mode
+               then
                   Apply_Float_Conversion_Check (Expr, Target_Type);
                else
                   Apply_Scalar_Range_Check
@@ -4688,12 +4723,40 @@ 
 
             end case;
 
-         --  For type conversion from one discrete type to another, we can
-         --  refine the range using the converted value.
-
          when N_Type_Conversion =>
-            Determine_Range (Expression (N), OK1, Lor, Hir, Assume_Valid);
 
+            --  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;
+
          --  Nothing special to do for all other expression kinds
 
          when others =>
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 247157)
+++ sem_res.adb	(working copy)
@@ -11053,15 +11053,19 @@ 
          end if;
       end if;
 
-      --  If at this stage we have a real to integer conversion, make sure
-      --  that the Do_Range_Check flag is set, because such conversions in
-      --  general need a range check. We only need this if expansion is off
-      --  or we are in GNATProve mode.
+      --  If at this stage we have a real to integer conversion, make sure that
+      --  the Do_Range_Check flag is set, because such conversions in general
+      --  need a range check. We only need this if expansion is off, or we are
+      --  in GNATprove mode and the conversion if from fixed-point to integer
+      --  (as floating-point to integer conversions are now handled in
+      --  GNATprove mode).
 
       if Nkind (N) = N_Type_Conversion
-        and then (GNATprove_Mode or not Expander_Active)
+        and then not Expander_Active
         and then Is_Integer_Type (Target_Typ)
-        and then Is_Real_Type (Operand_Typ)
+        and then (Is_Real_Type (Operand_Typ)
+                   or else (GNATprove_Mode
+                             and then Is_Fixed_Point_Type (Operand_Typ)))
       then
          Set_Do_Range_Check (Operand);
       end if;