Commit 83437e67 by Jerry DeLisle

re PR libfortran/56786 (Namelist read fails with designators containing embedded spaces)

2013-03-31  Jerry DeLisle  <jvdelisle@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.

From-SVN: r197290
parent ce1731f4
2012-03-29 Tobias Burnus <burnus@net-b.de> 2013-03-31 Jerry DeLisle <jvdelisle@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.
2013-03-29 Tobias Burnus <burnus@net-b.de>
PR fortran/56737 PR fortran/56737
* io/format.c (parse_format_list): Also cache FMT_STRING. * io/format.c (parse_format_list): Also cache FMT_STRING.
......
...@@ -2078,7 +2078,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, ...@@ -2078,7 +2078,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
/* The next character in the stream should be the '('. */ /* The next character in the stream should be the '('. */
if ((c = next_char (dtp)) == EOF) if ((c = next_char (dtp)) == EOF)
return false; goto err_ret;
/* Process the qualifier, by dimension and triplet. */ /* Process the qualifier, by dimension and triplet. */
...@@ -2092,7 +2092,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, ...@@ -2092,7 +2092,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
/* Process a potential sign. */ /* Process a potential sign. */
if ((c = next_char (dtp)) == EOF) if ((c = next_char (dtp)) == EOF)
return false; goto err_ret;
switch (c) switch (c)
{ {
case '-': case '-':
...@@ -2110,11 +2110,12 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, ...@@ -2110,11 +2110,12 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
/* Process characters up to the next ':' , ',' or ')'. */ /* Process characters up to the next ':' , ',' or ')'. */
for (;;) for (;;)
{ {
if ((c = next_char (dtp)) == EOF) c = next_char (dtp);
return false;
switch (c) switch (c)
{ {
case EOF:
goto err_ret;
case ':': case ':':
is_array_section = 1; is_array_section = 1;
break; break;
...@@ -2137,10 +2138,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, ...@@ -2137,10 +2138,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
push_char (dtp, c); push_char (dtp, c);
continue; continue;
case ' ': case '\t': case ' ': case '\t': case '\r': case '\n':
eat_spaces (dtp); eat_spaces (dtp);
if ((c = next_char (dtp) == EOF))
return false;
break; break;
default: default:
...@@ -2282,6 +2281,15 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, ...@@ -2282,6 +2281,15 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
err_ret: err_ret:
/* The EOF error message is issued by hit_eof. Return true so that the
caller does not use parse_err_msg and parse_err_msg_size to generate
an unrelated error message. */
if (c == EOF)
{
hit_eof (dtp);
dtp->u.p.input_complete = 1;
return true;
}
return false; return false;
} }
...@@ -2751,12 +2759,12 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, ...@@ -2751,12 +2759,12 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
return true; return true;
if ((c = next_char (dtp)) == EOF) if ((c = next_char (dtp)) == EOF)
return false; goto nml_err_ret;
switch (c) switch (c)
{ {
case '=': case '=':
if ((c = next_char (dtp)) == EOF) if ((c = next_char (dtp)) == EOF)
return false; goto nml_err_ret;
if (c != '?') if (c != '?')
{ {
snprintf (nml_err_msg, nml_err_msg_size, snprintf (nml_err_msg, nml_err_msg_size,
...@@ -2806,8 +2814,9 @@ get_name: ...@@ -2806,8 +2814,9 @@ get_name:
if (!is_separator (c)) if (!is_separator (c))
push_char (dtp, tolower(c)); push_char (dtp, tolower(c));
if ((c = next_char (dtp)) == EOF) if ((c = next_char (dtp)) == EOF)
return false; goto nml_err_ret;
} while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' )); }
while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' ));
unget_char (dtp, c); unget_char (dtp, c);
...@@ -2882,7 +2891,7 @@ get_name: ...@@ -2882,7 +2891,7 @@ get_name:
qualifier_flag = 1; qualifier_flag = 1;
if ((c = next_char (dtp)) == EOF) if ((c = next_char (dtp)) == EOF)
return false; goto nml_err_ret;
unget_char (dtp, c); unget_char (dtp, c);
} }
else if (nl->var_rank > 0) else if (nl->var_rank > 0)
...@@ -2909,7 +2918,7 @@ get_name: ...@@ -2909,7 +2918,7 @@ get_name:
component_flag = 1; component_flag = 1;
if ((c = next_char (dtp)) == EOF) if ((c = next_char (dtp)) == EOF)
return false; goto nml_err_ret;
goto get_name; goto get_name;
} }
...@@ -2946,7 +2955,7 @@ get_name: ...@@ -2946,7 +2955,7 @@ get_name:
} }
if ((c = next_char (dtp)) == EOF) if ((c = next_char (dtp)) == EOF)
return false; goto nml_err_ret;
unget_char (dtp, c); unget_char (dtp, c);
} }
...@@ -2986,7 +2995,7 @@ get_name: ...@@ -2986,7 +2995,7 @@ get_name:
return true; return true;
if ((c = next_char (dtp)) == EOF) if ((c = next_char (dtp)) == EOF)
return false; goto nml_err_ret;
if (c != '=') if (c != '=')
{ {
...@@ -3021,6 +3030,16 @@ get_name: ...@@ -3021,6 +3030,16 @@ get_name:
nml_err_ret: nml_err_ret:
/* The EOF error message is issued by hit_eof. Return true so that the
caller does not use nml_err_msg and nml_err_msg_size to generate
an unrelated error message. */
if (c == EOF)
{
dtp->u.p.input_complete = 1;
unget_char (dtp, c);
hit_eof (dtp);
return true;
}
return false; return false;
} }
......
...@@ -3840,7 +3840,7 @@ hit_eof (st_parameter_dt * dtp) ...@@ -3840,7 +3840,7 @@ hit_eof (st_parameter_dt * dtp)
case NO_ENDFILE: case NO_ENDFILE:
case AT_ENDFILE: case AT_ENDFILE:
generate_error (&dtp->common, LIBERROR_END, NULL); 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->endfile = AFTER_ENDFILE;
dtp->u.p.current_unit->current_record = 0; dtp->u.p.current_unit->current_record = 0;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment