git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

PR 45629 Remove usage of setjmp/longjmp 

From-SVN: r166180
This commit is contained in:
Janne Blomqvist 2010-11-02 14:56:38 +02:00
parent 6f1abb06a6
commit c86af7f3e4
4 changed files with 274 additions and 179 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
libgfortran/ChangeLog
View File

@ -1,3 +1,32 @@
2010-11-02 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/45629
* io/io.h: Remove setjmp.h include.
(st_parameter_dt): Change last_char to int, remove eof_jump.
* io/list_read.c (next_char): Return EOF instead of jumping.
(unget_char): Use int to be able to handle EOF.
(eat_spaces): Handle EOF return from next_char.
(eat_line): Likewise.
(eat_separator): Handle EOF return from next_char, eat_spaces,
eat_line.
(finish_separator): Likewise.
(convert_integer): Likewise.
(read_logical): Likewise.
(read_integer): Likewise.
(read_character): Likewise.
(parse_real): Likewise.
(read_complex): Likewise.
(read_real): Likewise.
(list_formatted_read_scalar): Likewise.
(list_formatted_read): Likewise.
(finish_list_read): Likewise.
(nml_parse_qualifier): Likewise.
(nml_match_name): Likewise.
(nml_get_obj_data): Likewise.
(namelist_read): Likewise.
* io/transfer.c (data_transfer_init): Initialize last_char.
(finalize_transfer): Remove jmp_buf setup.
2010-10-26 Jerry DeLisle <jvdelisle@gcc.gnu.org> 2010-10-26 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/46010 PR libgfortran/46010

7
libgfortran/io/io.h
View File

@ -31,7 +31,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h" #include "libgfortran.h"
#include <setjmp.h>
#include <gthr.h> #include <gthr.h>
/* Forward declarations. */ /* Forward declarations. */
@ -427,7 +426,10 @@ typedef struct st_parameter_dt
unsigned format_not_saved : 1; unsigned format_not_saved : 1;
/* 14 unused bits. */ /* 14 unused bits. */
char last_char; /* Used for ungetc() style functionality. Possible values
are an unsigned char, EOF, or EOF - 1 used to mark the
field as not valid. */
int last_char;
char nml_delim; char nml_delim;
int repeat_count; int repeat_count;
@ -438,7 +440,6 @@ typedef struct st_parameter_dt
char *scratch; char *scratch;
char *line_buffer; char *line_buffer;
struct format_data *fmt; struct format_data *fmt;
jmp_buf *eof_jump;
namelist_info *ionml; namelist_info *ionml;
/* A flag used to identify when a non-standard expanded namelist read /* A flag used to identify when a non-standard expanded namelist read
has occurred. */ has occurred. */

404
libgfortran/io/list_read.c
View File

