2007-12-14 Tobias Burnus <burnus@net-b.de>

        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  <burnus@net-b.de>

        PR fortran/34398
        * gfortran.dg/nan_4.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130932 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1000705..40bbc53 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-12-14  Tobias Burnus  <burnus@net-b.de>
+
+       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  <franke.daniel@gmail.com>
 
        PR fortran/34324

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 01d2989..b06aa07 100644 (file)
--- 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 255acb6..92ad77e 100644 (file)
--- 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 c5b95b4..bee74e5 100644 (file)
--- 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 56448f4..d021240 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-12-14  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/34398
+       * gfortran.dg/nan_4.f90: New.
+
 2007-12-14  Richard Guenther  <rguenther@suse.de>
 
        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 (file)
index 0000000..771aad0
--- /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