diff options
| author | Tobias Burnus <burnus@gcc.gnu.org> | 2007-12-05 14:42:32 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2007-12-05 14:42:32 +0100 |
| commit | 7b4c5f8b9b0091733b4ae3377e294aa2651f8811 (patch) | |
| tree | 5e83d0d41ff004471fcd506967d79fb199570a11 /gcc/fortran/resolve.c | |
| parent | 59b130b365bbb85a040ee7e1de221cf4aedb691a (diff) | |
| download | gcc-7b4c5f8b9b0091733b4ae3377e294aa2651f8811.zip gcc-7b4c5f8b9b0091733b4ae3377e294aa2651f8811.tar.gz gcc-7b4c5f8b9b0091733b4ae3377e294aa2651f8811.tar.bz2 | |
re PR fortran/34333 (if(nan == nan) wrongly returns TRUE, when nan is a parameter)
2007-12-05 Tobias Burnus <burnus@net-b.de>
PR fortran/34333
* arith.h (gfc_compare_expr): Add operator argument, needed
for compare_real.
* arith.c (gfc_arith_init_1): Use mpfr_min instead of
* mpfr_cmp/set
to account for NaN.
(compare_real): New function, as mpfr_cmp but takes NaN into
account.
(gfc_compare_expr): Use compare_real.
(compare_complex): Take NaN into account.
(gfc_arith_eq,gfc_arith_ne,gfc_arith_gt,gfc_arith_ge,gfc_arith_lt,
gfc_arith_le): Pass operator to gfc_compare_expr.
* resolve.c (compare_cases,resolve_select): Pass operator
to gfc_compare_expr.
* simplify.c (simplify_min_max): Take NaN into account.
2007-12-05 Tobias Burnus <burnus@net-b.de>
PR fortran/34333
* gfortran.dg/nan_2.f90: New.
From-SVN: r130623
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 18 |
1 files changed, 10 insertions, 8 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index eaa15d3..5083b9b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4822,7 +4822,7 @@ compare_cases (const gfc_case *op1, const gfc_case *op2) retval = 0; /* op2 = (M:) or (M:N), L < M */ if (op2->low != NULL - && gfc_compare_expr (op1->high, op2->low) < 0) + && gfc_compare_expr (op1->high, op2->low, INTRINSIC_LT) < 0) retval = -1; } else if (op1->high == NULL) /* op1 = (K:) */ @@ -4831,23 +4831,25 @@ compare_cases (const gfc_case *op1, const gfc_case *op2) retval = 0; /* op2 = (:N) or (M:N), K > N */ if (op2->high != NULL - && gfc_compare_expr (op1->low, op2->high) > 0) + && gfc_compare_expr (op1->low, op2->high, INTRINSIC_GT) > 0) retval = 1; } else /* op1 = (K:L) */ { if (op2->low == NULL) /* op2 = (:N), K > N */ - retval = (gfc_compare_expr (op1->low, op2->high) > 0) ? 1 : 0; + retval = (gfc_compare_expr (op1->low, op2->high, INTRINSIC_GT) > 0) + ? 1 : 0; else if (op2->high == NULL) /* op2 = (M:), L < M */ - retval = (gfc_compare_expr (op1->high, op2->low) < 0) ? -1 : 0; + retval = (gfc_compare_expr (op1->high, op2->low, INTRINSIC_LT) < 0) + ? -1 : 0; else /* op2 = (M:N) */ { retval = 0; /* L < M */ - if (gfc_compare_expr (op1->high, op2->low) < 0) + if (gfc_compare_expr (op1->high, op2->low, INTRINSIC_LT) < 0) retval = -1; /* K > N */ - else if (gfc_compare_expr (op1->low, op2->high) > 0) + else if (gfc_compare_expr (op1->low, op2->high, INTRINSIC_GT) > 0) retval = 1; } } @@ -5122,7 +5124,7 @@ resolve_select (gfc_code *code) /* Unreachable case ranges are discarded, so ignore. */ if (cp->low != NULL && cp->high != NULL && cp->low != cp->high - && gfc_compare_expr (cp->low, cp->high) > 0) + && gfc_compare_expr (cp->low, cp->high, INTRINSIC_GT) > 0) continue; /* FIXME: Should a warning be issued? */ @@ -5210,7 +5212,7 @@ resolve_select (gfc_code *code) if (cp->low != NULL && cp->high != NULL && cp->low != cp->high - && gfc_compare_expr (cp->low, cp->high) > 0) + && gfc_compare_expr (cp->low, cp->high, INTRINSIC_GT) > 0) { if (gfc_option.warn_surprising) gfc_warning ("Range specification at %L can never " |