diff options
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/nan_6.f90 | 99 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 5 | ||||
| -rw-r--r-- | libgfortran/io/list_read.c | 29 |
4 files changed, 138 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 16e1c670a61..5f0ea3fbd1e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-06-28 Tobias Burnus <burnus@net-b.de> + + PR fortran/43298 + * gfortran.dg/nan_6.f90: New. + 2010-06-28 H.J. Lu <hongjiu.lu@intel.com> PR tree-optimization/43781 diff --git a/gcc/testsuite/gfortran.dg/nan_6.f90 b/gcc/testsuite/gfortran.dg/nan_6.f90 new file mode 100644 index 00000000000..8f0af294420 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/nan_6.f90 @@ -0,0 +1,99 @@ +! { dg-do run } +! { dg-add-options ieee } +! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } } +! +! List-directed part of PR fortran/43298 +! and follow up to PR fortran/34319. +! +! Check handling of "NAN(alphanum)" +! +character(len=200) :: str +real :: r +complex :: z + +! read_real: + +r = 1.0 +str = 'INfinity' ; read(str,*) r +if (r < 0 .or. r /= r*1.1) call abort() + +r = 1.0 +str = '-INF' ; read(str,*) r +if (r > 0 .or. r /= r*1.1) call abort() + +r = 1.0 +str = '+INF' ; read(str,*) r +if (r < 0 .or. r /= r*1.1) call abort() + +r = 1.0 +str = '-inFiniTY' ; read(str,*) r +if (r > 0 .or. r /= r*1.1) call abort() + +r = 1.0 +str = 'NAN' ; read(str,*) r +if (.not. isnan(r)) call abort() + +r = 1.0 +str = '-NAN' ; read(str,*) r +if (.not. isnan(r)) call abort() + +r = 1.0 +str = '+NAN' ; read(str,*) r +if (.not. isnan(r)) call abort() + +r = 1.0 +str = 'NAN(0x111)' ; read(str,*) r +if (.not. isnan(r)) call abort() + +r = 1.0 +str = '-NAN(123)' ; read(str,*) r +if (.not. isnan(r)) call abort() + +r = 1.0 +str = '+NAN(0xFFE)' ; read(str,*) r +if (.not. isnan(r)) call abort() + + +! parse_real + +z = cmplx(-2.0,-4.0) +str = '(0.0,INfinity)' ; read(str,*) z +if (aimag(z) < 0 .or. aimag(z) /= aimag(z)*1.1) call abort() + +z = cmplx(-2.0,-4.0) +str = '(-INF,0.0)' ; read(str,*) z +if (real(z) > 0 .or. real(z) /= real(z)*1.1) call abort() + +z = cmplx(-2.0,-4.0) +str = '(0.0,+INF)' ; read(str,*) z +if (aimag(z) < 0 .or. aimag(z) /= aimag(z)*1.1) call abort() + +z = cmplx(-2.0,-4.0) +str = '(-inFiniTY,0.0)' ; read(str,*) z +if (real(z) > 0 .or. real(z) /= real(z)*1.1) call abort() + +z = cmplx(-2.0,-4.0) +str = '(NAN,0.0)' ; read(str,*) z +if (.not. isnan(real(z))) call abort() + +z = cmplx(-2.0,-4.0) +str = '(0.0,-NAN)' ; read(str,*) z +if (.not. isnan(aimag(z))) call abort() + +z = cmplx(-2.0,-4.0) +str = '(+NAN,0.0)' ; read(str,*) z +if (.not. isnan(real(z))) call abort() + +z = cmplx(-2.0,-4.0) +str = '(NAN(0x111),0.0)' ; read(str,*) z +if (.not. isnan(real(z))) call abort() + +z = cmplx(-2.0,-4.0) +str = '(0.0,-NaN(123))' ; read(str,*) z +if (.not. isnan(aimag(z))) call abort() + +z = cmplx(-2.0,-4.0) +str = '(+nan(0xFFE),0.0)' ; read(str,*) z +if (.not. isnan(real(z))) call abort() + +end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 3c2c75cd1b1..33a312cebdc 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,8 @@ +2010-06-28 Tobias Burnus <burnus@net-b.de> + + PR fortran/43298 + * list_read.c (parse_real, read_real): Support NAN(alphanum). + 2010-06-25 Tobias Burnus <burnus@net-b.de> * intrinsics/selected_real_kind.f90 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 798521d62ad..72016b73e29 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -1199,6 +1199,21 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) push_char (dtp, 'n'); push_char (dtp, 'a'); push_char (dtp, 'n'); + + /* Match "NAN(alphanum)". */ + if (c == '(') + { + for ( ; c != ')'; c = next_char (dtp)) + if (is_separator (c)) + goto bad; + else + push_char (dtp, c); + + push_char (dtp, ')'); + c = next_char (dtp); + if (is_separator (c)) + unget_char (dtp, c); + } goto done; } @@ -1576,6 +1591,20 @@ read_real (st_parameter_dt *dtp, void * dest, int length) goto unwind; c = next_char (dtp); l_push_char (dtp, c); + + /* Match NAN(alphanum). */ + if (c == '(') + { + for (c = next_char (dtp); c != ')'; c = next_char (dtp)) + if (is_separator (c)) + goto unwind; + else + l_push_char (dtp, c); + + l_push_char (dtp, ')'); + c = next_char (dtp); + l_push_char (dtp, c); + } } if (!is_separator (c)) |