-/* 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);
}
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:
}
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)
}
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))
}
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;
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,
+ array_loop_spec *ls, int rank, bt nml_elem_type,
+ char *parse_err_msg, size_t parse_err_msg_size,
int *parsed_rank)
{
int dim;
/* The next character in the stream should be the '('. */
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ goto err_ret;
/* Process the qualifier, by dimension and triplet. */
/* Process a potential sign. */
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ goto err_ret;
switch (c)
{
case '-':
/* Process characters up to the next ':' , ',' or ')'. */
for (;;)
{
- if ((c = next_char (dtp)) == EOF)
- return FAILURE;
-
+ c = next_char (dtp);
switch (c)
{
+ case EOF:
+ goto err_ret;
+
case ':':
is_array_section = 1;
break;
|| (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;
push_char (dtp, c);
continue;
- case ' ': case '\t':
+ case ' ': case '\t': case '\r': case '\n':
eat_spaces (dtp);
- if ((c = next_char (dtp) == EOF))
- return FAILURE;
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)
+ || nml_elem_type == BT_DERIVED)
ls[dim].end = ls[dim].start;
else
dtp->u.p.expanded_read = 1;
}
/* 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;
}
err_ret:
+ /* The EOF error message is issued by hit_eof. Return true so that the
+ caller does not use parse_err_msg and parse_err_msg_size to generate
+ an unrelated error message. */
+ if (c == EOF)
+ {
+ hit_eof (dtp);
+ dtp->u.p.input_complete = 1;
+ return SUCCESS;
+ }
return FAILURE;
}
index_type len;
char * p;
#ifdef HAVE_CRLF
- static const index_type endlen = 3;
+ static const index_type endlen = 2;
static const char endl[] = "\r\n";
static const char nmlend[] = "&end\r\n";
#else
- static const index_type endlen = 2;
+ static const index_type endlen = 1;
static const char endl[] = "\n";
static const char nmlend[] = "&end\n";
#endif
/* "&namelist_name\n" */
len = dtp->namelist_name_len;
- p = write_block (dtp, len + endlen);
+ p = write_block (dtp, len - 1 + endlen);
if (!p)
goto query_return;
memcpy (p, "&", 1);
memcpy ((char*)(p + 1), dtp->namelist_name, len);
- memcpy ((char*)(p + len + 1), &endl, endlen - 1);
+ memcpy ((char*)(p + len + 1), &endl, endlen);
for (nl = dtp->u.p.ionml; nl; nl = nl->next)
{
/* " var_name\n" */
goto query_return;
memcpy (p, " ", 1);
memcpy ((char*)(p + 1), nl->var_name, len);
- memcpy ((char*)(p + len + 1), &endl, endlen - 1);
+ memcpy ((char*)(p + len + 1), &endl, endlen);
}
/* "&end\n" */
- p = write_block (dtp, endlen + 3);
+ p = write_block (dtp, endlen + 4);
+ if (!p)
goto query_return;
- memcpy (p, &nmlend, endlen + 3);
+ memcpy (p, &nmlend, endlen + 4);
}
/* Flush the stream to force immediate output. */
since a single object can have multiple reads. */
dtp->u.p.expanded_read = 0;
- /* Now loop over the components. Update the component pointer
- with the return value from nml_write_obj. This loop jumps
- past nested derived types by testing if the potential
- component name contains '%'. */
+ /* Now loop over the components. */
for (cmp = nl->next;
cmp &&
- !strncmp (cmp->var_name, obj_name, obj_name_len) &&
- !strchr (cmp->var_name + obj_name_len, '%');
+ !strncmp (cmp->var_name, obj_name, obj_name_len);
cmp = cmp->next)
{
+ /* Jump over nested derived type by testing if the potential
+ component name contains '%'. */
+ if (strchr (cmp->var_name + obj_name_len, '%'))
+ continue;
if (nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos),
pprev_nl, nml_err_msg, nml_err_msg_size,
return SUCCESS;
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ goto nml_err_ret;
switch (c)
{
case '=':
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ goto nml_err_ret;
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 '/':
if (!is_separator (c))
push_char (dtp, tolower(c));
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
- } while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' ));
+ goto nml_err_ret;
+ }
+ while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' ));
unget_char (dtp, c);
{
parsed_rank = 0;
if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
- nml_err_msg, &parsed_rank) == FAILURE)
+ nl->type, 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,
qualifier_flag = 1;
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ goto nml_err_ret;
unget_char (dtp, c);
}
else if (nl->var_rank > 0)
goto nml_err_ret;
}
- if (*pprev_nl == NULL || !component_flag)
+ /* Don't move first_nl further in the list if a qualifier was found. */
+ if ((*pprev_nl == NULL && !qualifier_flag) || !component_flag)
first_nl = nl;
root_nl = nl;
component_flag = 1;
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ goto nml_err_ret;
goto get_name;
}
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, nl->type,
+ nml_err_msg, nml_err_msg_size, &parsed_rank)
== FAILURE)
{
char *nml_err_msg_end = strchr (nml_err_msg, '\0');
}
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ goto nml_err_ret;
unget_char (dtp, c);
}
return SUCCESS;
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ goto nml_err_ret;
if (c != '=')
{
nml_err_ret:
+ /* The EOF error message is issued by hit_eof. Return true so that the
+ caller does not use nml_err_msg and nml_err_msg_size to generate
+ an unrelated error message. */
+ if (c == EOF)
+ {
+ dtp->u.p.input_complete = 1;
+ unget_char (dtp, c);
+ hit_eof (dtp);
+ return SUCCESS;
+ }
+
return FAILURE;
}
case '?':
nml_query (dtp, '?');
+ goto find_nml_name;
case EOF:
return;
OSDN Git Service
