Commit 2558e2e8 by Jerry DeLisle

re PR fortran/59700 (Misleading/buggy runtime error message: Bad integer for item 0 in list input)

2014-01-11  Jerry DeLisle  <jvdelisle@gcc.gnu>
	    Dominique d'Humieres  <dominiq@lps.ens.fr>
	    Steven G. Kargl  <kargl@gcc.gnu.org>

	PR libfortran/59700
	PR libfortran/59764
	* io/io.h (struct st_parameter_dt): Assign expanded_read flag to
	unused bit. Define new variable line_buffer_pos.
	* io/list_read.c (free_saved, next_char, l_push_char,
	read_logical, read_real): Replace use of item_count with
	line_buffer_pos for line_buffer look ahead.
	(read_logical, read_integer, parse_real, read_real, check_type):
	Adjust location of free_line to after generating error messages
	to retain the correct item count for the message.

Co-Authored-By: Dominique d'Humieres <dominiq@lps.ens.fr>
Co-Authored-By: Steven G. Kargl <kargl@gcc.gnu.org>

From-SVN: r206553
parent 2c407426
2014-01-11 Jerry DeLisle <jvdelisle@gcc.gnu>
Dominique d'Humieres <dominiq@lps.ens.fr>
Steven G. Kargl <kargl@gcc.gnu.org>
PR libfortran/59700
PR libfortran/59764
* io/io.h (struct st_parameter_dt): Assign expanded_read flag to
unused bit. Define new variable line_buffer_pos.
* io/list_read.c (free_saved, next_char, l_push_char,
read_logical, read_real): Replace use of item_count with
line_buffer_pos for line_buffer look ahead.
(read_logical, read_integer, parse_real, read_real, check_type):
Adjust location of free_line to after generating error messages
to retain the correct item count for the message.
2014-01-02 Richard Sandiford <rdsandiford@googlemail.com> 2014-01-02 Richard Sandiford <rdsandiford@googlemail.com>
Update copyright years Update copyright years
......
...@@ -430,7 +430,10 @@ typedef struct st_parameter_dt ...@@ -430,7 +430,10 @@ typedef struct st_parameter_dt
unsigned g0_no_blanks : 1; unsigned g0_no_blanks : 1;
/* Used to signal use of free_format_data. */ /* Used to signal use of free_format_data. */
unsigned format_not_saved : 1; unsigned format_not_saved : 1;
/* 14 unused bits. */ /* A flag used to identify when a non-standard expanded namelist read
has occurred. */
unsigned expanded_read : 1;
/* 13 unused bits. */
/* Used for ungetc() style functionality. Possible values /* Used for ungetc() style functionality. Possible values
are an unsigned char, EOF, or EOF - 1 used to mark the are an unsigned char, EOF, or EOF - 1 used to mark the
...@@ -447,9 +450,8 @@ typedef struct st_parameter_dt ...@@ -447,9 +450,8 @@ typedef struct st_parameter_dt
char *line_buffer; char *line_buffer;
struct format_data *fmt; struct format_data *fmt;
namelist_info *ionml; namelist_info *ionml;
/* A flag used to identify when a non-standard expanded namelist read /* Current position within the look-ahead line buffer. */
has occurred. */ int line_buffer_pos;
int expanded_read;
/* Storage area for values except for strings. Must be /* Storage area for values except for strings. Must be
large enough to hold a complex value (two reals) of the large enough to hold a complex value (two reals) of the
largest kind. */ largest kind. */
......
...@@ -118,7 +118,7 @@ free_saved (st_parameter_dt *dtp) ...@@ -118,7 +118,7 @@ free_saved (st_parameter_dt *dtp)
static void static void
free_line (st_parameter_dt *dtp) free_line (st_parameter_dt *dtp)
{ {
dtp->u.p.item_count = 0; dtp->u.p.line_buffer_pos = 0;
dtp->u.p.line_buffer_enabled = 0; dtp->u.p.line_buffer_enabled = 0;
if (dtp->u.p.line_buffer == NULL) if (dtp->u.p.line_buffer == NULL)
...@@ -150,15 +150,15 @@ next_char (st_parameter_dt *dtp) ...@@ -150,15 +150,15 @@ next_char (st_parameter_dt *dtp)
{ {
dtp->u.p.at_eol = 0; dtp->u.p.at_eol = 0;
c = dtp->u.p.line_buffer[dtp->u.p.item_count]; c = dtp->u.p.line_buffer[dtp->u.p.line_buffer_pos];
if (c != '\0' && dtp->u.p.item_count < 64) if (c != '\0' && dtp->u.p.line_buffer_pos < 64)
{ {
dtp->u.p.line_buffer[dtp->u.p.item_count] = '\0'; dtp->u.p.line_buffer[dtp->u.p.line_buffer_pos] = '\0';
dtp->u.p.item_count++; dtp->u.p.line_buffer_pos++;
goto done; goto done;
} }
dtp->u.p.item_count = 0; dtp->u.p.line_buffer_pos = 0;
dtp->u.p.line_buffer_enabled = 0; dtp->u.p.line_buffer_enabled = 0;
} }
...@@ -639,7 +639,7 @@ l_push_char (st_parameter_dt *dtp, char c) ...@@ -639,7 +639,7 @@ l_push_char (st_parameter_dt *dtp, char c)
if (dtp->u.p.line_buffer == NULL) if (dtp->u.p.line_buffer == NULL)
dtp->u.p.line_buffer = xcalloc (SCRATCH_SIZE, 1); dtp->u.p.line_buffer = xcalloc (SCRATCH_SIZE, 1);
dtp->u.p.line_buffer[dtp->u.p.item_count++] = c; dtp->u.p.line_buffer[dtp->u.p.line_buffer_pos++] = c;
} }
...@@ -749,7 +749,7 @@ read_logical (st_parameter_dt *dtp, int length) ...@@ -749,7 +749,7 @@ read_logical (st_parameter_dt *dtp, int length)
{ {
dtp->u.p.nml_read_error = 1; dtp->u.p.nml_read_error = 1;
dtp->u.p.line_buffer_enabled = 1; dtp->u.p.line_buffer_enabled = 1;
dtp->u.p.item_count = 0; dtp->u.p.line_buffer_pos = 0;
return; return;
} }
...@@ -757,14 +757,17 @@ read_logical (st_parameter_dt *dtp, int length) ...@@ -757,14 +757,17 @@ read_logical (st_parameter_dt *dtp, int length)
bad_logical: bad_logical:
free_line (dtp);
if (nml_bad_return (dtp, c)) if (nml_bad_return (dtp, c))
return; {
free_line (dtp);
return;
}
free_saved (dtp); free_saved (dtp);
if (c == EOF) if (c == EOF)
{ {
free_line (dtp);
hit_eof (dtp); hit_eof (dtp);
return; return;
} }
...@@ -772,6 +775,7 @@ read_logical (st_parameter_dt *dtp, int length) ...@@ -772,6 +775,7 @@ read_logical (st_parameter_dt *dtp, int length)
eat_line (dtp); eat_line (dtp);
snprintf (message, MSGLEN, "Bad logical value while reading item %d", snprintf (message, MSGLEN, "Bad logical value while reading item %d",
dtp->u.p.item_count); dtp->u.p.item_count);
free_line (dtp);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return; return;
...@@ -912,9 +916,9 @@ read_integer (st_parameter_dt *dtp, int length) ...@@ -912,9 +916,9 @@ read_integer (st_parameter_dt *dtp, int length)
else if (c != '\n') else if (c != '\n')
eat_line (dtp); eat_line (dtp);
free_line (dtp);
snprintf (message, MSGLEN, "Bad integer for item %d in list input", snprintf (message, MSGLEN, "Bad integer for item %d in list input",
dtp->u.p.item_count); dtp->u.p.item_count);
free_line (dtp);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return; return;
...@@ -1297,9 +1301,9 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) ...@@ -1297,9 +1301,9 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
else if (c != '\n') else if (c != '\n')
eat_line (dtp); eat_line (dtp);
free_line (dtp);
snprintf (message, MSGLEN, "Bad floating point number for item %d", snprintf (message, MSGLEN, "Bad floating point number for item %d",
dtp->u.p.item_count); dtp->u.p.item_count);
free_line (dtp);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
...@@ -1405,9 +1409,9 @@ eol_4: ...@@ -1405,9 +1409,9 @@ eol_4:
else if (c != '\n') else if (c != '\n')
eat_line (dtp); eat_line (dtp);
free_line (dtp);
snprintf (message, MSGLEN, "Bad complex value in item %d of list input", snprintf (message, MSGLEN, "Bad complex value in item %d of list input",
dtp->u.p.item_count); dtp->u.p.item_count);
free_line (dtp);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
} }
...@@ -1769,7 +1773,7 @@ read_real (st_parameter_dt *dtp, void * dest, int length) ...@@ -1769,7 +1773,7 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
{ {
dtp->u.p.nml_read_error = 1; dtp->u.p.nml_read_error = 1;
dtp->u.p.line_buffer_enabled = 1; dtp->u.p.line_buffer_enabled = 1;
dtp->u.p.item_count = 0; dtp->u.p.line_buffer_pos = 0;
return; return;
} }
...@@ -1788,9 +1792,9 @@ read_real (st_parameter_dt *dtp, void * dest, int length) ...@@ -1788,9 +1792,9 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
else if (c != '\n') else if (c != '\n')
eat_line (dtp); eat_line (dtp);
free_line (dtp);
snprintf (message, MSGLEN, "Bad real number in item %d of list input", snprintf (message, MSGLEN, "Bad real number in item %d of list input",
dtp->u.p.item_count); dtp->u.p.item_count);
free_line (dtp);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
} }
...@@ -1805,11 +1809,10 @@ check_type (st_parameter_dt *dtp, bt type, int kind) ...@@ -1805,11 +1809,10 @@ check_type (st_parameter_dt *dtp, bt type, int kind)
if (dtp->u.p.saved_type != BT_UNKNOWN && dtp->u.p.saved_type != type) if (dtp->u.p.saved_type != BT_UNKNOWN && dtp->u.p.saved_type != type)
{ {
free_line (dtp);
snprintf (message, MSGLEN, "Read type %s where %s was expected for item %d", snprintf (message, MSGLEN, "Read type %s where %s was expected for item %d",
type_name (dtp->u.p.saved_type), type_name (type), type_name (dtp->u.p.saved_type), type_name (type),
dtp->u.p.item_count); dtp->u.p.item_count);
free_line (dtp);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
} }
...@@ -1820,13 +1823,13 @@ check_type (st_parameter_dt *dtp, bt type, int kind) ...@@ -1820,13 +1823,13 @@ check_type (st_parameter_dt *dtp, bt type, int kind)
if ((type != BT_COMPLEX && dtp->u.p.saved_length != kind) if ((type != BT_COMPLEX && dtp->u.p.saved_length != kind)
|| (type == BT_COMPLEX && dtp->u.p.saved_length != kind*2)) || (type == BT_COMPLEX && dtp->u.p.saved_length != kind*2))
{ {
free_line (dtp);
snprintf (message, MSGLEN, snprintf (message, MSGLEN,
"Read kind %d %s where kind %d is required for item %d", "Read kind %d %s where kind %d is required for item %d",
type == BT_COMPLEX ? dtp->u.p.saved_length / 2 type == BT_COMPLEX ? dtp->u.p.saved_length / 2
: dtp->u.p.saved_length, : dtp->u.p.saved_length,
type_name (dtp->u.p.saved_type), kind, type_name (dtp->u.p.saved_type), kind,
dtp->u.p.item_count); dtp->u.p.item_count);
free_line (dtp);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
} }
......
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