This updated patch addresses the issues with infinities, nans, characters, and
valid reals.
OK for trunk?
Test case attached.
Regards,
Jerry
Index: list_read.c
===================================================================
--- list_read.c (revision 194731)
+++ list_read.c (working copy)
@@ -697,6 +697,7 @@ read_logical (st_parameter_dt *dtp, int length)
break;
CASE_SEPARATORS:
+ case EOF:
unget_char (dtp, c);
eat_separator (dtp);
return; /* Null value. */
@@ -951,6 +952,7 @@ read_character (st_parameter_dt *dtp, int length _
break;
CASE_SEPARATORS:
+ case EOF:
unget_char (dtp, c); /* NULL value. */
eat_separator (dtp);
return;
@@ -975,8 +977,7 @@ read_character (st_parameter_dt *dtp, int length _
for (;;)
{
- if ((c = next_char (dtp)) == EOF)
- goto eof;
+ c = next_char (dtp);
switch (c)
{
CASE_DIGITS:
@@ -984,6 +985,7 @@ read_character (st_parameter_dt *dtp, int length _
break;
CASE_SEPARATORS:
+ case EOF:
unget_char (dtp, c);
goto done; /* String was only digits! */
@@ -1041,7 +1043,7 @@ read_character (st_parameter_dt *dtp, int length _
the string. */
if ((c = next_char (dtp)) == EOF)
- goto eof;
+ goto done_eof;
if (c == quote)
{
push_char (dtp, quote);
@@ -1167,6 +1169,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, in
goto exp2;
CASE_SEPARATORS:
+ case EOF:
goto done;
default:
@@ -1202,6 +1205,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, in
break;
CASE_SEPARATORS:
+ case EOF:
unget_char (dtp, c);
goto done;
@@ -1243,7 +1247,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, in
&& ((c = next_char (dtp)) == 'y' || c == 'Y')
&& (c = next_char (dtp))))
{
- if (is_separator (c))
+ if (is_separator (c) || (c == EOF))
unget_char (dtp, c);
push_char (dtp, 'i');
push_char (dtp, 'n');
@@ -1255,7 +1259,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, in
&& ((c = next_char (dtp)) == 'n' || c == 'N')
&& (c = next_char (dtp)))
{
- if (is_separator (c))
+ if (is_separator (c) || (c == EOF))
unget_char (dtp, c);
push_char (dtp, 'n');
push_char (dtp, 'a');
@@ -1269,7 +1273,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, in
goto bad;
c = next_char (dtp);
- if (is_separator (c))
+ if (is_separator (c) || (c == EOF))
unget_char (dtp, c);
}
goto done_infnan;
@@ -1315,6 +1319,7 @@ read_complex (st_parameter_dt *dtp, void * dest, i
break;
CASE_SEPARATORS:
+ case EOF:
unget_char (dtp, c);
eat_separator (dtp);
return;
@@ -1369,7 +1374,7 @@ eol_4:
goto bad_complex;
c = next_char (dtp);
- if (!is_separator (c))
+ if (!is_separator (c) && (c != EOF))
goto bad_complex;
unget_char (dtp, c);
@@ -1429,6 +1434,7 @@ read_real (st_parameter_dt *dtp, void * dest, int
goto got_sign;
CASE_SEPARATORS:
+ case EOF:
unget_char (dtp, c); /* Single null. */
eat_separator (dtp);
return;
@@ -1484,6 +1490,7 @@ read_real (st_parameter_dt *dtp, void * dest, int
goto got_repeat;
CASE_SEPARATORS:
+ case EOF:
if (c != '\n' && c != ',' && c != '\r' && c != ';')
unget_char (dtp, c);
goto done;
@@ -1647,7 +1654,7 @@ read_real (st_parameter_dt *dtp, void * dest, int
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
- if (!is_separator (c))
+ if (!is_separator (c) && (c != EOF))
{
if (c != 'i' && c != 'I')
goto unwind;
@@ -1700,7 +1707,7 @@ read_real (st_parameter_dt *dtp, void * dest, int
}
}
- if (!is_separator (c))
+ if (!is_separator (c) && (c != EOF))
goto unwind;
if (dtp->u.p.namelist_mode)
@@ -2537,16 +2544,16 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info
switch (nl->type)
{
case BT_INTEGER:
- read_integer (dtp, len);
- break;
+ read_integer (dtp, len);
+ break;
case BT_LOGICAL:
- read_logical (dtp, len);
- break;
+ read_logical (dtp, len);
+ break;
case BT_CHARACTER:
- read_character (dtp, len);
- break;
+ read_character (dtp, len);
+ break;
case BT_REAL:
/* Need to copy data back from the real location to the temp in order
! { dg-do run }
! PR55818 Reading a REAL from a file which doesn't end in a new line fails
! Test case from PR reporter.
implicit none
integer :: stat
!integer :: var ! << works
real :: var ! << fails
character(len=10) :: cvar ! << fails
complex :: cval
open(99, file="test.dat", access="stream", form="unformatted", status="new")
write(99) "1", new_line("")
write(99) "2", new_line("")
write(99) "3"
close(99)
! Test character kind
open(99, file="test.dat")
read (99,*, iostat=stat) cvar
if (stat /= 0 .or. cvar /= "1") call abort()
read (99,*, iostat=stat) cvar
if (stat /= 0 .or. cvar /= "2") call abort()
read (99,*, iostat=stat) cvar ! << FAILS: stat /= 0
if (stat /= 0 .or. cvar /= "3") call abort() ! << aborts here
! Test real kind
rewind(99)
read (99,*, iostat=stat) var
if (stat /= 0 .or. var /= 1.0) call abort()
read (99,*, iostat=stat) var
if (stat /= 0 .or. var /= 2.0) call abort()
read (99,*, iostat=stat) var ! << FAILS: stat /= 0
if (stat /= 0 .or. var /= 3.0) call abort()
close(99, status="delete")
! Test combinations of Inf and Nan
open(99, file="test.dat", access="stream", form="unformatted", status="new")
write(99) "infinity", new_line("")
write(99) "nan", new_line("")
write(99) "infinity"
close(99)
open(99, file="test.dat")
read (99,*, iostat=stat) var
if (stat /= 0) call abort()
read (99,*, iostat=stat) var
if (stat /= 0) call abort()
read (99,*) var ! << FAILS: stat /= 0
if (stat /= 0) call abort ! << aborts here
close(99, status="delete")
open(99, file="test.dat", access="stream", form="unformatted", status="new")
write(99) "infinity", new_line("")
write(99) "inf", new_line("")
write(99) "nan"
close(99)
open(99, file="test.dat")
read (99,*, iostat=stat) var
if (stat /= 0) call abort()
read (99,*, iostat=stat) var
if (stat /= 0) call abort()
read (99,*) var ! << FAILS: stat /= 0
if (stat /= 0) call abort ! << aborts here
close(99, status="delete")
open(99, file="test.dat", access="stream", form="unformatted", status="new")
write(99) "infinity", new_line("")
write(99) "nan", new_line("")
write(99) "inf"
close(99)
open(99, file="test.dat")
read (99,*, iostat=stat) var
if (stat /= 0) call abort()
read (99,*, iostat=stat) var
if (stat /= 0) call abort()
read (99,*) var ! << FAILS: stat /= 0
if (stat /= 0) call abort ! << aborts here
close(99, status="delete")
! Test complex kind
open(99, file="test.dat", access="stream", form="unformatted", status="new")
write(99) "(1,2)", new_line("")
write(99) "(2,3)", new_line("")
write(99) "(4,5)"
close(99)
open(99, file="test.dat")
read (99,*, iostat=stat) cval
if (stat /= 0 .or. cval /= cmplx(1,2)) call abort()
read (99,*, iostat=stat) cval
if (stat /= 0 .or. cval /= cmplx(2,3)) call abort()
read (99,*, iostat=stat) cval ! << FAILS: stat /= 0, value is okay
if (stat /= 0 .or. cval /= cmplx(4,5)) call abort()
close(99, status="delete")
end
