diff options
| author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-12-05 13:42:32 +0000 |
|---|---|---|
| committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-12-05 13:42:32 +0000 |
| commit | 134eab896ef229741f55025f4e457b6432bb48ba (patch) | |
| tree | 5e83d0d41ff004471fcd506967d79fb199570a11 /gcc/fortran/resolve.c | |
| parent | 3304ca2b022fad0aa122eeed7ff170c2fb84218e (diff) | |
| download | ppe42-gcc-134eab896ef229741f55025f4e457b6432bb48ba.tar.gz ppe42-gcc-134eab896ef229741f55025f4e457b6432bb48ba.zip | |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130623 138bc75d-0d04-0410-961f-82ee72b054a4
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 eaa15d3962f..5083b9b3be9 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 " |
