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

re PR fortran/27138 (gfortran: read(*,*) myInt advances only one character on error)

Browse Source 
2006-04-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/27138
	* io/list_read.c (eat_line): New function.
	(parse_repeat): Use new function and free_saved.
	(read_logical): Same.
	(read_integer): Use new function.
	(parse_real): Use nml_bad_return and new function.
	(read_complex): Use new function and free_saved.
	(read_real): Same.

From-SVN: r112999
This commit is contained in:
Jerry DeLisle 2006-04-17 02:33:51 +00:00
parent b12cbf2cc5
commit 9855448d22
2 changed files with 44 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
libgfortran/ChangeLog
View File

@ -1,3 +1,14 @@
2006-04-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/27138
* io/list_read.c (eat_line): New function.
(parse_repeat): Use new function and free_saved.
(read_logical): Same.
(read_integer): Use new function.
(parse_real): Use nml_bad_return and new function.
(read_complex): Use new function and free_saved.
(read_real): Same.
2006-04-12 Jerry DeLisle <jvdelisle@gcc.gnu.org> 2006-04-12 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/26766 PR libgfortran/26766

39
libgfortran/io/list_read.c
View File

@ -375,6 +375,21 @@ finish_separator (st_parameter_dt *dtp)
} }
} }
/* This function reads characters through to the end of the current line and
just ignores them. */
static void
eat_line (st_parameter_dt *dtp)
{
char c;
if (!is_internal_unit (dtp))
do
c = next_char (dtp);
while (c != '\n');
}
/* This function is needed to catch bad conversions so that namelist can /* This function is needed to catch bad conversions so that namelist can
attempt to see if dtp->u.p.saved_string contains a new object name rather attempt to see if dtp->u.p.saved_string contains a new object name rather
than a bad value. */ than a bad value. */
@ -534,9 +549,11 @@ parse_repeat (st_parameter_dt *dtp)
return 0; return 0;
bad_repeat: bad_repeat:
eat_line (dtp);
free_saved (dtp);
st_sprintf (message, "Bad repeat count in item %d of list input", st_sprintf (message, "Bad repeat count in item %d of list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, ERROR_READ_VALUE, message);
return 1; return 1;
} }
@ -550,8 +567,6 @@ parse_repeat (st_parameter_dt *dtp)
static void static void
l_push_char (st_parameter_dt *dtp, char c) l_push_char (st_parameter_dt *dtp, char c)
{ {
char *new;
if (dtp->u.p.line_buffer == NULL) if (dtp->u.p.line_buffer == NULL)
{ {
dtp->u.p.line_buffer = get_mem (SCRATCH_SIZE); dtp->u.p.line_buffer = get_mem (SCRATCH_SIZE);
@ -677,9 +692,12 @@ read_logical (st_parameter_dt *dtp, int length)
if (nml_bad_return (dtp, c)) if (nml_bad_return (dtp, c))
return; return;
eat_line (dtp);
free_saved (dtp);
if (dtp->u.p.line_buffer != NULL)
free_mem (dtp->u.p.line_buffer);
st_sprintf (message, "Bad logical value while reading item %d", st_sprintf (message, "Bad logical value while reading item %d",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, ERROR_READ_VALUE, message);
return; return;
@ -806,8 +824,8 @@ read_integer (st_parameter_dt *dtp, int length)
if (nml_bad_return (dtp, c)) if (nml_bad_return (dtp, c))
return; return;
eat_line (dtp);
free_saved (dtp); free_saved (dtp);
st_sprintf (message, "Bad integer for item %d in list input", st_sprintf (message, "Bad integer for item %d in list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, ERROR_READ_VALUE, message);
@ -1085,6 +1103,11 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
return m; return m;
bad: bad:
if (nml_bad_return (dtp, c))
return 0;
eat_line (dtp);
free_saved (dtp); free_saved (dtp);
st_sprintf (message, "Bad floating point number for item %d", st_sprintf (message, "Bad floating point number for item %d",
dtp->u.p.item_count); dtp->u.p.item_count);
@ -1167,9 +1190,10 @@ eol_2:
if (nml_bad_return (dtp, c)) if (nml_bad_return (dtp, c))
return; return;
eat_line (dtp);
free_saved (dtp);
st_sprintf (message, "Bad complex value in item %d of list input", st_sprintf (message, "Bad complex value in item %d of list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, ERROR_READ_VALUE, message);
} }
@ -1381,9 +1405,10 @@ read_real (st_parameter_dt *dtp, int length)
if (nml_bad_return (dtp, c)) if (nml_bad_return (dtp, c))
return; return;
eat_line (dtp);
free_saved (dtp);
st_sprintf (message, "Bad real number in item %d of list input", st_sprintf (message, "Bad real number in item %d of list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, ERROR_READ_VALUE, message);
} }