[Ada] No range check on fixed point to integer conversion

gcc/ada/

	* checks.adb (Apply_Type_Conversion_Checks): Minor code clean
	up.
	* exp_ch4.adb (Discrete_Range_Check): Optimize range checks.
	Update comments.
	(Expand_N_Type_Conversion): Generate range check when rewriting
	a type conversion if needed. Add assertion.
	* exp_ch6.adb (Expand_Simple_Function_Return): Minor code clean
	up.
	* sem_res.adb (Resolve_Type_Conversion): Apply range check when
	needed.  Update comments.

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 4eebfd7b7cb05ce965fdb9893ffd1255fe8bac40..cfbb4bc9fcfc75b943fc6e6ecdb0c3b9d17f8add 100644 (file)
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -3646,14 +3646,10 @@ package body Checks is
                             (Entity (High_Bound (Scalar_Range (Enum_T))));
                      end if;
 
-                     if Last_E <= Last_I then
-                        null;
-
-                     else
+                     if Last_E > Last_I then
                         Activate_Overflow_Check (N);
                      end if;
                   end;
-
                else
                   Activate_Overflow_Check (N);
                end if;
@@ -3666,7 +3662,6 @@ package body Checks is
                  and then not GNATprove_Mode
                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

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 6622a16c9834ded35b59d90d6335c2cbb54563b4..7139e4948b3540206a37ab9fbbb76d8b4ae2ce4c 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -11447,7 +11447,12 @@ package body Exp_Ch4 is
       --  Start of processing for Discrete_Range_Check
 
       begin
-         --  Nothing to do if conversion was rewritten
+         --  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
             return;
@@ -11455,6 +11460,16 @@ package body Exp_Ch4 is
 
          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);
+
          --  Nothing to do if range checks suppressed
 
          if Range_Checks_Suppressed (Target_Type) then
@@ -11473,23 +11488,20 @@ package body Exp_Ch4 is
          --  Before we do a range check, we have to deal with treating
          --  a fixed-point operand as an integer. The way we do this
          --  is simply to do an unchecked conversion to an appropriate
-         --  integer type large enough to hold the result.
+         --  integer type with the smallest size, so that we can suppress
+         --  trivial checks.
 
          if Is_Fixed_Point_Type (Etype (Expr)) then
-            if Esize (Base_Type (Etype (Expr))) > Standard_Integer_Size then
-               Ityp := Standard_Long_Long_Integer;
-            else
-               Ityp := Standard_Integer;
-            end if;
+            Ityp := Small_Integer_Type_For
+                      (Esize (Base_Type (Etype (Expr))), False);
 
-            --  Generate a temporary with the large type to facilitate in the C
-            --  backend the code generation for the unchecked conversion.
+            --  Generate a temporary with the integer type to facilitate in the
+            --  C backend the code generation for the unchecked conversion.
 
             if Modify_Tree_For_C then
                Generate_Temporary;
             end if;
 
-            Set_Do_Range_Check (Expr, False);
             Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr));
          end if;
 
@@ -11726,7 +11738,12 @@ package body Exp_Ch4 is
          Tnn    : Entity_Id;
 
       begin
-         --  Nothing to do if conversion was rewritten
+         --  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
             return;
@@ -11734,7 +11751,7 @@ package body Exp_Ch4 is
 
          Expr := Expression (N);
 
-         --  Clear the flag once for all
+         --  Clear the Do_Range_Check flag on Expr
 
          Set_Do_Range_Check (Expr, False);
 
@@ -12009,7 +12026,8 @@ package body Exp_Ch4 is
 
       --  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.
+      --  an Assignment_OK attribute, which must be propagated to the operand
+      --  and the Do_Range_Check flag on Operand should be taken into account.
 
       if Operand_Type = Target_Type then
          if Assignment_OK (N) then
@@ -12017,6 +12035,13 @@ package body Exp_Ch4 is
          end if;
 
          Rewrite (N, Relocate_Node (Operand));
+
+         if Do_Range_Check (Operand) then
+            pragma Assert (Is_Discrete_Type (Operand_Type));
+
+            Discrete_Range_Check;
+         end if;
+
          goto Done;
       end if;
 
@@ -12125,7 +12150,7 @@ package body Exp_Ch4 is
       --  in Checks.Apply_Arithmetic_Overflow_Check, but we catch more cases in
       --  the processing here. Also we still need the Checks circuit, since we
       --  have to be sure not to generate junk overflow checks in the first
-      --  place, since it would be trick to remove them here.
+      --  place, since it would be tricky to remove them here.
 
       if Integer_Promotion_Possible (N) then
 
@@ -12409,7 +12434,9 @@ package body Exp_Ch4 is
       --  These conversions require special expansion and processing, found in
       --  the Exp_Fixd package. We ignore cases where Conversion_OK is set,
       --  since from a semantic point of view, these are simple integer
-      --  conversions, which do not need further processing.
+      --  conversions, which do not need further processing except for the
+      --  generation of range checks, which is performed at the end of this
+      --  procedure.
 
       elsif Is_Fixed_Point_Type (Operand_Type)
         and then not Conversion_OK (N)
@@ -12617,11 +12644,15 @@ package body Exp_Ch4 is
          then
             Real_Range_Check;
          end if;
+
+         pragma Assert (not Do_Range_Check (Expression (N)));
       end if;
 
       --  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

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index c059ee6276e596b6a8647cef56f2914bd97bd65c..20506c807ef6b557fb5e5d3b4e10a98520980cfb 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7457,10 +7457,9 @@ package body Exp_Ch6 is
       --  Check the result expression of a scalar function against the subtype
       --  of the function by inserting a conversion. This conversion must
       --  eventually be performed for other classes of types, but for now it's
-      --  only done for scalars.
-      --  ???
+      --  only done for scalars ???
 
-      if Is_Scalar_Type (Exp_Typ) then
+      if Is_Scalar_Type (Exp_Typ) and then Exp_Typ /= R_Type then
          Rewrite (Exp, Convert_To (R_Type, Exp));
 
          --  The expression is resolved to ensure that the conversion gets

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index cd87ec235afe0a8da094309b8a7fef65b2829d47..1ca62ecaddca221e6aea75f8b59c84f7d1bcbb3e 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -11641,12 +11641,12 @@ package body Sem_Res is
       --  to apply checks required for a subtype conversion.
 
       --  Skip these type conversion checks if universal fixed operands
-      --  operands involved, since range checks are handled separately for
+      --  are involved, since range checks are handled separately for
       --  these cases (in the appropriate Expand routines in unit 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 Target_Typ /= Universal_Fixed
         and then Operand_Typ /= Universal_Fixed
       then
          Apply_Type_Conversion_Checks (N);
@@ -11886,19 +11886,13 @@ package body Sem_Res is
            (N, Target_Typ, Static_Failure_Is_Error => True);
       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.
-      --  In GNATprove mode, we only do that when converting from fixed-point
-      --  (as floating-point to integer conversions are now handled in
-      --  GNATprove mode).
+      --  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 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)
-                   or else (not GNATprove_Mode
-                             and then Is_Floating_Point_Type (Operand_Typ)))
+        and then Is_Fixed_Point_Type (Operand_Typ)
         and then not Range_Checks_Suppressed (Target_Typ)
         and then not Range_Checks_Suppressed (Operand_Typ)
       then