From: Tobias Burnus Date: Fri, 14 Dec 2007 15:11:17 +0000 (+0100) Subject: re PR fortran/34398 (BOZ literals: Range checks) X-Git-Tag: releases/gcc-4.3.0~984 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=4956b1f14709e967ec5a374a4f9f5bcdadaea480;p=thirdparty%2Fgcc.git re PR fortran/34398 (BOZ literals: Range checks) 2007-12-14 Tobias Burnus PR fortran/34398 * expr.c (gfc_check_assign): Add range checks for assignments of * BOZs. * resolve.c (resolve_ordinary_assign): Ditto. * arith.c (gfc_range_check): Fix return value for complex * numbers. 2007-12-14 Tobias Burnus PR fortran/34398 * gfortran.dg/nan_4.f90: New. From-SVN: r130932 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1000705a2fb3..40bbc53385dd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-12-14 Tobias Burnus + + PR fortran/34398 + * expr.c (gfc_check_assign): Add range checks for assignments of BOZs. + * resolve.c (resolve_ordinary_assign): Ditto. + * arith.c (gfc_range_check): Fix return value for complex numbers. + 2007-12-14 Daniel Franke PR fortran/34324 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 01d2989f3169..b06aa078c8aa 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -532,6 +532,7 @@ arith gfc_range_check (gfc_expr *e) { arith rc; + arith rc2; switch (e->ts.type) { @@ -558,13 +559,16 @@ gfc_range_check (gfc_expr *e) if (rc == ARITH_NAN) mpfr_set_nan (e->value.complex.r); - rc = gfc_check_real_range (e->value.complex.i, e->ts.kind); + rc2 = gfc_check_real_range (e->value.complex.i, e->ts.kind); if (rc == ARITH_UNDERFLOW) mpfr_set_ui (e->value.complex.i, 0, GFC_RND_MODE); if (rc == ARITH_OVERFLOW) mpfr_set_inf (e->value.complex.i, mpfr_sgn (e->value.complex.i)); if (rc == ARITH_NAN) mpfr_set_nan (e->value.complex.i); + + if (rc == ARITH_OK) + rc = rc2; break; default: diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 255acb6f188d..92ad77e37a44 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2755,11 +2755,28 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) /* Handle the case of a BOZ literal on the RHS. */ if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER) { + int rc; if (gfc_option.warn_surprising) gfc_warning ("BOZ literal at %L is bitwise transferred " "non-integer symbol '%s'", &rvalue->where, lvalue->symtree->n.sym->name); gfc_convert_boz (rvalue, &lvalue->ts); + if ((rc = gfc_range_check (rvalue)) != ARITH_OK) + { + if (rc == ARITH_UNDERFLOW) + gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L" + ". This check can be disabled with the option " + "-fno-range-check", &rvalue->where); + else if (rc == ARITH_OVERFLOW) + gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L" + ". This check can be disabled with the option " + "-fno-range-check", &rvalue->where); + else if (rc == ARITH_NAN) + gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L" + ". This check can be disabled with the option " + "-fno-range-check", &rvalue->where); + return FAILURE; + } } if (gfc_compare_types (&lvalue->ts, &rvalue->ts)) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c5b95b46a045..bee74e53c426 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5921,12 +5921,29 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) /* Handle the case of a BOZ literal on the RHS. */ if (rhs->is_boz && lhs->ts.type != BT_INTEGER) { + int rc; if (gfc_option.warn_surprising) gfc_warning ("BOZ literal at %L is bitwise transferred " "non-integer symbol '%s'", &code->loc, lhs->symtree->n.sym->name); gfc_convert_boz (rhs, &lhs->ts); + if ((rc = gfc_range_check (rhs)) != ARITH_OK) + { + if (rc == ARITH_UNDERFLOW) + gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L" + ". This check can be disabled with the option " + "-fno-range-check", &rhs->where); + else if (rc == ARITH_OVERFLOW) + gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L" + ". This check can be disabled with the option " + "-fno-range-check", &rhs->where); + else if (rc == ARITH_NAN) + gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L" + ". This check can be disabled with the option " + "-fno-range-check", &rhs->where); + return false; + } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 56448f4202c8..d021240e5570 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-12-14 Tobias Burnus + + PR fortran/34398 + * gfortran.dg/nan_4.f90: New. + 2007-12-14 Richard Guenther PR middle-end/34462 diff --git a/gcc/testsuite/gfortran.dg/nan_4.f90 b/gcc/testsuite/gfortran.dg/nan_4.f90 new file mode 100644 index 000000000000..771aad02fa95 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/nan_4.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! { dg-options "-std=gnu" } +! { dg-options "-std=gnu -mieee" { target sh*-*-* } } +! +! PR fortran/34398. +! +! Check for invalid numbers in bit-wise BOZ transfers +! +program test + implicit none + real(4), parameter :: r0 = z'FFFFFFFF' ! { dg-error "Arithmetic NaN" } + real(4) r + data r/z'FFFFFFFF'/ ! { dg-error "Arithmetic NaN" } + r = z'FFFFFFFF' ! { dg-error "Arithmetic NaN" } +end program test