diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 1 |
4 files changed, 49 insertions, 2 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b273bfc..474921e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,16 @@ 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 diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 1f9493d..cddd15a 100644 --- 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 481fc37..f3ea21f 100644 --- 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 ada3adc..ee6a1d9 100644 --- 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. |