-/* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009, 2010
+/* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009, 2010, 2011
Free Software Foundation, Inc.
Contributed by Andy Vaught
Namelist input contributed by Paul Thomas
#define MAX_REPEAT 200000000
-#ifndef HAVE_SNPRINTF
-# undef snprintf
-# define snprintf(str, size, ...) sprintf (str, __VA_ARGS__)
-#endif
+
+#define MSGLEN 100
/* Save a character to a string buffer, enlarging it as necessary. */
err = eat_line (dtp);
if (err)
return err;
- if ((c = next_char (dtp)) == EOF)
- return LIBERROR_END;
- if (c == '!')
- {
- err = eat_line (dtp);
- if (err)
- return err;
- if ((c = next_char (dtp)) == EOF)
- return LIBERROR_END;
- }
+ c = '\n';
}
}
while (c == '\n' || c == '\r' || c == ' ' || c == '\t');
static int
convert_integer (st_parameter_dt *dtp, int length, int negative)
{
- char c, *buffer, message[100];
+ char c, *buffer, message[MSGLEN];
int m;
GFC_INTEGER_LARGEST v, max, max10;
if (dtp->u.p.repeat_count == 0)
{
- sprintf (message, "Zero repeat count in item %d of list input",
+ snprintf (message, MSGLEN, "Zero repeat count in item %d of list input",
dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
overflow:
if (length == -1)
- sprintf (message, "Repeat count overflow in item %d of list input",
+ snprintf (message, MSGLEN, "Repeat count overflow in item %d of list input",
dtp->u.p.item_count);
else
- sprintf (message, "Integer overflow while reading item %d",
+ snprintf (message, MSGLEN, "Integer overflow while reading item %d",
dtp->u.p.item_count);
free_saved (dtp);
static int
parse_repeat (st_parameter_dt *dtp)
{
- char message[100];
+ char message[MSGLEN];
int c, repeat;
if ((c = next_char (dtp)) == EOF)
if (repeat > MAX_REPEAT)
{
- sprintf (message,
+ snprintf (message, MSGLEN,
"Repeat count overflow in item %d of list input",
dtp->u.p.item_count);
case '*':
if (repeat == 0)
{
- sprintf (message,
+ snprintf (message, MSGLEN,
"Zero repeat count in item %d of list input",
dtp->u.p.item_count);
}
else
eat_line (dtp);
- sprintf (message, "Bad repeat count in item %d of list input",
+ snprintf (message, MSGLEN, "Bad repeat count in item %d of list input",
dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1;
static void
read_logical (st_parameter_dt *dtp, int length)
{
- char message[100];
+ char message[MSGLEN];
int c, i, v;
if (parse_repeat (dtp))
{
case 't':
v = 1;
- if ((c = next_char (dtp)) == EOF)
- goto bad_logical;
+ c = next_char (dtp);
l_push_char (dtp, c);
- if (!is_separator(c))
+ if (!is_separator(c) && c != EOF)
goto possible_name;
unget_char (dtp, c);
break;
case 'f':
v = 0;
- if ((c = next_char (dtp)) == EOF)
- goto bad_logical;
+ c = next_char (dtp);
l_push_char (dtp, c);
- if (!is_separator(c))
+ if (!is_separator(c) && c != EOF)
goto possible_name;
unget_char (dtp, c);
hit_eof (dtp);
return;
}
- else
+ else if (c != '\n')
eat_line (dtp);
- sprintf (message, "Bad logical value while reading item %d",
+ snprintf (message, MSGLEN, "Bad logical value while reading item %d",
dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return;
static void
read_integer (st_parameter_dt *dtp, int length)
{
- char message[100];
+ char message[MSGLEN];
int c, negative;
negative = 0;
goto repeat;
CASE_SEPARATORS: /* Not a repeat count. */
+ case EOF:
goto done;
default:
break;
CASE_SEPARATORS:
+ case EOF:
goto done;
default:
hit_eof (dtp);
return;
}
- else
+ else if (c != '\n')
eat_line (dtp);
- sprintf (message, "Bad integer for item %d in list input",
+ snprintf (message, MSGLEN, "Bad integer for item %d in list input",
dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
static void
read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
{
- char quote, message[100];
+ char quote, message[MSGLEN];
int c;
quote = ' '; /* Space means no quote character. */
for (;;)
{
if ((c = next_char (dtp)) == EOF)
- goto eof;
+ goto done_eof;
switch (c)
{
case '"':
invalid. */
done:
c = next_char (dtp);
- eof:
- if (is_separator (c) || c == '!')
+ done_eof:
+ if (is_separator (c) || c == '!' || c == EOF)
{
unget_char (dtp, c);
eat_separator (dtp);
dtp->u.p.saved_type = BT_CHARACTER;
free_line (dtp);
}
- else
+ else
{
free_saved (dtp);
- if (c == EOF)
- {
- hit_eof (dtp);
- return;
- }
- sprintf (message, "Invalid string input in item %d",
+ snprintf (message, MSGLEN, "Invalid string input in item %d",
dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
}
+ return;
+
+ eof:
+ free_saved (dtp);
+ hit_eof (dtp);
}
static int
parse_real (st_parameter_dt *dtp, void *buffer, int length)
{
- char message[100];
+ char message[MSGLEN];
int c, m, seen_dp;
if ((c = next_char (dtp)) == EOF)
goto bad;
+
if (c == '-' || c == '+')
{
push_char (dtp, c);
goto exp2;
CASE_SEPARATORS:
- unget_char (dtp, c);
goto done;
default:
return m;
+ done_infnan:
+ unget_char (dtp, c);
+ push_char (dtp, '\0');
+
+ m = convert_infnan (dtp, buffer, dtp->u.p.saved_string, length);
+ free_saved (dtp);
+
+ return m;
+
inf_nan:
/* Match INF and Infinity. */
if ((c == 'i' || c == 'I')
push_char (dtp, 'i');
push_char (dtp, 'n');
push_char (dtp, 'f');
- goto done;
+ goto done_infnan;
}
} /* Match NaN. */
else if (((c = next_char (dtp)) == 'a' || c == 'A')
if (is_separator (c))
unget_char (dtp, c);
}
- goto done;
+ goto done_infnan;
}
bad:
hit_eof (dtp);
return 1;
}
- else
+ else if (c != '\n')
eat_line (dtp);
- sprintf (message, "Bad floating point number for item %d",
+ snprintf (message, MSGLEN, "Bad floating point number for item %d",
dtp->u.p.item_count);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
static void
read_complex (st_parameter_dt *dtp, void * dest, int kind, size_t size)
{
- char message[100];
+ char message[MSGLEN];
int c;
if (parse_repeat (dtp))
goto bad_complex;
}
+eol_1:
eat_spaces (dtp);
+ c = next_char (dtp);
+ if (c == '\n' || c== '\r')
+ goto eol_1;
+ else
+ unget_char (dtp, c);
+
if (parse_real (dtp, dest, kind))
return;
-eol_1:
+eol_2:
eat_spaces (dtp);
c = next_char (dtp);
if (c == '\n' || c== '\r')
- goto eol_1;
+ goto eol_2;
else
unget_char (dtp, c);
!= (dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';'))
goto bad_complex;
-eol_2:
+eol_3:
eat_spaces (dtp);
c = next_char (dtp);
if (c == '\n' || c== '\r')
- goto eol_2;
+ goto eol_3;
else
unget_char (dtp, c);
if (parse_real (dtp, dest + size / 2, kind))
return;
-
+
+eol_4:
eat_spaces (dtp);
+ c = next_char (dtp);
+ if (c == '\n' || c== '\r')
+ goto eol_4;
+ else
+ unget_char (dtp, c);
+
if (next_char (dtp) != ')')
goto bad_complex;
hit_eof (dtp);
return;
}
- else
+ else if (c != '\n')
eat_line (dtp);
- sprintf (message, "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);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
}
static void
read_real (st_parameter_dt *dtp, void * dest, int length)
{
- char message[100];
+ char message[MSGLEN];
int c;
int seen_dp;
int is_inf;
}
free_line (dtp);
- goto done;
+ unget_char (dtp, c);
+ eat_separator (dtp);
+ push_char (dtp, '\0');
+ if (convert_infnan (dtp, dest, dtp->u.p.saved_string, length))
+ return;
+
+ free_saved (dtp);
+ dtp->u.p.saved_type = BT_REAL;
+ return;
unwind:
if (dtp->u.p.namelist_mode)
hit_eof (dtp);
return;
}
- else
+ else if (c != '\n')
eat_line (dtp);
- sprintf (message, "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);
generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
}
static int
check_type (st_parameter_dt *dtp, bt type, int len)
{
- char message[100];
+ char message[MSGLEN];
if (dtp->u.p.saved_type != BT_UNKNOWN && dtp->u.p.saved_type != type)
{
- sprintf (message, "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),
dtp->u.p.item_count);
if (dtp->u.p.saved_length != len)
{
- sprintf (message,
+ snprintf (message, MSGLEN,
"Read kind %d %s where kind %d is required for item %d",
dtp->u.p.saved_length, type_name (dtp->u.p.saved_type), len,
dtp->u.p.item_count);
static try
nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
array_loop_spec *ls, int rank, char *parse_err_msg,
+ size_t parse_err_msg_size,
int *parsed_rank)
{
int dim;
|| (c==')' && dim < rank -1))
{
if (is_char)
- sprintf (parse_err_msg, "Bad substring qualifier");
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Bad substring qualifier");
else
- sprintf (parse_err_msg, "Bad number of index fields");
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Bad number of index fields");
goto err_ret;
}
break;
default:
if (is_char)
- sprintf (parse_err_msg,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Bad character in substring qualifier");
else
- sprintf (parse_err_msg, "Bad character in index");
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Bad character in index");
goto err_ret;
}
&& dtp->u.p.saved_string == 0)
{
if (is_char)
- sprintf (parse_err_msg, "Null substring qualifier");
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Null substring qualifier");
else
- sprintf (parse_err_msg, "Null index field");
+ 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)
- sprintf (parse_err_msg, "Bad substring qualifier");
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Bad substring qualifier");
else
- sprintf (parse_err_msg, "Bad index triplet");
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Bad index triplet");
goto err_ret;
}
if (is_char && !is_array_section)
{
- sprintf (parse_err_msg,
+ snprintf (parse_err_msg, parse_err_msg_size,
"Missing colon in substring qualifier");
goto err_ret;
}
}
/* Now read the index. */
- if (convert_integer (dtp, sizeof(ssize_t), neg))
+ if (convert_integer (dtp, sizeof(index_type), neg))
{
if (is_char)
- sprintf (parse_err_msg, "Bad integer substring qualifier");
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Bad integer substring qualifier");
else
- sprintf (parse_err_msg, "Bad integer in index");
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Bad integer in index");
goto err_ret;
}
break;
if (!null_flag)
{
if (indx == 0)
- memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t));
+ memcpy (&ls[dim].start, dtp->u.p.value, sizeof(index_type));
if (indx == 1)
- memcpy (&ls[dim].end, dtp->u.p.value, sizeof(ssize_t));
+ memcpy (&ls[dim].end, dtp->u.p.value, sizeof(index_type));
if (indx == 2)
- memcpy (&ls[dim].step, dtp->u.p.value, sizeof(ssize_t));
+ memcpy (&ls[dim].step, dtp->u.p.value, sizeof(index_type));
}
/* Singlet or doublet indices. */
{
if (indx == 0)
{
- memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t));
+ memcpy (&ls[dim].start, dtp->u.p.value, sizeof(index_type));
/* If -std=f95/2003 or an array section is specified,
do not allow excess data to be processed. */
if (is_array_section == 1
|| !(compile_options.allow_std & GFC_STD_GNU)
- || !dtp->u.p.ionml->touched
|| dtp->u.p.ionml->type == BT_DERIVED)
ls[dim].end = ls[dim].start;
else
}
/* Check the values of the triplet indices. */
- if ((ls[dim].start > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim]))
- || (ls[dim].start < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim]))
- || (ls[dim].end > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim]))
- || (ls[dim].end < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim])))
+ if ((ls[dim].start > GFC_DIMENSION_UBOUND(ad[dim]))
+ || (ls[dim].start < GFC_DIMENSION_LBOUND(ad[dim]))
+ || (ls[dim].end > GFC_DIMENSION_UBOUND(ad[dim]))
+ || (ls[dim].end < GFC_DIMENSION_LBOUND(ad[dim])))
{
if (is_char)
- sprintf (parse_err_msg, "Substring out of range");
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Substring out of range");
else
- sprintf (parse_err_msg, "Index %d out of range", dim + 1);
+ 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))
{
- sprintf (parse_err_msg, "Bad range in index %d", dim + 1);
+ snprintf (parse_err_msg, parse_err_msg_size,
+ "Bad range in index %d", dim + 1);
goto err_ret;
}
return FAILURE;
if (c != '?')
{
- sprintf (nml_err_msg, "namelist read: misplaced = sign");
+ snprintf (nml_err_msg, nml_err_msg_size,
+ "namelist read: misplaced = sign");
goto nml_err_ret;
}
nml_query (dtp, '=');
nml_match_name (dtp, "end", 3);
if (dtp->u.p.nml_read_error)
{
- sprintf (nml_err_msg, "namelist not terminated with / or &end");
+ snprintf (nml_err_msg, nml_err_msg_size,
+ "namelist not terminated with / or &end");
goto nml_err_ret;
}
case '/':
{
parsed_rank = 0;
if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
- nml_err_msg, &parsed_rank) == FAILURE)
+ nml_err_msg, nml_err_msg_size,
+ &parsed_rank) == FAILURE)
{
char *nml_err_msg_end = strchr (nml_err_msg, '\0');
snprintf (nml_err_msg_end,
descriptor_dimension chd[1] = { {1, clow, nl->string_length} };
array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} };
- if (nml_parse_qualifier (dtp, chd, ind, -1, nml_err_msg, &parsed_rank)
+ if (nml_parse_qualifier (dtp, chd, ind, -1, nml_err_msg,
+ nml_err_msg_size, &parsed_rank)
== FAILURE)
{
char *nml_err_msg_end = strchr (nml_err_msg, '\0');
{
int c;
char nml_err_msg[200];
+
+ /* Initialize the error string buffer just in case we get an unexpected fail
+ somewhere and end up at nml_err_ret. */
+ strcpy (nml_err_msg, "Internal namelist read error");
+
/* Pointer to the previously read object, in case attempt is made to read
new object name. Should this fail, error message can give previous
name. */
goto nml_err_ret;
generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg);
}
+
+ /* Reset the previous namelist pointer if we know we are not going
+ to be doing multiple reads within a single namelist object. */
+ if (prev_nl && prev_nl->var_rank == 0)
+ prev_nl = NULL;
}
free_saved (dtp);
OSDN Git Service
