[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

gcc/ada/ChangeLog

 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):
 	Remove special test for Float'First, no longer required.
 	(Expand_N_Attribute_Reference, case Succ): Remove special test

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;

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;

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.