OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/34398 (BOZ literals: Range checks) 

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.

From-SVN: r130932
This commit is contained in:
Tobias Burnus 2007-12-14 16:11:17 +01:00 committed by Tobias Burnus
parent ae4dbd44ba
commit 4956b1f147
6 changed files with 66 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -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

6
gcc/fortran/arith.c
View File

@ -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:

17
gcc/fortran/expr.c
View File

@ -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))

17
gcc/fortran/resolve.c
View File

@ -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;
}
}

5
gcc/testsuite/ChangeLog
View File

@ -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

15
gcc/testsuite/gfortran.dg/nan_4.f90 Normal file
View File

@ -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