This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR 34319 - Accept NaN/Infinity in I/O
- From: Tobias Burnus <tobias dot burnus at physik dot fu-berlin dot de>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Fri, 7 Dec 2007 23:29:07 +0100
- Subject: [Patch, Fortran] PR 34319 - Accept NaN/Infinity in I/O
:ADDPATCH fortran:
This patch allows for complex and real the input of NaN and
Inf/Infinity.
Build and regression tested on x86-64-linux.
OK for the trunk?
Tobias
2007-12-07 Tobias Burnus <burnus@net-b.de>
PR fortran/34319
* io/list_read.c (parse_real, read_real): Support NaN/Infinity.
2007-12-07 Tobias Burnus <burnus@net-b.de>
PR fortran/34319
* gfortran.dg/nan_3.f90: New.
Index: libgfortran/io/list_read.c
===================================================================
--- libgfortran/io/list_read.c (Revision 130671)
+++ libgfortran/io/list_read.c (Arbeitskopie)
@@ -1078,7 +1078,12 @@ parse_real (st_parameter_dt *dtp, void *
}
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 *
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 *
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 len
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 len
}
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 len
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))
Index: gcc/testsuite/gfortran.dg/nan_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/nan_3.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/nan_3.f90 (Revision 0)
@@ -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