#define CASE_DIGITS case '0': case '1': case '2': case '3': case '4': \
case '5': case '6': case '7': case '8': case '9'
-#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t': \
- case '\r': case ';': case '!'
+#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': \
+ case '\t': case '\r': case ';'
/* This macro assumes that we're operating on a variable. */
#define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \
- || c == '\t' || c == '\r' || c == ';' || c == '!')
+ || c == '\t' || c == '\r' || c == ';' || \
+ (dtp->u.p.namelist_mode && c == '!'))
/* Maximum repeat count. Less than ten times the maximum signed int32. */
/* Worker function to save a default KIND=1 character to a string
buffer, enlarging it as necessary. */
-
+
static void
push_char_default (st_parameter_dt *dtp, int c)
{
if (dtp->u.p.saved_used >= dtp->u.p.saved_length)
{
dtp->u.p.saved_length = 2 * dtp->u.p.saved_length;
- dtp->u.p.saved_string =
+ dtp->u.p.saved_string =
xrealloc (dtp->u.p.saved_string, dtp->u.p.saved_length);
-
- // Also this should not be necessary.
- memset (dtp->u.p.saved_string + dtp->u.p.saved_used, 0,
- dtp->u.p.saved_length - dtp->u.p.saved_used);
-
}
dtp->u.p.saved_string[dtp->u.p.saved_used++] = (char) c;
/* Worker function to save a KIND=4 character to a string buffer,
enlarging the buffer as necessary. */
-
static void
push_char4 (st_parameter_dt *dtp, int c)
{
- gfc_char4_t *new, *p = (gfc_char4_t *) dtp->u.p.saved_string;
+ gfc_char4_t *p = (gfc_char4_t *) dtp->u.p.saved_string;
if (p == NULL)
{
{
dtp->u.p.saved_length = 2 * dtp->u.p.saved_length;
p = xrealloc (p, dtp->u.p.saved_length * sizeof (gfc_char4_t));
-
- memset4 (new + dtp->u.p.saved_used, 0,
- dtp->u.p.saved_length - dtp->u.p.saved_used);
}
p[dtp->u.p.saved_used++] = c;
/* Unget saves the last character so when reading the next character,
we need to check to see if there is a character waiting. Similar,
if the line buffer is being used to read_logical, check it too. */
-
+
static int
check_buffers (st_parameter_dt *dtp)
{
dtp->u.p.line_buffer_pos = 0;
dtp->u.p.line_buffer_enabled = 0;
}
-
+
done:
dtp->u.p.at_eol = (c == '\n' || c == EOF);
return c;
record = next_array_record (dtp, dtp->u.p.current_unit->ls,
&finished);
- /* Check for "end-of-file" condition. */
+ /* Check for "end-of-file" condition. */
if (finished)
{
dtp->u.p.at_eof = 1;
if (is_array_io (dtp))
{
- /* Check whether we hit EOF. */
+ /* Check whether we hit EOF. */
if (unlikely (length == 0))
{
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
return '\0';
- }
+ }
dtp->u.p.current_unit->bytes_left--;
}
else
{
- if (dtp->u.p.at_eof)
+ if (dtp->u.p.at_eof)
return EOF;
if (length == 0)
{
/* Worker function for UTF encoded files. */
static int
-next_char_utf8 (st_parameter_dt *dtp)
+next_char_utf8 (st_parameter_dt *dtp)
{
static const uchar masks[6] = { 0x7F, 0x1F, 0x0F, 0x07, 0x02, 0x01 };
static const uchar patns[6] = { 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC };
if ((c & ~masks[nb-1]) == patns[nb-1])
goto found;
goto invalid;
-
+
found:
c = (c & masks[nb-1]);
utf_done:
dtp->u.p.at_eol = (c == '\n' || c == (gfc_char4_t) EOF);
return (int) c;
-
+
invalid:
generate_error (&dtp->common, LIBERROR_READ_VALUE, "Invalid UTF-8 encoding");
return (gfc_char4_t) '?';
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.
Returns 0 for success, and non-zero error code otherwise. */
break;
case '!':
+ /* Eat a namelist comment. */
if (dtp->u.p.namelist_mode)
- { /* Eat a namelist comment. */
- notify_std (&dtp->common, GFC_STD_GNU,
- "'!' in namelist is not a valid separator,"
- " try inserting a space");
+ {
err = eat_line (dtp);
if (err)
return err;
/* To read a logical we have to look ahead in the input stream to make sure
- there is not an equal sign indicating a variable name. To do this we use
+ there is not an equal sign indicating a variable name. To do this we use
line_buffer to point to a temporary buffer, pushing characters there for
possible later reading. */
break;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_logical;
+
CASE_SEPARATORS:
case EOF:
unget_char (dtp, c);
goto logical_done;
}
}
-
+
l_push_char (dtp, c);
if (c == '=')
{
dtp->u.p.line_buffer_pos = 0;
return;
}
-
+
}
bad_logical:
goto bad_integer;
goto get_integer;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_integer;
+
CASE_SEPARATORS: /* Single null. */
unget_char (dtp, c);
eat_separator (dtp);
push_char (dtp, '\0');
goto repeat;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_integer;
+
CASE_SEPARATORS: /* Not a repeat count. */
case EOF:
goto done;
CASE_DIGITS:
break;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_integer;
+
CASE_SEPARATORS:
unget_char (dtp, c);
eat_separator (dtp);
push_char (dtp, c);
break;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_integer;
+
CASE_SEPARATORS:
case EOF:
goto done;
if (nml_bad_return (dtp, c))
return;
- free_saved (dtp);
+ free_saved (dtp);
if (c == EOF)
{
free_line (dtp);
push_char (dtp, c);
break;
}
-
+
/* See if we have a doubled quote character or the end of
the string. */
-
+
if ((c = next_char (dtp)) == EOF)
goto done_eof;
if (c == quote)
push_char (dtp, quote);
break;
}
-
+
unget_char (dtp, c);
goto done;
-
+
CASE_SEPARATORS:
if (quote == ' ')
{
unget_char (dtp, c);
goto done;
}
-
+
if (c != '\n' && c != '\r')
push_char (dtp, c);
break;
-
+
default:
push_char (dtp, c);
break;
done:
c = next_char (dtp);
done_eof:
- if (is_separator (c) || c == '!' || c == EOF)
+ if (is_separator (c) || c == EOF)
{
unget_char (dtp, c);
eat_separator (dtp);
dtp->u.p.saved_type = BT_CHARACTER;
}
- else
+ else
{
free_saved (dtp);
snprintf (message, MSGLEN, "Invalid string input in item %d",
if ((c = next_char (dtp)) == EOF)
goto bad;
-
+
if (c == '-' || c == '+')
{
push_char (dtp, c);
if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
c = '.';
-
+
if (!isdigit (c) && c != '.')
{
if (c == 'i' || c == 'I' || c == 'n' || c == 'N')
goto bad;
goto exp2;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad;
+
CASE_SEPARATORS:
case EOF:
goto done;
push_char (dtp, c);
break;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad;
+
CASE_SEPARATORS:
case EOF:
unget_char (dtp, c);
push_char (dtp, 'n');
push_char (dtp, 'a');
push_char (dtp, 'n');
-
+
/* Match "NAN(alphanum)". */
if (c == '(')
{
case '(':
break;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_complex;
+
CASE_SEPARATORS:
case EOF:
unget_char (dtp, c);
if (parse_real (dtp, dest + size / 2, kind))
return;
-
+
eol_4:
eat_spaces (dtp);
c = next_char (dtp);
hit_eof (dtp);
return;
}
- else if (c != '\n')
+ else if (c != '\n')
eat_line (dtp);
snprintf (message, MSGLEN, "Bad complex value in item %d of list input",
case '-':
goto got_sign;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_real;
+
CASE_SEPARATORS:
unget_char (dtp, c); /* Single null. */
eat_separator (dtp);
push_char (dtp, '\0');
goto got_repeat;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_real;
+
CASE_SEPARATORS:
case EOF:
if (c != '\n' && c != ',' && c != '\r' && c != ';')
push_char (dtp, c);
break;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_real;
+
CASE_SEPARATORS:
case EOF:
goto done;
push_char (dtp, c);
break;
+ case '!':
+ if (!dtp->u.p.namelist_mode)
+ goto bad_real;
+
CASE_SEPARATORS:
case EOF:
goto done;
goto unwind;
if (dtp->u.p.namelist_mode)
- {
+ {
if (c == ' ' || c =='\n' || c == '\r')
{
do
dtp->u.p.input_complete = 0;
dtp->u.p.repeat_count = 1;
dtp->u.p.at_eol = 0;
-
+
if ((c = eat_spaces (dtp)) == EOF)
{
err = LIBERROR_END;
return err;
goto set_value;
}
-
+
if (dtp->u.p.input_complete)
goto cleanup;
for (elem = 0; elem < nelems; elem++)
{
dtp->u.p.item_count++;
- err = list_formatted_read_scalar (dtp, type, tmp + stride*elem,
+ err = list_formatted_read_scalar (dtp, type, tmp + stride*elem,
kind, size);
if (err)
break;
|| (c==')' && dim < rank -1))
{
if (is_char)
- snprintf (parse_err_msg, parse_err_msg_size,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Bad substring qualifier");
else
- snprintf (parse_err_msg, parse_err_msg_size,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Bad number of index fields");
goto err_ret;
}
snprintf (parse_err_msg, parse_err_msg_size,
"Bad character in substring qualifier");
else
- snprintf (parse_err_msg, parse_err_msg_size,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Bad character in index");
goto err_ret;
}
&& dtp->u.p.saved_string == 0)
{
if (is_char)
- snprintf (parse_err_msg, parse_err_msg_size,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Null substring qualifier");
else
- snprintf (parse_err_msg, parse_err_msg_size,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Null index field");
goto err_ret;
}
|| (indx == 2 && dtp->u.p.saved_string == 0))
{
if (is_char)
- snprintf (parse_err_msg, parse_err_msg_size,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Bad substring qualifier");
else
snprintf (parse_err_msg, parse_err_msg_size,
|| (ls[dim].end < GFC_DIMENSION_LBOUND(ad[dim])))
{
if (is_char)
- snprintf (parse_err_msg, parse_err_msg_size,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Substring out of range");
else
- snprintf (parse_err_msg, parse_err_msg_size,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Index %d out of range", dim + 1);
goto err_ret;
}
if (((ls[dim].end - ls[dim].start ) * ls[dim].step < 0)
|| (ls[dim].step == 0))
{
- snprintf (parse_err_msg, parse_err_msg_size,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Bad range in index %d", dim + 1);
goto err_ret;
}
strcmp_extended_type (char *p, char *q)
{
char *r, *s;
-
+
for (r = p, s = q; *r && *s; r++, s++)
{
if (*r != *s)
goto nml_err_ret;
if (c != '?')
{
- snprintf (nml_err_msg, nml_err_msg_size,
+ snprintf (nml_err_msg, nml_err_msg_size,
"namelist read: misplaced = sign");
goto nml_err_ret;
}
nml_match_name (dtp, "end", 3);
if (dtp->u.p.nml_read_error)
{
- snprintf (nml_err_msg, nml_err_msg_size,
+ snprintf (nml_err_msg, nml_err_msg_size,
"namelist not terminated with / or &end");
goto nml_err_ret;
}
dtp->u.p.namelist_mode = 1;
dtp->u.p.input_complete = 0;
dtp->u.p.expanded_read = 0;
-
+
/* Set the next_char and push_char worker functions. */
set_workers (dtp);
if (dtp->u.p.nml_read_error)
goto find_nml_name;
- /* A trailing space is required, we give a little latitude here, 10.9.1. */
+ /* A trailing space is required, we give a little latitude here, 10.9.1. */
c = next_char (dtp);
if (!is_separator(c) && c != '!')
{
projects / platform / upstream / linaro-gcc.git / commitdiff