From c9f7e8258a6a36303f7ba5b41528679eb0e74855 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 8 Dec 2007 16:51:52 +0100 Subject: [PATCH] re PR fortran/34319 (I/O: Support "NaN", "Infinity" and "INF" as input) 2007-12-08 Tobias Burnus PR fortran/34319 * io/list_read.c (parse_real, read_real): Support NaN/Infinity. 2007-12-08 Tobias Burnus PR fortran/34319 * gfortran.dg/nan_3.f90: New. From-SVN: r130708 --- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/nan_3.f90 | 45 ++++++++++++++ libgfortran/ChangeLog | 5 ++ libgfortran/io/list_read.c | 93 ++++++++++++++++++++++++++++- 4 files changed, 146 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/nan_3.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 87b83e11c2d..255956afbc5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-12-08 Tobias Burnus + + PR fortran/34319 + * gfortran.dg/nan_3.f90: New. + 2007-12-07 Jakub Jelinek * g++.old-deja/g++.mike/empty.C: Remove 2 xfails. diff --git a/gcc/testsuite/gfortran.dg/nan_3.f90 b/gcc/testsuite/gfortran.dg/nan_3.f90 new file mode 100644 index 00000000000..957b94d214d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/nan_3.f90 @@ -0,0 +1,45 @@ +! { dg-do run } +! { dg-options "-fno-range-check" } +! { dg-options "-fno-range-check -mieee" { target sh*-*-* } } +! +! PR fortran/34319 +! +! Check support of INF/NaN for I/O. +! +program main + implicit none + real :: r + complex :: z + character(len=30) :: str + + str = "nan" + read(str,*) r + if (.not.isnan(r)) call abort() + str = "(nan,4.0)" + read(str,*) z + if (.not.isnan(real(z)) .or. aimag(z) /= 4.0) call abort() + str = "(7.0,nan)" + read(str,*) z + if (.not.isnan(aimag(z)) .or. real(z) /= 7.0) call abort() + + str = "inFinity" + read(str,*) r + if (r <= huge(r)) call abort() + str = "(+inFinity,4.0)" + read(str,*) z + if ((real(z) <= huge(r)) .or. aimag(z) /= 4.0) call abort() + str = "(7.0,-inFinity)" + read(str,*) z + if ((aimag(z) >= -huge(r)) .or. real(z) /= 7.0) call abort() + + str = "inf" + read(str,*) r + if (r <= huge(r)) call abort() + str = "(+inf,4.0)" + read(str,*) z + if ((real(z) <= huge(r)) .or. aimag(z) /= 4.0) call abort() + str = "(7.0,-inf)" + read(str,*) z + if ((aimag(z) >= -huge(r)) .or. real(z) /= 7.0) call abort() + +end program main diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index e77ef147b0a..888633823a9 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,8 @@ +2007-12-08 Tobias Burnus + + PR fortran/34319 + * io/list_read.c (parse_real, read_real): Support NaN/Infinity. + 2007-12-02 Jerry DeLisle Thomas Koenig diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 586e356d105..c2124891532 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -1078,7 +1078,12 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) } if (!isdigit (c) && c != '.') - goto bad; + { + if (c == 'i' || c == 'I' || c == 'n' || c == 'N') + goto inf_nan; + else + goto bad; + } push_char (dtp, c); @@ -1136,6 +1141,13 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) exp2: if (!isdigit (c)) + { + if (c == 'i' || c == 'I' || c == 'n' || c == 'N') + goto inf_nan; + else + goto bad; + } + goto bad; push_char (dtp, c); @@ -1166,6 +1178,41 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) return m; + inf_nan: + /* Match INF and Infinity. */ + if ((c == 'i' || c == 'I') + && ((c = next_char (dtp)) == 'n' || c == 'N') + && ((c = next_char (dtp)) == 'f' || c == 'F')) + { + c = next_char (dtp); + if ((c != 'i' && c != 'I') + || ((c == 'i' || c == 'I') + && ((c = next_char (dtp)) == 'n' || c == 'N') + && ((c = next_char (dtp)) == 'i' || c == 'I') + && ((c = next_char (dtp)) == 't' || c == 'T') + && ((c = next_char (dtp)) == 'y' || c == 'Y') + && (c = next_char (dtp)))) + { + if (is_separator (c)) + unget_char (dtp, c); + push_char (dtp, 'i'); + push_char (dtp, 'n'); + push_char (dtp, 'f'); + goto done; + } + } /* Match NaN. */ + else if (((c = next_char (dtp)) == 'a' || c == 'A') + && ((c = next_char (dtp)) == 'n' || c == 'N') + && (c = next_char (dtp))) + { + if (is_separator (c)) + unget_char (dtp, c); + push_char (dtp, 'n'); + push_char (dtp, 'a'); + push_char (dtp, 'n'); + goto done; + } + bad: if (nml_bad_return (dtp, c)) @@ -1293,6 +1340,12 @@ read_real (st_parameter_dt *dtp, int length) eat_separator (dtp); return; + case 'i': + case 'I': + case 'n': + case 'N': + goto inf_nan; + default: goto bad_real; } @@ -1367,7 +1420,12 @@ read_real (st_parameter_dt *dtp, int length) } if (!isdigit (c) && c != '.') - goto bad_real; + { + if (c == 'i' || c == 'I' || c == 'n' || c == 'N') + goto inf_nan; + else + goto bad_real; + } if (c == '.') { @@ -1464,6 +1522,37 @@ read_real (st_parameter_dt *dtp, int length) dtp->u.p.saved_type = BT_REAL; return; + inf_nan: + /* Match INF and Infinity. */ + if ((c == 'i' || c == 'I') + && ((c = next_char (dtp)) == 'n' || c == 'N') + && ((c = next_char (dtp)) == 'f' || c == 'F')) + { + c = next_char (dtp); + if (is_separator (c) + || ((c == 'i' || c == 'I') + && ((c = next_char (dtp)) == 'n' || c == 'N') + && ((c = next_char (dtp)) == 'i' || c == 'I') + && ((c = next_char (dtp)) == 't' || c == 'T') + && ((c = next_char (dtp)) == 'y' || c == 'Y') + && (c = next_char (dtp)) && is_separator (c))) + { + push_char (dtp, 'i'); + push_char (dtp, 'n'); + push_char (dtp, 'f'); + goto done; + } + } /* Match NaN. */ + else if (((c = next_char (dtp)) == 'a' || c == 'A') + && ((c = next_char (dtp)) == 'n' || c == 'N') + && (c = next_char (dtp)) && is_separator (c)) + { + push_char (dtp, 'n'); + push_char (dtp, 'a'); + push_char (dtp, 'n'); + goto done; + } + bad_real: if (nml_bad_return (dtp, c))