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

re PR fortran/34319 (I/O: Support "NaN", "Infinity" and "INF" as input)

Browse Source 
2007-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34319
        * io/list_read.c (parse_real, read_real): Support NaN/Infinity.

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

        PR fortran/34319
        * gfortran.dg/nan_3.f90: New.

From-SVN: r130708
This commit is contained in:
Tobias Burnus 2007-12-08 16:51:52 +01:00 committed by Tobias Burnus
parent f10d132b68
commit c9f7e8258a
4 changed files with 146 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/34319
* gfortran.dg/nan_3.f90: New.
2007-12-07 Jakub Jelinek <jakub@redhat.com>
* g++.old-deja/g++.mike/empty.C: Remove 2 xfails.

45
gcc/testsuite/gfortran.dg/nan_3.f90 Normal file
View File

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

5
libgfortran/ChangeLog
View File

@ -1,3 +1,8 @@
2007-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/34319
* io/list_read.c (parse_real, read_real): Support NaN/Infinity.
2007-12-02 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Thomas Koenig <tkoenig@gcc.gnu.org>

93
libgfortran/io/list_read.c
View File

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