-/* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005, 2007 Free Software Foundation, Inc.
Contributed by Andy Vaught
Namelist input contributed by Paul Thomas
/* Handle the end-of-record and end-of-file conditions for
internal array unit. */
- if (is_array_io(dtp))
+ if (is_array_io (dtp))
{
if (dtp->u.p.at_eof)
longjmp (*dtp->u.p.eof_jump, 1);
if (is_stream_io (dtp))
dtp->u.p.current_unit->strm_pos++;
- if (is_internal_unit(dtp))
+ if (is_internal_unit (dtp))
{
- if (is_array_io(dtp))
+ if (is_array_io (dtp))
{
/* End of record is handled in the next pass through, above. The
check for NULL here is cautionary. */
case '/':
dtp->u.p.input_complete = 1;
- if (!dtp->u.p.namelist_mode) next_record (dtp, 0);
+ if (!dtp->u.p.namelist_mode)
+ return;
break;
case '\n':
if (dtp->u.p.repeat_count == 0)
{
- st_sprintf (message, "Zero repeat count in item %d of list input",
- dtp->u.p.item_count);
+ sprintf (message, "Zero repeat count in item %d of list input",
+ dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
m = 1;
overflow:
if (length == -1)
- st_sprintf (message, "Repeat count overflow in item %d of list input",
- dtp->u.p.item_count);
+ sprintf (message, "Repeat count overflow in item %d of list input",
+ dtp->u.p.item_count);
else
- st_sprintf (message, "Integer overflow while reading item %d",
- dtp->u.p.item_count);
+ sprintf (message, "Integer overflow while reading item %d",
+ dtp->u.p.item_count);
free_saved (dtp);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
if (repeat > MAX_REPEAT)
{
- st_sprintf (message,
- "Repeat count overflow in item %d of list input",
- dtp->u.p.item_count);
+ sprintf (message,
+ "Repeat count overflow in item %d of list input",
+ dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
return 1;
case '*':
if (repeat == 0)
{
- st_sprintf (message,
- "Zero repeat count in item %d of list input",
- dtp->u.p.item_count);
+ sprintf (message,
+ "Zero repeat count in item %d of list input",
+ dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
return 1;
eat_line (dtp);
free_saved (dtp);
- st_sprintf (message, "Bad repeat count in item %d of list input",
- dtp->u.p.item_count);
+ sprintf (message, "Bad repeat count in item %d of list input",
+ dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
return 1;
}
eat_line (dtp);
free_saved (dtp);
- st_sprintf (message, "Bad logical value while reading item %d",
+ sprintf (message, "Bad logical value while reading item %d",
dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
return;
eat_line (dtp);
free_saved (dtp);
- st_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);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
else
{
free_saved (dtp);
- st_sprintf (message, "Invalid string input in item %d",
+ sprintf (message, "Invalid string input in item %d",
dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
}
eat_line (dtp);
free_saved (dtp);
- st_sprintf (message, "Bad floating point number for item %d",
+ sprintf (message, "Bad floating point number for item %d",
dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
eat_line (dtp);
free_saved (dtp);
- st_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);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
}
eat_line (dtp);
free_saved (dtp);
- st_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);
generate_error (&dtp->common, ERROR_READ_VALUE, message);
}
if (dtp->u.p.saved_type != BT_NULL && dtp->u.p.saved_type != type)
{
- st_sprintf (message, "Read type %s where %s was expected for item %d",
+ sprintf (message, "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)
{
- st_sprintf (message,
+ sprintf (message,
"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);
c = eat_spaces (dtp);
if (is_separator (c))
- { /* Found a null value. */
+ {
+ /* Found a null value. */
eat_separator (dtp);
dtp->u.p.repeat_count = 0;
- /* eat_separator sets this flag if the separator was a comma */
+ /* eat_separator sets this flag if the separator was a comma. */
if (dtp->u.p.comma_flag)
goto cleanup;
- /* eat_separator sets this flag if the separator was a \n or \r */
+ /* eat_separator sets this flag if the separator was a \n or \r. */
if (dtp->u.p.at_eol)
finish_separator (dtp);
else
else
{
eat_spaces (dtp);
- /* trailing spaces prior to end of line */
+ /* Trailing spaces prior to end of line. */
if (dtp->u.p.at_eol)
finish_separator (dtp);
}
if ((c==',' && dim == rank -1)
|| (c==')' && dim < rank -1))
{
- st_sprintf (parse_err_msg,
- "Bad number of index fields");
+ sprintf (parse_err_msg,
+ "Bad number of index fields");
goto err_ret;
}
break;
break;
default:
- st_sprintf (parse_err_msg, "Bad character in index");
+ sprintf (parse_err_msg, "Bad character in index");
goto err_ret;
}
if ((c == ',' || c == ')') && indx == 0
&& dtp->u.p.saved_string == 0)
{
- st_sprintf (parse_err_msg, "Null index field");
+ sprintf (parse_err_msg, "Null index field");
goto err_ret;
}
if ((c == ':' && indx == 1 && dtp->u.p.saved_string == 0)
|| (indx == 2 && dtp->u.p.saved_string == 0))
{
- st_sprintf(parse_err_msg, "Bad index triplet");
+ sprintf(parse_err_msg, "Bad index triplet");
goto err_ret;
}
/* Now read the index. */
if (convert_integer (dtp, sizeof(ssize_t), neg))
{
- st_sprintf (parse_err_msg, "Bad integer in index");
+ sprintf (parse_err_msg, "Bad integer in index");
goto err_ret;
}
break;
|| (ls[dim].end > (ssize_t)ad[dim].ubound)
|| (ls[dim].end < (ssize_t)ad[dim].lbound))
{
- st_sprintf (parse_err_msg, "Index %d out of range", dim + 1);
+ sprintf (parse_err_msg, "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))
{
- st_sprintf (parse_err_msg, "Bad range in index %d", dim + 1);
+ sprintf (parse_err_msg, "Bad range in index %d", dim + 1);
goto err_ret;
}
index_type len = strlen (nl->var_name) + 1;
int dim;
char * ext_name = (char*)get_mem (len + 1);
- strcpy (ext_name, nl->var_name);
- strcat (ext_name, "%");
+ memcpy (ext_name, nl->var_name, len-1);
+ memcpy (ext_name + len - 1, "%", 2);
for (nl = nl->next; nl; nl = nl->next)
{
if (strncmp (nl->var_name, ext_name, len) == 0)
index_type dlen;
index_type m;
index_type obj_name_len;
- void * pdata ;
+ void * pdata;
/* This object not touched in name parsing. */
case GFC_DTYPE_DERIVED:
obj_name_len = strlen (nl->var_name) + 1;
obj_name = get_mem (obj_name_len+1);
- strcpy (obj_name, nl->var_name);
- strcat (obj_name, "%");
+ memcpy (obj_name, nl->var_name, obj_name_len-1);
+ memcpy (obj_name + obj_name_len - 1, "%", 2);
/* If reading a derived type, disable the expanded read warning
since a single object can have multiple reads. */
goto incr_idx;
default:
- st_sprintf (nml_err_msg, "Bad type for namelist object %s",
+ sprintf (nml_err_msg, "Bad type for namelist object %s",
nl->var_name);
internal_error (&dtp->common, nml_err_msg);
goto nml_err_ret;
if (dtp->u.p.repeat_count > 1)
{
- st_sprintf (nml_err_msg, "Repeat count too large for namelist object %s" ,
+ sprintf (nml_err_msg, "Repeat count too large for namelist object %s" ,
nl->var_name );
goto nml_err_ret;
}
c = next_char (dtp);
if (c != '?')
{
- st_sprintf (nml_err_msg, "namelist read: misplaced = sign");
+ sprintf (nml_err_msg, "namelist read: misplaced = sign");
goto nml_err_ret;
}
nml_query (dtp, '=');
nml_match_name (dtp, "end", 3);
if (dtp->u.p.nml_read_error)
{
- st_sprintf (nml_err_msg, "namelist not terminated with / or &end");
+ sprintf (nml_err_msg, "namelist not terminated with / or &end");
goto nml_err_ret;
}
case '/':
if (nl == NULL)
{
if (dtp->u.p.nml_read_error && *pprev_nl)
- st_sprintf (nml_err_msg, "Bad data for namelist object %s",
+ sprintf (nml_err_msg, "Bad data for namelist object %s",
(*pprev_nl)->var_name);
else
- st_sprintf (nml_err_msg, "Cannot match namelist object name %s",
+ sprintf (nml_err_msg, "Cannot match namelist object name %s",
dtp->u.p.saved_string);
goto nml_err_ret;
if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
parse_err_msg) == FAILURE)
{
- st_sprintf (nml_err_msg, "%s for namelist variable %s",
+ sprintf (nml_err_msg, "%s for namelist variable %s",
parse_err_msg, nl->var_name);
goto nml_err_ret;
}
if (nl->type != GFC_DTYPE_DERIVED)
{
- st_sprintf (nml_err_msg, "Attempt to get derived component for %s",
+ sprintf (nml_err_msg, "Attempt to get derived component for %s",
nl->var_name);
goto nml_err_ret;
}
if (nml_parse_qualifier (dtp, chd, ind, 1, parse_err_msg) == FAILURE)
{
- st_sprintf (nml_err_msg, "%s for namelist variable %s",
+ sprintf (nml_err_msg, "%s for namelist variable %s",
parse_err_msg, nl->var_name);
goto nml_err_ret;
}
if (ind[0].step != 1)
{
- st_sprintf (nml_err_msg,
+ sprintf (nml_err_msg,
"Bad step in substring for namelist object %s",
nl->var_name);
goto nml_err_ret;
if (c == '(')
{
- st_sprintf (nml_err_msg, "Qualifier for a scalar or non-character"
+ sprintf (nml_err_msg, "Qualifier for a scalar or non-character"
" namelist object %s", nl->var_name);
goto nml_err_ret;
}
if (c != '=')
{
- st_sprintf (nml_err_msg, "Equal sign must follow namelist object name %s",
+ sprintf (nml_err_msg, "Equal sign must follow namelist object name %s",
nl->var_name);
goto nml_err_ret;
}
case '&':
break;
+ case '!':
+ eat_line (dtp);
+ goto find_nml_name;
+
case '=':
c = next_char (dtp);
if (c == '?')
OSDN Git Service
