mirror of git://gcc.gnu.org/git/gcc.git
PR 45629 Remove usage of setjmp/longjmp
From-SVN: r166180
This commit is contained in:
Janne Blomqvist
parent
6f1abb06a6
commit
c86af7f3e4
|
|
@ -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>
|
||||
|
||||
PR libgfortran/46010
|
||||
|
|
|
|||
|
|
@ -31,7 +31,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|||
|
||||
#include "libgfortran.h"
|
||||
|
||||
#include <setjmp.h>
|
||||
#include <gthr.h>
|
||||
|
||||
/* Forward declarations. */
|
||||
|
|
@ -427,7 +426,10 @@ typedef struct st_parameter_dt
|
|||
unsigned format_not_saved : 1;
|
||||
/* 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;
|
||||
|
||||
int repeat_count;
|
||||
|
|
@ -438,7 +440,6 @@ typedef struct st_parameter_dt
|
|||
char *scratch;
|
||||
char *line_buffer;
|
||||
struct format_data *fmt;
|
||||
jmp_buf *eof_jump;
|
||||
namelist_info *ionml;
|
||||
/* A flag used to identify when a non-standard expanded namelist read
|
||||
has occurred. */
|
||||
|
|
|
|||
|
|
@ -133,19 +133,18 @@ free_line (st_parameter_dt *dtp)
|
|||
}
|
||||
|
||||
|
||||
static char
|
||||
static int
|
||||
next_char (st_parameter_dt *dtp)
|
||||
{
|
||||
ssize_t length;
|
||||
gfc_offset record;
|
||||
char c;
|
||||
int cc;
|
||||
int c;
|
||||
|
||||
if (dtp->u.p.last_char != '\0')
|
||||
if (dtp->u.p.last_char != EOF - 1)
|
||||
{
|
||||
dtp->u.p.at_eol = 0;
|
||||
c = dtp->u.p.last_char;
|
||||
dtp->u.p.last_char = '\0';
|
||||
dtp->u.p.last_char = EOF - 1;
|
||||
goto done;
|
||||
}
|
||||
|
||||
|
|
@ -172,7 +171,7 @@ next_char (st_parameter_dt *dtp)
|
|||
if (is_array_io (dtp))
|
||||
{
|
||||
if (dtp->u.p.at_eof)
|
||||
longjmp (*dtp->u.p.eof_jump, 1);
|
||||
return EOF;
|
||||
|
||||
/* Check for "end-of-record" condition. */
|
||||
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;
|
||||
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;
|
||||
goto done;
|
||||
|
|
@ -203,7 +202,9 @@ next_char (st_parameter_dt *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)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
|
|
@ -223,7 +224,7 @@ next_char (st_parameter_dt *dtp)
|
|||
else
|
||||
{
|
||||
if (dtp->u.p.at_eof)
|
||||
longjmp (*dtp->u.p.eof_jump, 1);
|
||||
return EOF;
|
||||
if (length == 0)
|
||||
{
|
||||
c = '\n';
|
||||
|
|
@ -233,23 +234,12 @@ next_char (st_parameter_dt *dtp)
|
|||
}
|
||||
else
|
||||
{
|
||||
cc = fbuf_getc (dtp->u.p.current_unit);
|
||||
|
||||
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)
|
||||
c = fbuf_getc (dtp->u.p.current_unit);
|
||||
if (c != EOF && is_stream_io (dtp))
|
||||
dtp->u.p.current_unit->strm_pos++;
|
||||
|
||||
}
|
||||
done:
|
||||
dtp->u.p.at_eol = (c == '\n' || c == '\r');
|
||||
dtp->u.p.at_eol = (c == '\n' || c == '\r' || c == EOF);
|
||||
return c;
|
||||
}
|
||||
|
||||
|
|
@ -257,7 +247,7 @@ done:
|
|||
/* Push a character back onto the input. */
|
||||
|
||||
static void
|
||||
unget_char (st_parameter_dt *dtp, char c)
|
||||
unget_char (st_parameter_dt *dtp, int 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
|
||||
terminated the eating and also places it back on the input. */
|
||||
|
||||
static char
|
||||
static int
|
||||
eat_spaces (st_parameter_dt *dtp)
|
||||
{
|
||||
char c;
|
||||
int c;
|
||||
|
||||
do
|
||||
{
|
||||
c = next_char (dtp);
|
||||
}
|
||||
while (c == ' ' || c == '\t');
|
||||
c = next_char (dtp);
|
||||
while (c != EOF && (c == ' ' || c == '\t'));
|
||||
|
||||
unget_char (dtp, c);
|
||||
return c;
|
||||
}
|
||||
|
||||
|
||||
/* This function reads characters through to the end of the current line and
|
||||
just ignores them. */
|
||||
/* This function reads characters through to the end of the current
|
||||
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)
|
||||
{
|
||||
char c;
|
||||
int c;
|
||||
|
||||
do
|
||||
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
|
||||
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
|
||||
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)
|
||||
{
|
||||
char c, n;
|
||||
int c, n;
|
||||
int err = 0;
|
||||
|
||||
eat_spaces (dtp);
|
||||
dtp->u.p.comma_flag = 0;
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return LIBERROR_END;
|
||||
switch (c)
|
||||
{
|
||||
case ',':
|
||||
|
|
@ -336,7 +332,8 @@ eat_separator (st_parameter_dt *dtp)
|
|||
|
||||
case '\r':
|
||||
dtp->u.p.at_eol = 1;
|
||||
n = next_char(dtp);
|
||||
if ((n = next_char(dtp)) == EOF)
|
||||
return LIBERROR_END;
|
||||
if (n != '\n')
|
||||
{
|
||||
unget_char (dtp, n);
|
||||
|
|
@ -349,15 +346,22 @@ eat_separator (st_parameter_dt *dtp)
|
|||
{
|
||||
do
|
||||
{
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return LIBERROR_END;
|
||||
if (c == '!')
|
||||
{
|
||||
eat_line (dtp);
|
||||
c = next_char (dtp);
|
||||
err = eat_line (dtp);
|
||||
if (err)
|
||||
return err;
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return LIBERROR_END;
|
||||
if (c == '!')
|
||||
{
|
||||
eat_line (dtp);
|
||||
c = next_char (dtp);
|
||||
err = eat_line (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 '!':
|
||||
if (dtp->u.p.namelist_mode)
|
||||
{ /* Eat a namelist comment. */
|
||||
do
|
||||
c = next_char (dtp);
|
||||
while (c != '\n');
|
||||
err = eat_line (dtp);
|
||||
if (err)
|
||||
return err;
|
||||
|
||||
break;
|
||||
}
|
||||
|
|
@ -382,22 +386,26 @@ eat_separator (st_parameter_dt *dtp)
|
|||
unget_char (dtp, c);
|
||||
break;
|
||||
}
|
||||
return err;
|
||||
}
|
||||
|
||||
|
||||
/* Finish processing a separator that was interrupted by a newline.
|
||||
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)
|
||||
{
|
||||
char c;
|
||||
int c;
|
||||
int err;
|
||||
|
||||
restart:
|
||||
eat_spaces (dtp);
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return LIBERROR_END;
|
||||
switch (c)
|
||||
{
|
||||
case ',':
|
||||
|
|
@ -405,7 +413,8 @@ finish_separator (st_parameter_dt *dtp)
|
|||
unget_char (dtp, c);
|
||||
else
|
||||
{
|
||||
c = eat_spaces (dtp);
|
||||
if ((c = eat_spaces (dtp)) == EOF)
|
||||
return LIBERROR_END;
|
||||
if (c == '\n' || c == '\r')
|
||||
goto restart;
|
||||
}
|
||||
|
|
@ -415,7 +424,7 @@ finish_separator (st_parameter_dt *dtp)
|
|||
case '/':
|
||||
dtp->u.p.input_complete = 1;
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
return;
|
||||
return err;
|
||||
break;
|
||||
|
||||
case '\n':
|
||||
|
|
@ -425,10 +434,9 @@ finish_separator (st_parameter_dt *dtp)
|
|||
case '!':
|
||||
if (dtp->u.p.namelist_mode)
|
||||
{
|
||||
do
|
||||
c = next_char (dtp);
|
||||
while (c != '\n');
|
||||
|
||||
err = eat_line (dtp);
|
||||
if (err)
|
||||
return err;
|
||||
goto restart;
|
||||
}
|
||||
|
||||
|
|
@ -436,6 +444,7 @@ finish_separator (st_parameter_dt *dtp)
|
|||
unget_char (dtp, c);
|
||||
break;
|
||||
}
|
||||
return err;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -535,10 +544,11 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
|
|||
static int
|
||||
parse_repeat (st_parameter_dt *dtp)
|
||||
{
|
||||
char c, message[100];
|
||||
int repeat;
|
||||
char message[100];
|
||||
int c, repeat;
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad_repeat;
|
||||
switch (c)
|
||||
{
|
||||
CASE_DIGITS:
|
||||
|
|
@ -599,8 +609,14 @@ parse_repeat (st_parameter_dt *dtp)
|
|||
|
||||
bad_repeat:
|
||||
|
||||
eat_line (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",
|
||||
dtp->u.p.item_count);
|
||||
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
|
||||
|
|
@ -631,8 +647,8 @@ l_push_char (st_parameter_dt *dtp, char c)
|
|||
static void
|
||||
read_logical (st_parameter_dt *dtp, int length)
|
||||
{
|
||||
char c, message[100];
|
||||
int i, v;
|
||||
char message[100];
|
||||
int c, i, v;
|
||||
|
||||
if (parse_repeat (dtp))
|
||||
return;
|
||||
|
|
@ -643,7 +659,8 @@ read_logical (st_parameter_dt *dtp, int length)
|
|||
{
|
||||
case 't':
|
||||
v = 1;
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad_logical;
|
||||
l_push_char (dtp, c);
|
||||
|
||||
if (!is_separator(c))
|
||||
|
|
@ -653,7 +670,8 @@ read_logical (st_parameter_dt *dtp, int length)
|
|||
break;
|
||||
case 'f':
|
||||
v = 0;
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad_logical;
|
||||
l_push_char (dtp, c);
|
||||
|
||||
if (!is_separator(c))
|
||||
|
|
@ -695,10 +713,8 @@ read_logical (st_parameter_dt *dtp, int length)
|
|||
|
||||
/* Eat trailing garbage. */
|
||||
do
|
||||
{
|
||||
c = next_char (dtp);
|
||||
}
|
||||
while (!is_separator (c));
|
||||
c = next_char (dtp);
|
||||
while (c != EOF && !is_separator (c));
|
||||
|
||||
unget_char (dtp, c);
|
||||
eat_separator (dtp);
|
||||
|
|
@ -746,8 +762,14 @@ read_logical (st_parameter_dt *dtp, int length)
|
|||
if (nml_bad_return (dtp, c))
|
||||
return;
|
||||
|
||||
eat_line (dtp);
|
||||
free_saved (dtp);
|
||||
if (c == EOF)
|
||||
{
|
||||
hit_eof (dtp);
|
||||
return;
|
||||
}
|
||||
else
|
||||
eat_line (dtp);
|
||||
sprintf (message, "Bad logical value while reading item %d",
|
||||
dtp->u.p.item_count);
|
||||
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
|
||||
|
|
@ -771,8 +793,8 @@ read_logical (st_parameter_dt *dtp, int length)
|
|||
static void
|
||||
read_integer (st_parameter_dt *dtp, int length)
|
||||
{
|
||||
char c, message[100];
|
||||
int negative;
|
||||
char message[100];
|
||||
int c, negative;
|
||||
|
||||
negative = 0;
|
||||
|
||||
|
|
@ -784,7 +806,8 @@ read_integer (st_parameter_dt *dtp, int length)
|
|||
/* Fall through... */
|
||||
|
||||
case '+':
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad_integer;
|
||||
goto get_integer;
|
||||
|
||||
CASE_SEPARATORS: /* Single null. */
|
||||
|
|
@ -829,7 +852,8 @@ read_integer (st_parameter_dt *dtp, int length)
|
|||
|
||||
/* Get the real integer. */
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad_integer;
|
||||
switch (c)
|
||||
{
|
||||
CASE_DIGITS:
|
||||
|
|
@ -875,9 +899,15 @@ read_integer (st_parameter_dt *dtp, int length)
|
|||
|
||||
if (nml_bad_return (dtp, c))
|
||||
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",
|
||||
dtp->u.p.item_count);
|
||||
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
|
||||
|
|
@ -905,11 +935,13 @@ read_integer (st_parameter_dt *dtp, int length)
|
|||
static void
|
||||
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. */
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto eof;
|
||||
switch (c)
|
||||
{
|
||||
CASE_DIGITS:
|
||||
|
|
@ -941,7 +973,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
|
|||
|
||||
for (;;)
|
||||
{
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto eof;
|
||||
switch (c)
|
||||
{
|
||||
CASE_DIGITS:
|
||||
|
|
@ -968,7 +1001,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
|
|||
|
||||
/* Now get the real string. */
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto eof;
|
||||
switch (c)
|
||||
{
|
||||
CASE_SEPARATORS:
|
||||
|
|
@ -989,7 +1023,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
|
|||
get_string:
|
||||
for (;;)
|
||||
{
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto eof;
|
||||
switch (c)
|
||||
{
|
||||
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
|
||||
the string. */
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto eof;
|
||||
if (c == quote)
|
||||
{
|
||||
push_char (dtp, quote);
|
||||
|
|
@ -1034,6 +1070,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
|
|||
invalid. */
|
||||
done:
|
||||
c = next_char (dtp);
|
||||
eof:
|
||||
if (is_separator (c) || c == '!')
|
||||
{
|
||||
unget_char (dtp, c);
|
||||
|
|
@ -1044,6 +1081,11 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
|
|||
else
|
||||
{
|
||||
free_saved (dtp);
|
||||
if (c == EOF)
|
||||
{
|
||||
hit_eof (dtp);
|
||||
return;
|
||||
}
|
||||
sprintf (message, "Invalid string input in item %d",
|
||||
dtp->u.p.item_count);
|
||||
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
|
||||
|
|
@ -1057,14 +1099,16 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
|
|||
static int
|
||||
parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
||||
{
|
||||
char c, message[100];
|
||||
int m, seen_dp;
|
||||
char message[100];
|
||||
int c, m, seen_dp;
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad;
|
||||
if (c == '-' || 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)
|
||||
|
|
@ -1084,7 +1128,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
|
||||
for (;;)
|
||||
{
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad;
|
||||
if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
|
||||
c = '.';
|
||||
switch (c)
|
||||
|
|
@ -1112,7 +1157,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
case '+':
|
||||
push_char (dtp, 'e');
|
||||
push_char (dtp, c);
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad;
|
||||
goto exp2;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
|
|
@ -1125,7 +1171,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
}
|
||||
|
||||
exp1:
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad;
|
||||
if (c != '-' && c != '+')
|
||||
push_char (dtp, '+');
|
||||
else
|
||||
|
|
@ -1142,7 +1189,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
|
||||
for (;;)
|
||||
{
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad;
|
||||
switch (c)
|
||||
{
|
||||
CASE_DIGITS:
|
||||
|
|
@ -1219,8 +1267,14 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
if (nml_bad_return (dtp, c))
|
||||
return 0;
|
||||
|
||||
eat_line (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",
|
||||
dtp->u.p.item_count);
|
||||
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)
|
||||
{
|
||||
char message[100];
|
||||
char c;
|
||||
int c;
|
||||
|
||||
if (parse_repeat (dtp))
|
||||
return;
|
||||
|
|
@ -1303,8 +1357,14 @@ eol_2:
|
|||
if (nml_bad_return (dtp, c))
|
||||
return;
|
||||
|
||||
eat_line (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",
|
||||
dtp->u.p.item_count);
|
||||
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
|
||||
|
|
@ -1316,7 +1376,8 @@ eol_2:
|
|||
static void
|
||||
read_real (st_parameter_dt *dtp, void * dest, int length)
|
||||
{
|
||||
char c, message[100];
|
||||
char message[100];
|
||||
int c;
|
||||
int seen_dp;
|
||||
int is_inf;
|
||||
|
||||
|
|
@ -1409,7 +1470,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
|
||||
/* Now get the number itself. */
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad_real;
|
||||
if (is_separator (c))
|
||||
{ /* Repeated null value. */
|
||||
unget_char (dtp, c);
|
||||
|
|
@ -1423,7 +1485,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
{
|
||||
got_sign:
|
||||
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)
|
||||
|
|
@ -1460,6 +1523,7 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
break;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
case EOF:
|
||||
goto done;
|
||||
|
||||
case '.':
|
||||
|
|
@ -1491,7 +1555,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
exp1:
|
||||
push_char (dtp, 'e');
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad_real;
|
||||
if (c != '+' && c != '-')
|
||||
push_char (dtp, '+');
|
||||
else
|
||||
|
|
@ -1612,7 +1677,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
if (c == ' ' || c =='\n' || c == '\r')
|
||||
{
|
||||
do
|
||||
c = next_char (dtp);
|
||||
{
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad_real;
|
||||
}
|
||||
while (c == ' ' || c =='\n' || c == '\r');
|
||||
|
||||
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))
|
||||
return;
|
||||
|
||||
eat_line (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",
|
||||
dtp->u.p.item_count);
|
||||
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
|
||||
greater than one, we copy the data item multiple times. */
|
||||
|
||||
static void
|
||||
list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
|
||||
static int
|
||||
list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
|
||||
int kind, size_t size)
|
||||
{
|
||||
char c;
|
||||
gfc_char4_t *q;
|
||||
int i, m;
|
||||
jmp_buf eof_jump;
|
||||
int c, i, m;
|
||||
int err = 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)
|
||||
{
|
||||
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.at_eol = 0;
|
||||
|
||||
c = eat_spaces (dtp);
|
||||
if ((c = eat_spaces (dtp)) == EOF)
|
||||
{
|
||||
err = LIBERROR_END;
|
||||
goto cleanup;
|
||||
}
|
||||
if (is_separator (c))
|
||||
{
|
||||
/* 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 (check_type (dtp, type, kind))
|
||||
return;
|
||||
return err;
|
||||
goto set_value;
|
||||
}
|
||||
|
||||
|
|
@ -1864,7 +1929,9 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
|
|||
free_saved (dtp);
|
||||
|
||||
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;
|
||||
size_t stride = type == BT_CHARACTER ?
|
||||
size * GFC_SIZE_OF_CHAR_KIND(kind) : size;
|
||||
int err;
|
||||
|
||||
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++)
|
||||
{
|
||||
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
|
||||
finish_list_read (st_parameter_dt *dtp)
|
||||
{
|
||||
char c;
|
||||
int err;
|
||||
|
||||
free_saved (dtp);
|
||||
|
||||
|
|
@ -1905,18 +1976,9 @@ finish_list_read (st_parameter_dt *dtp)
|
|||
return;
|
||||
}
|
||||
|
||||
do
|
||||
{
|
||||
c = next_char (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;
|
||||
}
|
||||
err = eat_line (dtp);
|
||||
if (err == LIBERROR_END)
|
||||
hit_eof (dtp);
|
||||
}
|
||||
|
||||
/* NAMELIST INPUT
|
||||
|
|
@ -1953,7 +2015,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
int neg;
|
||||
int null_flag;
|
||||
int is_array_section, is_char;
|
||||
char c;
|
||||
int c;
|
||||
|
||||
is_char = 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 '('. */
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return FAILURE;
|
||||
|
||||
/* Process the qualifier, by dimension and triplet. */
|
||||
|
||||
|
|
@ -1981,7 +2044,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
neg = 0;
|
||||
|
||||
/* Process a potential sign. */
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return FAILURE;
|
||||
switch (c)
|
||||
{
|
||||
case '-':
|
||||
|
|
@ -1999,7 +2063,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
/* Process characters up to the next ':' , ',' or ')'. */
|
||||
for (;;)
|
||||
{
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return FAILURE;
|
||||
|
||||
switch (c)
|
||||
{
|
||||
|
|
@ -2025,7 +2090,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
|
||||
case ' ': case '\t':
|
||||
eat_spaces (dtp);
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp) == EOF))
|
||||
return FAILURE;
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -2229,12 +2295,13 @@ static void
|
|||
nml_match_name (st_parameter_dt *dtp, const char *name, index_type len)
|
||||
{
|
||||
index_type i;
|
||||
char c;
|
||||
int c;
|
||||
|
||||
dtp->u.p.nml_read_error = 0;
|
||||
for (i = 0; i < len; i++)
|
||||
{
|
||||
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;
|
||||
break;
|
||||
|
|
@ -2591,7 +2658,7 @@ static try
|
|||
nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
|
||||
char *nml_err_msg, size_t nml_err_msg_size)
|
||||
{
|
||||
char c;
|
||||
int c;
|
||||
namelist_info * nl;
|
||||
namelist_info * first_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)
|
||||
return SUCCESS;
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return FAILURE;
|
||||
switch (c)
|
||||
{
|
||||
case '=':
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return FAILURE;
|
||||
if (c != '?')
|
||||
{
|
||||
sprintf (nml_err_msg, "namelist read: misplaced = sign");
|
||||
|
|
@ -2663,7 +2732,8 @@ get_name:
|
|||
{
|
||||
if (!is_separator (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 =='%' ));
|
||||
|
||||
unget_char (dtp, c);
|
||||
|
|
@ -2737,7 +2807,8 @@ get_name:
|
|||
|
||||
qualifier_flag = 1;
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return FAILURE;
|
||||
unget_char (dtp, c);
|
||||
}
|
||||
else if (nl->var_rank > 0)
|
||||
|
|
@ -2762,8 +2833,8 @@ get_name:
|
|||
root_nl = nl;
|
||||
|
||||
component_flag = 1;
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return FAILURE;
|
||||
goto get_name;
|
||||
}
|
||||
|
||||
|
|
@ -2799,7 +2870,8 @@ get_name:
|
|||
goto nml_err_ret;
|
||||
}
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return FAILURE;
|
||||
unget_char (dtp, c);
|
||||
}
|
||||
|
||||
|
|
@ -2838,7 +2910,8 @@ get_name:
|
|||
if (dtp->u.p.input_complete)
|
||||
return SUCCESS;
|
||||
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
return FAILURE;
|
||||
|
||||
if (c != '=')
|
||||
{
|
||||
|
|
@ -2883,8 +2956,7 @@ nml_err_ret:
|
|||
void
|
||||
namelist_read (st_parameter_dt *dtp)
|
||||
{
|
||||
char c;
|
||||
jmp_buf eof_jump;
|
||||
int c;
|
||||
char nml_err_msg[200];
|
||||
/* Pointer to the previously read object, in case attempt is made to read
|
||||
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.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.
|
||||
Exit on success or EOF. If '?' or '=?' encountered in stdin, print
|
||||
node names or namelist on stdout. */
|
||||
|
||||
find_nml_name:
|
||||
switch (c = next_char (dtp))
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto nml_err_eof;
|
||||
switch (c)
|
||||
{
|
||||
case '$':
|
||||
case '&':
|
||||
break;
|
||||
|
||||
case '!':
|
||||
eat_line (dtp);
|
||||
if (eat_line (dtp))
|
||||
goto nml_err_eof;
|
||||
goto find_nml_name;
|
||||
|
||||
case '=':
|
||||
c = next_char (dtp);
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto nml_err_eof;
|
||||
if (c == '?')
|
||||
nml_query (dtp, '=');
|
||||
else
|
||||
|
|
@ -2941,7 +3009,8 @@ find_nml_name:
|
|||
goto find_nml_name;
|
||||
|
||||
/* 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 != '!')
|
||||
{
|
||||
unget_char (dtp, c);
|
||||
|
|
@ -2965,16 +3034,17 @@ find_nml_name:
|
|||
}
|
||||
}
|
||||
|
||||
dtp->u.p.eof_jump = NULL;
|
||||
free_saved (dtp);
|
||||
free_line (dtp);
|
||||
return;
|
||||
|
||||
/* All namelist error calls return from here */
|
||||
|
||||
nml_err_eof:
|
||||
hit_eof (dtp);
|
||||
|
||||
nml_err_ret:
|
||||
|
||||
dtp->u.p.eof_jump = NULL;
|
||||
free_saved (dtp);
|
||||
free_line (dtp);
|
||||
generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg);
|
||||
|
|
|
|||
|
|
@ -2666,7 +2666,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
else
|
||||
{
|
||||
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
|
||||
dtp->u.p.transfer = formatted_transfer;
|
||||
}
|
||||
|
|
@ -3362,7 +3365,6 @@ next_record (st_parameter_dt *dtp, int done)
|
|||
static void
|
||||
finalize_transfer (st_parameter_dt *dtp)
|
||||
{
|
||||
jmp_buf eof_jump;
|
||||
GFC_INTEGER_4 cf = dtp->common.flags;
|
||||
|
||||
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)
|
||||
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)
|
||||
{
|
||||
finish_list_read (dtp);
|
||||
|
|
|
|||
Loading…
Reference in New Issue