@ -133,19 +133,18 @@ free_line (st_parameter_dt *dtp)
} }
static char static int
next_char (st_parameter_dt *dtp) next_char (st_parameter_dt *dtp)
{ {
ssize_t length; ssize_t length;
gfc_offset record; gfc_offset record;
char c; int c;
int cc;
if (dtp->u.p.last_char != '\0') if (dtp->u.p.last_char != EOF - 1)
{ {
dtp->u.p.at_eol = 0; dtp->u.p.at_eol = 0;
c = dtp->u.p.last_char; c = dtp->u.p.last_char;
dtp->u.p.last_char = '\0'; dtp->u.p.last_char = EOF - 1;
goto done; goto done;
} }
@ -172,7 +171,7 @@ next_char (st_parameter_dt *dtp)
if (is_array_io (dtp)) if (is_array_io (dtp))
{ {
if (dtp->u.p.at_eof) if (dtp->u.p.at_eof)
longjmp (*dtp->u.p.eof_jump, 1); return EOF;
/* Check for "end-of-record" condition. */ /* Check for "end-of-record" condition. */
if (dtp->u.p.current_unit->bytes_left == 0) if (dtp->u.p.current_unit->bytes_left == 0)
@ -192,7 +191,7 @@ next_char (st_parameter_dt *dtp)
record *= dtp->u.p.current_unit->recl; record *= dtp->u.p.current_unit->recl;
if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0) if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0)
longjmp (*dtp->u.p.eof_jump, 1); return EOF;
dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
goto done; goto done;
@ -203,7 +202,9 @@ next_char (st_parameter_dt *dtp)
if (is_internal_unit (dtp)) if (is_internal_unit (dtp))
{ {
length = sread (dtp->u.p.current_unit->s, &c, 1); char cc;
length = sread (dtp->u.p.current_unit->s, &cc, 1);
c = cc;
if (length < 0) if (length < 0)
{ {
generate_error (&dtp->common, LIBERROR_OS, NULL); generate_error (&dtp->common, LIBERROR_OS, NULL);
@ -223,7 +224,7 @@ next_char (st_parameter_dt *dtp)
else else
{ {
if (dtp->u.p.at_eof) if (dtp->u.p.at_eof)
longjmp (*dtp->u.p.eof_jump, 1); return EOF;
if (length == 0) if (length == 0)
{ {
c = '\n'; c = '\n';
@ -233,23 +234,12 @@ next_char (st_parameter_dt *dtp)
} }
else else
{ {
cc = fbuf_getc (dtp->u.p.current_unit); c = fbuf_getc (dtp->u.p.current_unit);
if (c != EOF && is_stream_io (dtp))
if (cc == EOF)
{
if (dtp->u.p.current_unit->endfile == AT_ENDFILE)
longjmp (*dtp->u.p.eof_jump, 1);
dtp->u.p.current_unit->endfile = AT_ENDFILE;
c = '\n';
}
else
c = (char) cc;
if (is_stream_io (dtp) && cc != EOF)
dtp->u.p.current_unit->strm_pos++; dtp->u.p.current_unit->strm_pos++;
} }
done: done:
dtp->u.p.at_eol = (c == '\n' || c == '\r'); dtp->u.p.at_eol = (c == '\n' || c == '\r' || c == EOF);
return c; return c;
} }
@ -257,7 +247,7 @@ done:
/* Push a character back onto the input. */ /* Push a character back onto the input. */
static void static void
unget_char (st_parameter_dt *dtp, char c) unget_char (st_parameter_dt *dtp, int c)
{ {
dtp->u.p.last_char = c; dtp->u.p.last_char = c;
} }
@ -266,33 +256,35 @@ unget_char (st_parameter_dt *dtp, char c)
/* Skip over spaces in the input. Returns the nonspace character that /* Skip over spaces in the input. Returns the nonspace character that
terminated the eating and also places it back on the input. */ terminated the eating and also places it back on the input. */
static char static int
eat_spaces (st_parameter_dt *dtp) eat_spaces (st_parameter_dt *dtp)
{ {
char c; int c;
do do
{ c = next_char (dtp);
c = next_char (dtp); while (c != EOF && (c == ' ' || c == '\t'));
}
while (c == ' ' || c == '\t');
unget_char (dtp, c); unget_char (dtp, c);
return c; return c;
} }
/* This function reads characters through to the end of the current line and /* This function reads characters through to the end of the current
just ignores them. */ line and just ignores them. Returns 0 for success and LIBERROR_END
if it hit EOF. */
static void static int
eat_line (st_parameter_dt *dtp) eat_line (st_parameter_dt *dtp)
{ {
char c; int c;
do do
c = next_char (dtp); c = next_char (dtp);
while (c != '\n'); while (c != EOF && c != '\n');
if (c == EOF)
return LIBERROR_END;
return 0;
} }
@ -305,17 +297,21 @@ eat_line (st_parameter_dt *dtp)
separator, we stop reading. If there are more input items, we separator, we stop reading. If there are more input items, we
continue reading the separator with finish_separator() which takes continue reading the separator with finish_separator() which takes
care of the fact that we may or may not have seen a comma as part care of the fact that we may or may not have seen a comma as part
of the separator. */ of the separator.
static void Returns 0 for success, and non-zero error code otherwise. */
static int
eat_separator (st_parameter_dt *dtp) eat_separator (st_parameter_dt *dtp)
{ {
char c, n; int c, n;
int err = 0;
eat_spaces (dtp); eat_spaces (dtp);
dtp->u.p.comma_flag = 0; dtp->u.p.comma_flag = 0;
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return LIBERROR_END;
switch (c) switch (c)
{ {
case ',': case ',':
@ -336,7 +332,8 @@ eat_separator (st_parameter_dt *dtp)
case '\r': case '\r':
dtp->u.p.at_eol = 1; dtp->u.p.at_eol = 1;
n = next_char(dtp); if ((n = next_char(dtp)) == EOF)
return LIBERROR_END;
if (n != '\n') if (n != '\n')
{ {
unget_char (dtp, n); unget_char (dtp, n);
@ -349,15 +346,22 @@ eat_separator (st_parameter_dt *dtp)
{ {
do do
{ {
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return LIBERROR_END;
if (c == '!') if (c == '!')
{ {
eat_line (dtp); err = eat_line (dtp);
c = next_char (dtp); if (err)
return err;
if ((c = next_char (dtp)) == EOF)
return LIBERROR_END;
if (c == '!') if (c == '!')
{ {
eat_line (dtp); err = eat_line (dtp);
c = next_char (dtp); if (err)
return err;
if ((c = next_char (dtp)) == EOF)
return LIBERROR_END;
} }
} }
} }
@ -369,9 +373,9 @@ eat_separator (st_parameter_dt *dtp)
case '!': case '!':
if (dtp->u.p.namelist_mode) if (dtp->u.p.namelist_mode)
{ /* Eat a namelist comment. */ { /* Eat a namelist comment. */
do err = eat_line (dtp);
c = next_char (dtp); if (err)
while (c != '\n'); return err;
break; break;
} }
@ -382,22 +386,26 @@ eat_separator (st_parameter_dt *dtp)
unget_char (dtp, c); unget_char (dtp, c);
break; break;
} }
return err;
} }
/* Finish processing a separator that was interrupted by a newline. /* Finish processing a separator that was interrupted by a newline.
If we're here, then another data item is present, so we finish what If we're here, then another data item is present, so we finish what
we started on the previous line. */ we started on the previous line. Return 0 on success, error code
on failure. */
static void static int
finish_separator (st_parameter_dt *dtp) finish_separator (st_parameter_dt *dtp)
{ {
char c; int c;
int err;
restart: restart:
eat_spaces (dtp); eat_spaces (dtp);
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return LIBERROR_END;
switch (c) switch (c)
{ {
case ',': case ',':
@ -405,7 +413,8 @@ finish_separator (st_parameter_dt *dtp)
unget_char (dtp, c); unget_char (dtp, c);
else else
{ {
c = eat_spaces (dtp); if ((c = eat_spaces (dtp)) == EOF)
return LIBERROR_END;
if (c == '\n' || c == '\r') if (c == '\n' || c == '\r')
goto restart; goto restart;
} }
@ -415,7 +424,7 @@ finish_separator (st_parameter_dt *dtp)
case '/': case '/':
dtp->u.p.input_complete = 1; dtp->u.p.input_complete = 1;
if (!dtp->u.p.namelist_mode) if (!dtp->u.p.namelist_mode)
return; return err;
break; break;
case '\n': case '\n':
@ -425,10 +434,9 @@ finish_separator (st_parameter_dt *dtp)
case '!': case '!':
if (dtp->u.p.namelist_mode) if (dtp->u.p.namelist_mode)
{ {
do err = eat_line (dtp);
c = next_char (dtp); if (err)
while (c != '\n'); return err;
goto restart; goto restart;
} }
@ -436,6 +444,7 @@ finish_separator (st_parameter_dt *dtp)
unget_char (dtp, c); unget_char (dtp, c);
break; break;
} }
return err;
} }
@ -535,10 +544,11 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
static int static int
parse_repeat (st_parameter_dt *dtp) parse_repeat (st_parameter_dt *dtp)
{ {
char c, message[100]; char message[100];
int repeat; int c, repeat;
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad_repeat;
switch (c) switch (c)
{ {
CASE_DIGITS: CASE_DIGITS:
@ -599,8 +609,14 @@ parse_repeat (st_parameter_dt *dtp)
bad_repeat: bad_repeat:
eat_line (dtp);
free_saved (dtp); free_saved (dtp);
if (c == EOF)
{
hit_eof (dtp);
return 1;
}
else
eat_line (dtp);
sprintf (message, "Bad repeat count in item %d of list input", 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, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@ -631,8 +647,8 @@ l_push_char (st_parameter_dt *dtp, char c)
static void static void
read_logical (st_parameter_dt *dtp, int length) read_logical (st_parameter_dt *dtp, int length)
{ {
char c, message[100]; char message[100];
int i, v; int c, i, v;
if (parse_repeat (dtp)) if (parse_repeat (dtp))
return; return;
@ -643,7 +659,8 @@ read_logical (st_parameter_dt *dtp, int length)
{ {
case 't': case 't':
v = 1; v = 1;
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad_logical;
l_push_char (dtp, c); l_push_char (dtp, c);
if (!is_separator(c)) if (!is_separator(c))
@ -653,7 +670,8 @@ read_logical (st_parameter_dt *dtp, int length)
break; break;
case 'f': case 'f':
v = 0; v = 0;
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad_logical;
l_push_char (dtp, c); l_push_char (dtp, c);
if (!is_separator(c)) if (!is_separator(c))
@ -695,10 +713,8 @@ read_logical (st_parameter_dt *dtp, int length)
/* Eat trailing garbage. */ /* Eat trailing garbage. */
do do
{ c = next_char (dtp);
c = next_char (dtp); while (c != EOF && !is_separator (c));
}
while (!is_separator (c));
unget_char (dtp, c); unget_char (dtp, c);
eat_separator (dtp); eat_separator (dtp);
@ -746,8 +762,14 @@ 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); free_saved (dtp);
if (c == EOF)
{
hit_eof (dtp);
return;
}
else
eat_line (dtp);
sprintf (message, "Bad logical value while reading item %d", sprintf (message, "Bad logical value while reading item %d",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@ -771,8 +793,8 @@ read_logical (st_parameter_dt *dtp, int length)
static void static void
read_integer (st_parameter_dt *dtp, int length) read_integer (st_parameter_dt *dtp, int length)
{ {
char c, message[100]; char message[100];
int negative; int c, negative;
negative = 0; negative = 0;
@ -784,7 +806,8 @@ read_integer (st_parameter_dt *dtp, int length)
/* Fall through... */ /* Fall through... */
case '+': case '+':
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad_integer;
goto get_integer; goto get_integer;
CASE_SEPARATORS: /* Single null. */ CASE_SEPARATORS: /* Single null. */
@ -829,7 +852,8 @@ read_integer (st_parameter_dt *dtp, int length)
/* Get the real integer. */ /* Get the real integer. */
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad_integer;
switch (c) switch (c)
{ {
CASE_DIGITS: CASE_DIGITS:
@ -875,9 +899,15 @@ 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); if (c == EOF)
{
hit_eof (dtp);
return;
}
else
eat_line (dtp);
sprintf (message, "Bad integer for item %d in list input", sprintf (message, "Bad integer for item %d in list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@ -905,11 +935,13 @@ read_integer (st_parameter_dt *dtp, int length)
static void static void
read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
{ {
char c, quote, message[100]; char quote, message[100];
int c;
quote = ' '; /* Space means no quote character. */ quote = ' '; /* Space means no quote character. */
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto eof;
switch (c) switch (c)
{ {
CASE_DIGITS: CASE_DIGITS:
@ -941,7 +973,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
for (;;) for (;;)
{ {
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto eof;
switch (c) switch (c)
{ {
CASE_DIGITS: CASE_DIGITS:
@ -968,7 +1001,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
/* Now get the real string. */ /* Now get the real string. */
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto eof;
switch (c) switch (c)
{ {
CASE_SEPARATORS: CASE_SEPARATORS:
@ -989,7 +1023,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
get_string: get_string:
for (;;) for (;;)
{ {
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto eof;
switch (c) switch (c)
{ {
case '"': case '"':
@ -1003,7 +1038,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
/* See if we have a doubled quote character or the end of /* See if we have a doubled quote character or the end of
the string. */ the string. */
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto eof;
if (c == quote) if (c == quote)
{ {
push_char (dtp, quote); push_char (dtp, quote);
@ -1034,6 +1070,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
invalid. */ invalid. */
done: done:
c = next_char (dtp); c = next_char (dtp);
eof:
if (is_separator (c) || c == '!') if (is_separator (c) || c == '!')
{ {
unget_char (dtp, c); unget_char (dtp, c);
@ -1044,6 +1081,11 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
else else
{ {
free_saved (dtp); free_saved (dtp);
if (c == EOF)
{
hit_eof (dtp);
return;
}
sprintf (message, "Invalid string input in item %d", sprintf (message, "Invalid string input in item %d",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@ -1057,14 +1099,16 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
static int static int
parse_real (st_parameter_dt *dtp, void *buffer, int length) parse_real (st_parameter_dt *dtp, void *buffer, int length)
{ {
char c, message[100]; char message[100];
int m, seen_dp; int c, m, seen_dp;
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad;
if (c == '-' || c == '+') if (c == '-' || c == '+')
{ {
push_char (dtp, c); push_char (dtp, c);
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad;
} }
if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
@ -1084,7 +1128,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
for (;;) for (;;)
{ {
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad;
if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
c = '.'; c = '.';
switch (c) switch (c)
@ -1112,7 +1157,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
case '+': case '+':
push_char (dtp, 'e'); push_char (dtp, 'e');
push_char (dtp, c); push_char (dtp, c);
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad;
goto exp2; goto exp2;
CASE_SEPARATORS: CASE_SEPARATORS:
@ -1125,7 +1171,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
} }
exp1: exp1:
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad;
if (c != '-' && c != '+') if (c != '-' && c != '+')
push_char (dtp, '+'); push_char (dtp, '+');
else else
@ -1142,7 +1189,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
for (;;) for (;;)
{ {
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad;
switch (c) switch (c)
{ {
CASE_DIGITS: CASE_DIGITS:
@ -1219,8 +1267,14 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
if (nml_bad_return (dtp, c)) if (nml_bad_return (dtp, c))
return 0; return 0;
eat_line (dtp);
free_saved (dtp); free_saved (dtp);
if (c == EOF)
{
hit_eof (dtp);
return 1;
}
else
eat_line (dtp);
sprintf (message, "Bad floating point number for item %d", sprintf (message, "Bad floating point number for item %d",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@ -1236,7 +1290,7 @@ static void
read_complex (st_parameter_dt *dtp, void * dest, int kind, size_t size) read_complex (st_parameter_dt *dtp, void * dest, int kind, size_t size)
{ {
char message[100]; char message[100];
char c; int c;
if (parse_repeat (dtp)) if (parse_repeat (dtp))
return; return;
@ -1303,8 +1357,14 @@ eol_2:
if (nml_bad_return (dtp, c)) if (nml_bad_return (dtp, c))
return; return;
eat_line (dtp);
free_saved (dtp); free_saved (dtp);
if (c == EOF)
{
hit_eof (dtp);
return;
}
else
eat_line (dtp);
sprintf (message, "Bad complex value in item %d of list input", 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, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@ -1316,7 +1376,8 @@ eol_2:
static void static void
read_real (st_parameter_dt *dtp, void * dest, int length) read_real (st_parameter_dt *dtp, void * dest, int length)
{ {
char c, message[100]; char message[100];
int c;
int seen_dp; int seen_dp;
int is_inf; int is_inf;
@ -1409,7 +1470,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
/* Now get the number itself. */ /* Now get the number itself. */
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad_real;
if (is_separator (c)) if (is_separator (c))
{ /* Repeated null value. */ { /* Repeated null value. */
unget_char (dtp, c); unget_char (dtp, c);
@ -1423,7 +1485,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
{ {
got_sign: got_sign:
push_char (dtp, c); push_char (dtp, c);
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad_real;
} }
if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
@ -1460,6 +1523,7 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
break; break;
CASE_SEPARATORS: CASE_SEPARATORS:
case EOF:
goto done; goto done;
case '.': case '.':
@ -1491,7 +1555,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
exp1: exp1:
push_char (dtp, 'e'); push_char (dtp, 'e');
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto bad_real;
if (c != '+' && c != '-') if (c != '+' && c != '-')
push_char (dtp, '+'); push_char (dtp, '+');
else else
@ -1612,7 +1677,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
if (c == ' ' || c =='\n' || c == '\r') if (c == ' ' || c =='\n' || c == '\r')
{ {
do do
c = next_char (dtp); {
if ((c = next_char (dtp)) == EOF)
goto bad_real;
}
while (c == ' ' || c =='\n' || c == '\r'); while (c == ' ' || c =='\n' || c == '\r');
l_push_char (dtp, c); l_push_char (dtp, c);
@ -1652,8 +1720,14 @@ read_real (st_parameter_dt *dtp, void * dest, 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);
if (c == EOF)
{
hit_eof (dtp);
return;
}
else
eat_line (dtp);
sprintf (message, "Bad real number in item %d of list input", 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, LIBERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@ -1700,29 +1774,16 @@ check_type (st_parameter_dt *dtp, bt type, int len)
reading, usually in the dtp->u.p.value[] array. If a repeat count is reading, usually in the dtp->u.p.value[] array. If a repeat count is
greater than one, we copy the data item multiple times. */ greater than one, we copy the data item multiple times. */
static void static int
list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p, list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
int kind, size_t size) int kind, size_t size)
{ {
char c;
gfc_char4_t *q; gfc_char4_t *q;
int i, m; int c, i, m;
jmp_buf eof_jump; int err = 0;
dtp->u.p.namelist_mode = 0; dtp->u.p.namelist_mode = 0;
dtp->u.p.eof_jump = &eof_jump;
if (setjmp (eof_jump))
{
generate_error (&dtp->common, LIBERROR_END, NULL);
if (!is_internal_unit (dtp))
{
dtp->u.p.current_unit->endfile = AFTER_ENDFILE;
dtp->u.p.current_unit->current_record = 0;
}
goto cleanup;
}
if (dtp->u.p.first_item) if (dtp->u.p.first_item)
{ {
dtp->u.p.first_item = 0; dtp->u.p.first_item = 0;
@ -1730,7 +1791,11 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
dtp->u.p.repeat_count = 1; dtp->u.p.repeat_count = 1;
dtp->u.p.at_eol = 0; dtp->u.p.at_eol = 0;
c = eat_spaces (dtp); if ((c = eat_spaces (dtp)) == EOF)
{
err = LIBERROR_END;
goto cleanup;
}
if (is_separator (c)) if (is_separator (c))
{ {
/* Found a null value. */ /* Found a null value. */
@ -1754,7 +1819,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
if (dtp->u.p.repeat_count > 0) if (dtp->u.p.repeat_count > 0)
{ {
if (check_type (dtp, type, kind)) if (check_type (dtp, type, kind))
return; return err;
goto set_value; goto set_value;
} }
@ -1864,7 +1929,9 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
free_saved (dtp); free_saved (dtp);
cleanup: cleanup:
dtp->u.p.eof_jump = NULL; if (err == LIBERROR_END)
hit_eof (dtp);
return err;
} }
@ -1876,6 +1943,7 @@ list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind,
char *tmp; char *tmp;
size_t stride = type == BT_CHARACTER ? size_t stride = type == BT_CHARACTER ?
size * GFC_SIZE_OF_CHAR_KIND(kind) : size; size * GFC_SIZE_OF_CHAR_KIND(kind) : size;
int err;
tmp = (char *) p; tmp = (char *) p;
@ -1883,7 +1951,10 @@ list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind,
for (elem = 0; elem < nelems; elem++) for (elem = 0; elem < nelems; elem++)
{ {
dtp->u.p.item_count++; dtp->u.p.item_count++;
list_formatted_read_scalar (dtp, type, tmp + stride*elem, kind, size); err = list_formatted_read_scalar (dtp, type, tmp + stride*elem,
kind, size);
if (err)
break;
} }
} }
@ -1893,7 +1964,7 @@ list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind,
void void
finish_list_read (st_parameter_dt *dtp) finish_list_read (st_parameter_dt *dtp)
{ {
char c; int err;
free_saved (dtp); free_saved (dtp);
@ -1905,18 +1976,9 @@ finish_list_read (st_parameter_dt *dtp)
return; return;
} }
do err = eat_line (dtp);
{ if (err == LIBERROR_END)
c = next_char (dtp); hit_eof (dtp);
}
while (c != '\n');
if (dtp->u.p.current_unit->endfile != NO_ENDFILE)
{
generate_error (&dtp->common, LIBERROR_END, NULL);
dtp->u.p.current_unit->endfile = AFTER_ENDFILE;
dtp->u.p.current_unit->current_record = 0;
}
} }
/* NAMELIST INPUT /* NAMELIST INPUT
@ -1953,7 +2015,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
int neg; int neg;
int null_flag; int null_flag;
int is_array_section, is_char; int is_array_section, is_char;
char c; int c;
is_char = 0; is_char = 0;
is_array_section = 0; is_array_section = 0;
@ -1968,7 +2030,8 @@ 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 '('. */
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return FAILURE;
/* Process the qualifier, by dimension and triplet. */ /* Process the qualifier, by dimension and triplet. */
@ -1981,7 +2044,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
neg = 0; neg = 0;
/* Process a potential sign. */ /* Process a potential sign. */
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return FAILURE;
switch (c) switch (c)
{ {
case '-': case '-':
@ -1999,7 +2063,8 @@ 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 (;;)
{ {
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return FAILURE;
switch (c) switch (c)
{ {
@ -2025,7 +2090,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
case ' ': case '\t': case ' ': case '\t':
eat_spaces (dtp); eat_spaces (dtp);
c = next_char (dtp); if ((c = next_char (dtp) == EOF))
return FAILURE;
break; break;
default: default:
@ -2229,12 +2295,13 @@ static void
nml_match_name (st_parameter_dt *dtp, const char *name, index_type len) nml_match_name (st_parameter_dt *dtp, const char *name, index_type len)
{ {
index_type i; index_type i;
char c; int c;
dtp->u.p.nml_read_error = 0; dtp->u.p.nml_read_error = 0;
for (i = 0; i < len; i++) for (i = 0; i < len; i++)
{ {
c = next_char (dtp); c = next_char (dtp);
if (tolower (c) != tolower (name[i])) if (c == EOF || (tolower (c) != tolower (name[i])))
{ {
dtp->u.p.nml_read_error = 1; dtp->u.p.nml_read_error = 1;
break; break;
@ -2591,7 +2658,7 @@ static try
nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
char *nml_err_msg, size_t nml_err_msg_size) char *nml_err_msg, size_t nml_err_msg_size)
{ {
char c; int c;
namelist_info * nl; namelist_info * nl;
namelist_info * first_nl = NULL; namelist_info * first_nl = NULL;
namelist_info * root_nl = NULL; namelist_info * root_nl = NULL;
@ -2612,11 +2679,13 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
if (dtp->u.p.input_complete) if (dtp->u.p.input_complete)
return SUCCESS; return SUCCESS;
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return FAILURE;
switch (c) switch (c)
{ {
case '=': case '=':
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return FAILURE;
if (c != '?') if (c != '?')
{ {
sprintf (nml_err_msg, "namelist read: misplaced = sign"); sprintf (nml_err_msg, "namelist read: misplaced = sign");
@ -2663,7 +2732,8 @@ get_name:
{ {
if (!is_separator (c)) if (!is_separator (c))
push_char (dtp, tolower(c)); push_char (dtp, tolower(c));
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return FAILURE;
} while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' )); } while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' ));
unget_char (dtp, c); unget_char (dtp, c);
@ -2737,7 +2807,8 @@ get_name:
qualifier_flag = 1; qualifier_flag = 1;
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return FAILURE;
unget_char (dtp, c); unget_char (dtp, c);
} }
else if (nl->var_rank > 0) else if (nl->var_rank > 0)
@ -2762,8 +2833,8 @@ get_name:
root_nl = nl; root_nl = nl;
component_flag = 1; component_flag = 1;
if ((c = next_char (dtp)) == EOF)
c = next_char (dtp); return FAILURE;
goto get_name; goto get_name;
} }
@ -2799,7 +2870,8 @@ get_name:
goto nml_err_ret; goto nml_err_ret;
} }
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return FAILURE;
unget_char (dtp, c); unget_char (dtp, c);
} }
@ -2838,7 +2910,8 @@ get_name:
if (dtp->u.p.input_complete) if (dtp->u.p.input_complete)
return SUCCESS; return SUCCESS;
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
return FAILURE;
if (c != '=') if (c != '=')
{ {
@ -2883,8 +2956,7 @@ nml_err_ret:
void void
namelist_read (st_parameter_dt *dtp) namelist_read (st_parameter_dt *dtp)
{ {
char c; int c;
jmp_buf eof_jump;
char nml_err_msg[200]; char nml_err_msg[200];
/* Pointer to the previously read object, in case attempt is made to read /* Pointer to the previously read object, in case attempt is made to read
new object name. Should this fail, error message can give previous new object name. Should this fail, error message can give previous
@ -2895,31 +2967,27 @@ namelist_read (st_parameter_dt *dtp)
dtp->u.p.input_complete = 0; dtp->u.p.input_complete = 0;
dtp->u.p.expanded_read = 0; dtp->u.p.expanded_read = 0;
dtp->u.p.eof_jump = &eof_jump;
if (setjmp (eof_jump))
{
dtp->u.p.eof_jump = NULL;
generate_error (&dtp->common, LIBERROR_END, NULL);
return;
}
/* Look for &namelist_name . Skip all characters, testing for $nmlname. /* Look for &namelist_name . Skip all characters, testing for $nmlname.
Exit on success or EOF. If '?' or '=?' encountered in stdin, print Exit on success or EOF. If '?' or '=?' encountered in stdin, print
node names or namelist on stdout. */ node names or namelist on stdout. */
find_nml_name: find_nml_name:
switch (c = next_char (dtp)) if ((c = next_char (dtp)) == EOF)
goto nml_err_eof;
switch (c)
{ {
case '$': case '$':
case '&': case '&':
break; break;
case '!': case '!':
eat_line (dtp); if (eat_line (dtp))
goto nml_err_eof;
goto find_nml_name; goto find_nml_name;
case '=': case '=':
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto nml_err_eof;
if (c == '?') if (c == '?')
nml_query (dtp, '='); nml_query (dtp, '=');
else else
@ -2941,7 +3009,8 @@ find_nml_name:
goto find_nml_name; goto find_nml_name;
/* A trailing space is required, we give a little lattitude here, 10.9.1. */ /* A trailing space is required, we give a little lattitude here, 10.9.1. */
c = next_char (dtp); if ((c = next_char (dtp)) == EOF)
goto nml_err_eof;
if (!is_separator(c) && c != '!') if (!is_separator(c) && c != '!')
{ {
unget_char (dtp, c); unget_char (dtp, c);
@ -2965,16 +3034,17 @@ find_nml_name:
} }
} }
dtp->u.p.eof_jump = NULL;
free_saved (dtp); free_saved (dtp);
free_line (dtp); free_line (dtp);
return; return;
/* All namelist error calls return from here */ /* All namelist error calls return from here */
nml_err_eof:
hit_eof (dtp);
nml_err_ret: nml_err_ret:
dtp->u.p.eof_jump = NULL;
free_saved (dtp); free_saved (dtp);
free_line (dtp); free_line (dtp);
generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg); generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg);

13
libgfortran/io/transfer.c
View File

@ -2666,7 +2666,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
else else
{ {
if ((cf & IOPARM_DT_LIST_FORMAT) != 0) if ((cf & IOPARM_DT_LIST_FORMAT) != 0)
dtp->u.p.transfer = list_formatted_read; {
dtp->u.p.last_char = EOF - 1;
dtp->u.p.transfer = list_formatted_read;
}
else else
dtp->u.p.transfer = formatted_transfer; dtp->u.p.transfer = formatted_transfer;
} }
@ -3362,7 +3365,6 @@ next_record (st_parameter_dt *dtp, int done)
static void static void
finalize_transfer (st_parameter_dt *dtp) finalize_transfer (st_parameter_dt *dtp)
{ {
jmp_buf eof_jump;
GFC_INTEGER_4 cf = dtp->common.flags; GFC_INTEGER_4 cf = dtp->common.flags;
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
@ -3394,13 +3396,6 @@ finalize_transfer (st_parameter_dt *dtp)
if (dtp->u.p.current_unit == NULL) if (dtp->u.p.current_unit == NULL)
return; return;
dtp->u.p.eof_jump = &eof_jump;
if (setjmp (eof_jump))
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return;
}
if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING) if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING)
{ {
finish_list_read (dtp); finish_list_read (dtp);