Hi all,
The attached patch fixes this PR by removing a spurious call to next_char which
threw off the parsing sequence. In addition, I audited the file for other tests
of EOF and corrected the error handling. This eliminated some wrong error
messages or undefined error messages when an EOF is encountered during a
namelist read.
Also needed to modify hit_eof to not set the file position status for namelist
mode to AFTER_ENDFILE to assure we get the correct EOF error.
Also attached is the original test case from the PR, modified to include some
reads cut short by EOF.
Regression tested on x86-64.
OK for trunk?
Regards,
Jerry
2013-03-29 Jerry DeLisle <jvdeli...@gcc.gnu.org>
PR libfortran/56786
* io/list_read.c (nml_parse_qualifier): Remove spurious next_char call
when checking for EOF. Use error return mechanism when EOF detected.
Do not return false unless parse_err_msg and parse_err_msg_size have
been set. Use hit_eof.
(nml_get_obj_data): Likewise use the correct error mechanism.
* io/transfer.c (hit_eof): Do not set AFTER_ENDFILE if in namelist
mode.
Index: list_read.c
===================================================================
--- list_read.c (revision 197268)
+++ list_read.c (working copy)
@@ -2078,7 +2078,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descrip
/* The next character in the stream should be the '('. */
if ((c = next_char (dtp)) == EOF)
- return false;
+ goto err_ret;
/* Process the qualifier, by dimension and triplet. */
@@ -2092,7 +2092,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descrip
/* Process a potential sign. */
if ((c = next_char (dtp)) == EOF)
- return false;
+ goto err_ret;
switch (c)
{
case '-':
@@ -2110,11 +2110,12 @@ nml_parse_qualifier (st_parameter_dt *dtp, descrip
/* Process characters up to the next ':' , ',' or ')'. */
for (;;)
{
- if ((c = next_char (dtp)) == EOF)
- return false;
-
+ c = next_char (dtp);
switch (c)
{
+ case EOF:
+ goto err_ret;
+
case ':':
is_array_section = 1;
break;
@@ -2137,10 +2138,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descrip
push_char (dtp, c);
continue;
- case ' ': case '\t':
+ case ' ': case '\t': case '\r': case '\n':
eat_spaces (dtp);
- if ((c = next_char (dtp) == EOF))
- return false;
break;
default:
@@ -2282,6 +2281,14 @@ nml_parse_qualifier (st_parameter_dt *dtp, descrip
err_ret:
+ /* Do not return false unless parse_err_msg and parse_err_msg_size have
+ been set. */
+ if (c == EOF)
+ {
+ hit_eof (dtp);
+ dtp->u.p.input_complete = 1;
+ return true;
+ }
return false;
}
@@ -2751,12 +2758,12 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_i
return true;
if ((c = next_char (dtp)) == EOF)
- return false;
+ goto nml_err_ret;
switch (c)
{
case '=':
if ((c = next_char (dtp)) == EOF)
- return false;
+ goto nml_err_ret;
if (c != '?')
{
snprintf (nml_err_msg, nml_err_msg_size,
@@ -2806,8 +2813,9 @@ get_name:
if (!is_separator (c))
push_char (dtp, tolower(c));
if ((c = next_char (dtp)) == EOF)
- return false;
- } while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' ));
+ goto nml_err_ret;
+ }
+ while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' ));
unget_char (dtp, c);
@@ -2882,7 +2890,7 @@ get_name:
qualifier_flag = 1;
if ((c = next_char (dtp)) == EOF)
- return false;
+ goto nml_err_ret;
unget_char (dtp, c);
}
else if (nl->var_rank > 0)
@@ -2909,7 +2917,7 @@ get_name:
component_flag = 1;
if ((c = next_char (dtp)) == EOF)
- return false;
+ goto nml_err_ret;
goto get_name;
}
@@ -2946,7 +2954,7 @@ get_name:
}
if ((c = next_char (dtp)) == EOF)
- return false;
+ goto nml_err_ret;
unget_char (dtp, c);
}
@@ -2986,7 +2994,7 @@ get_name:
return true;
if ((c = next_char (dtp)) == EOF)
- return false;
+ goto nml_err_ret;
if (c != '=')
{
@@ -3021,6 +3029,15 @@ get_name:
nml_err_ret:
+ /* Do not return false unless nml_err_msg and nml_err_msg_size have
+ been set. */
+ if (c == EOF)
+ {
+ dtp->u.p.input_complete = 1;
+ unget_char (dtp, c);
+ hit_eof (dtp);
+ return true;
+ }
return false;
}
Index: transfer.c
===================================================================
--- transfer.c (revision 197268)
+++ transfer.c (working copy)
@@ -3840,7 +3840,7 @@ hit_eof (st_parameter_dt * dtp)
case NO_ENDFILE:
case AT_ENDFILE:
generate_error (&dtp->common, LIBERROR_END, NULL);
- if (!is_internal_unit (dtp))
+ if (!is_internal_unit (dtp) && !dtp->u.p.namelist_mode)
{
dtp->u.p.current_unit->endfile = AFTER_ENDFILE;
dtp->u.p.current_unit->current_record = 0;
! { dg-do run }
! PR56786 Error on embedded spaces
integer :: i(3)
namelist /nml/ i
i = -42
open(99,status='scratch')
write(99,'(a)') '&nml i(3 ) = 5 /'
rewind(99)
read(99,nml=nml)
close(99)
if (i(1)/=-42 .or. i(2)/=-42 .or. i(3)/=5) call abort()
! Shorten the file so the read hits EOF
open(99,status='scratch')
write(99,'(a)') '&nml i(3 ) = 5 '
rewind(99)
read(99,nml=nml, end=30)
call abort()
! Shorten some more
30 close(99)
open(99,status='scratch')
write(99,'(a)') '&nml i(3 ) ='
rewind(99)
read(99,nml=nml, end=40)
call abort()
! Shorten some more
40 close(99)
open(99,status='scratch')
write(99,'(a)') '&nml i(3 )'
rewind(99)
read(99,nml=nml, end=50)
call abort()
! Shorten some more
50 close(99)
open(99,status='scratch')
write(99,'(a)') '&nml i(3 '
rewind(99)
read(99,nml=nml, end=60)
call abort()
60 close(99)
end
