[multiple changes]

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* sem_ch12.adb: Minor reformatting.

2014-08-04  Arnaud Charlet  <charlet@adacore.com>

	* exp_util.adb, checks.adb (Check_Float_Op_Overflow): Add special
	expansion in CodePeer_Mode.
	(Selected_Range_Checks): Add handling of overflow checks in
	CodePeer_Mode.

From-SVN: r213547

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b273bfc7fa2a01598ea8f2aed3b1ed81b8f77fb0..474921e0726e17aaf4f149c10ceaa58534b38834 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch12.adb: Minor reformatting.
+
+2014-08-04  Arnaud Charlet  <charlet@adacore.com>
+
+       * exp_util.adb, checks.adb (Check_Float_Op_Overflow): Add special
+       expansion in CodePeer_Mode.
+       (Selected_Range_Checks): Add handling of overflow checks in
+       CodePeer_Mode.
+
 2014-08-04  Robert Dewar  <dewar@adacore.com>
 
        * exp_attr.adb (Expand_N_Attribute_Reference, case Pred):

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 1f9493d1d18dc5b43171e5ec4fdecb2b7aca92ce..cddd15a57f916a7f6e9f9727d72db16eb38cd365 100644 (file)
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -391,11 +391,13 @@ package body Checks is
    begin
       --  Nothing to do for unconstrained floating-point types (the test for
       --  Etype (N) being present seems necessary in some cases, should be
-      --  tracked down, but for now just ignore the check in this case ???)
+      --  tracked down, but for now just ignore the check in this case ???),
+      --  except if Check_Float_Overflow is set.
 
       if Present (Etype (N))
         and then Is_Floating_Point_Type (Etype (N))
         and then not Is_Constrained (Etype (N))
+        and then not Check_Float_Overflow
       then
          return;
       end if;
@@ -9212,6 +9214,7 @@ package body Checks is
       Wnode       : Node_Id  := Warn_Node;
       Ret_Result  : Check_Result := (Empty, Empty);
       Num_Checks  : Integer := 0;
+      Reason      : RT_Exception_Code := CE_Range_Check_Failed;
 
       procedure Add_Check (N : Node_Id);
       --  Adds the action given to Ret_Result if N is non-Empty
@@ -9833,6 +9836,16 @@ package body Checks is
          else
             if not In_Subrange_Of (S_Typ, T_Typ) then
                Cond := Discrete_Expr_Cond (Ck_Node, T_Typ);
+
+            --  Special case CodePeer_Mode and apparently redundant checks on
+            --  floating point types: these are used as overflow checks, see
+            --  Exp_Util.Check_Float_Op_Overflow.
+
+            elsif CodePeer_Mode and then Check_Float_Overflow
+              and then Is_Floating_Point_Type (S_Typ)
+            then
+               Cond := Discrete_Expr_Cond (Ck_Node, T_Typ);
+               Reason := CE_Overflow_Check_Failed;
             end if;
          end if;
       end if;
@@ -10027,7 +10040,7 @@ package body Checks is
          Add_Check
            (Make_Raise_Constraint_Error (Loc,
              Condition => Cond,
-             Reason    => CE_Range_Check_Failed));
+             Reason    => Reason));
       end if;
 
       return Ret_Result;

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 481fc37115aa85c6a7de64c4e81e40f3fa8f8fdf..f3ea21fe2bfcc484c583287c795efd11a3b4a835 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1647,6 +1647,28 @@ package body Exp_Util is
          return;
       end if;
 
+      --  Special expansion for CodePeer_Mode: we reuse the Apply_Range_Check
+      --  machinery instead of expanding a 'Valid attribute, since CodePeer
+      --  does not know how to handle expansion of 'Valid on floating point.
+      --  ??? Consider using the same expansion in normal mode. This should
+      --  work assuming division checks are also enabled (to prevent generation
+      --  of NaNs), except for e.g. unchecked conversions which might also
+      --  generate NaNs.
+
+      if CodePeer_Mode then
+         declare
+            Typ : constant Entity_Id := Etype (N);
+         begin
+            --  Prevent recursion
+
+            Set_Analyzed (N);
+
+            Apply_Range_Check (N, Typ);
+            Analyze_And_Resolve (N, Typ);
+            return;
+         end;
+      end if;
+
       --  Otherwise we replace the expression by
 
       --  do Tnn : constant ftype := expression;

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index ada3adc76b849b068876a3fdfcccee6226d9b991..ee6a1d978b4ef0206b999c3b2e3c567e2d1cfe65 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1682,6 +1682,7 @@ package body Sem_Ch12 is
 
                         if Present (Match) then
                            if Nkind (Match) = N_Operator_Symbol then
+
                               --  If the name is a default, find its visible
                               --  entity at the point of instantiation.