/* Inputs a rank-dimensional qualifier, which can contain
singlets, doublets, triplets or ':' with the standard meanings. */
-static try
+static bool
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,
/* The next character in the stream should be the '('. */
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ return false;
/* Process the qualifier, by dimension and triplet. */
/* Process a potential sign. */
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ return false;
switch (c)
{
case '-':
for (;;)
{
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ return false;
switch (c)
{
case ' ': case '\t':
eat_spaces (dtp);
if ((c = next_char (dtp) == EOF))
- return FAILURE;
+ return false;
break;
default:
ls[dim].idx = ls[dim].start;
}
eat_spaces (dtp);
- return SUCCESS;
+ return true;
err_ret:
- return FAILURE;
+ return false;
}
static namelist_info *
little data to be available. On the other hand, too much data is an
error. */
-static try
+static bool
nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
namelist_info **pprev_nl, char *nml_err_msg,
size_t nml_err_msg_size, index_type clow, index_type chigh)
/* This object not touched in name parsing. */
if (!nl->touched)
- return SUCCESS;
+ return true;
dtp->u.p.repeat_count = 0;
eat_spaces (dtp);
if (--dtp->u.p.repeat_count <= 0)
{
if (dtp->u.p.input_complete)
- return SUCCESS;
+ return true;
if (dtp->u.p.at_eol)
finish_separator (dtp);
if (dtp->u.p.input_complete)
- return SUCCESS;
+ return true;
dtp->u.p.saved_type = BT_UNKNOWN;
free_saved (dtp);
cmp = cmp->next)
{
- if (nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos),
+ if (!nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos),
pprev_nl, nml_err_msg, nml_err_msg_size,
- clow, chigh) == FAILURE)
+ clow, chigh))
{
free (obj_name);
- return FAILURE;
+ return false;
}
if (dtp->u.p.input_complete)
{
free (obj_name);
- return SUCCESS;
+ return true;
}
}
if (dtp->u.p.nml_read_error)
{
dtp->u.p.expanded_read = 0;
- return SUCCESS;
+ return true;
}
if (dtp->u.p.saved_type == BT_UNKNOWN)
"Repeat count too large for namelist object %s", nl->var_name);
goto nml_err_ret;
}
- return SUCCESS;
+ return true;
nml_err_ret:
- return FAILURE;
+ return false;
}
/* Parses the object name, including array and substring qualifiers. It
touched. nml_read_obj is called at the end and this reads the data in
the manner specified by the object name. */
-static try
+static bool
nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
char *nml_err_msg, size_t nml_err_msg_size)
{
eat_separator (dtp);
if (dtp->u.p.input_complete)
- return SUCCESS;
+ return true;
if (dtp->u.p.at_eol)
finish_separator (dtp);
if (dtp->u.p.input_complete)
- return SUCCESS;
+ return true;
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ return false;
switch (c)
{
case '=':
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ return false;
if (c != '?')
{
snprintf (nml_err_msg, nml_err_msg_size,
goto nml_err_ret;
}
nml_query (dtp, '=');
- return SUCCESS;
+ return true;
case '?':
nml_query (dtp, '?');
- return SUCCESS;
+ return true;
case '$':
case '&':
}
case '/':
dtp->u.p.input_complete = 1;
- return SUCCESS;
+ return true;
default :
break;
if (!is_separator (c))
push_char (dtp, tolower(c));
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ return false;
} while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' ));
unget_char (dtp, c);
if (c == '(' && nl->var_rank)
{
parsed_rank = 0;
- if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
+ if (!nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
nml_err_msg, nml_err_msg_size,
- &parsed_rank) == FAILURE)
+ &parsed_rank))
{
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;
+ return false;
unget_char (dtp, c);
}
else if (nl->var_rank > 0)
component_flag = 1;
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ return false;
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,
- nml_err_msg_size, &parsed_rank)
- == FAILURE)
+ if (!nml_parse_qualifier (dtp, chd, ind, -1, nml_err_msg,
+ nml_err_msg_size, &parsed_rank))
{
char *nml_err_msg_end = strchr (nml_err_msg, '\0');
snprintf (nml_err_msg_end,
}
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ return false;
unget_char (dtp, c);
}
eat_separator (dtp);
if (dtp->u.p.input_complete)
- return SUCCESS;
+ return true;
if (dtp->u.p.at_eol)
finish_separator (dtp);
if (dtp->u.p.input_complete)
- return SUCCESS;
+ return true;
if ((c = next_char (dtp)) == EOF)
- return FAILURE;
+ return false;
if (c != '=')
{
nl = first_nl;
}
- if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size,
- clow, chigh) == FAILURE)
+ if (!nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size,
+ clow, chigh))
goto nml_err_ret;
- return SUCCESS;
+ return true;
nml_err_ret:
- return FAILURE;
+ return false;
}
/* Entry point for namelist input. Goes through input until namelist name
while (!dtp->u.p.input_complete)
{
- if (nml_get_obj_data (dtp, &prev_nl, nml_err_msg, sizeof nml_err_msg)
- == FAILURE)
+ if (!nml_get_obj_data (dtp, &prev_nl, nml_err_msg, sizeof nml_err_msg))
{
if (dtp->u.p.current_unit->unit_number != options.stdin_unit)
goto nml_err_ret;
/* Function for reading the next couple of bytes from the current
- file, advancing the current position. We return FAILURE on end of record or
+ file, advancing the current position. We return NULL on end of record or
end of file. This function is only for formatted I/O, unformatted uses
read_block_direct.
called for unformatted files. There are three cases to consider:
Stream I/O, unformatted direct, unformatted sequential. */
-static try
+static bool
write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
{
if (unlikely (have_written < 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
- return FAILURE;
+ return false;
}
dtp->u.p.current_unit->strm_pos += (gfc_offset) have_written;
- return SUCCESS;
+ return true;
}
/* Unformatted direct access. */
if (unlikely (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes))
{
generate_error (&dtp->common, LIBERROR_DIRECT_EOR, NULL);
- return FAILURE;
+ return false;
}
if (buf == NULL && nbytes == 0)
- return SUCCESS;
+ return true;
have_written = swrite (dtp->u.p.current_unit->s, buf, nbytes);
if (unlikely (have_written < 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
- return FAILURE;
+ return false;
}
dtp->u.p.current_unit->strm_pos += (gfc_offset) have_written;
dtp->u.p.current_unit->bytes_left -= (gfc_offset) have_written;
- return SUCCESS;
+ return true;
}
/* Unformatted sequential. */
if (unlikely (to_write_subrecord < 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
- return FAILURE;
+ return false;
}
dtp->u.p.current_unit->strm_pos += (gfc_offset) to_write_subrecord;
if (unlikely (short_record))
{
generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL);
- return FAILURE;
+ return false;
}
- return SUCCESS;
+ return true;
}
/* Output a real number according to its format which is FMT_G free. */
-static try
+static bool
output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
int nprinted, int precision, int sign_bit, bool zero_flag)
{
{
generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not "
"greater than zero in format specifier 'E' or 'D'");
- return FAILURE;
+ return false;
}
if (p <= -d || p >= d + 2)
{
generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor "
"out of range in format specifier 'E' or 'D'");
- return FAILURE;
+ return false;
}
if (!zero_flag)
/* Create the ouput buffer. */
out = write_block (dtp, w);
if (out == NULL)
- return FAILURE;
+ return false;
/* Check the value fits in the specified field width. */
if (nblanks < 0 || edigits == -1 || w == 1 || (w == 2 && sign != S_NONE))
{
gfc_char4_t *out4 = (gfc_char4_t *) out;
memset4 (out4, '*', w);
- return FAILURE;
+ return false;
}
star_fill (out, w);
- return FAILURE;
+ return false;
}
/* See if we have space for a zero before the decimal point. */
memset4 (out4, ' ' , nblanks);
dtp->u.p.no_leading_blank = 0;
}
- return SUCCESS;
+ return true;
} /* End of character(kind=4) internal unit code. */
/* Pad to full field width. */
dtp->u.p.no_leading_blank = 0;
}
- return SUCCESS;
+ return true;
}
int ubound, lbound;\
char *p, pad = ' ';\
int save_scale_factor, nb = 0;\
- try result;\
+ bool result;\
int nprinted, precision;\
\
save_scale_factor = dtp->u.p.scale_factor;\
p = write_block (dtp, nb);\
if (p == NULL)\
return;\
- if (result == FAILURE)\
+ if (!result)\
pad = '*';\
if (unlikely (is_char4_unit (dtp)))\
{\