diff options
Diffstat (limited to 'libgfortran/io')
| -rw-r--r-- | libgfortran/io/format.c | 1 | ||||
| -rw-r--r-- | libgfortran/io/list_read.c | 102 | ||||
| -rw-r--r-- | libgfortran/io/open.c | 14 | ||||
| -rw-r--r-- | libgfortran/io/transfer.c | 22 | ||||
| -rw-r--r-- | libgfortran/io/write.c | 1 | ||||
| -rw-r--r-- | libgfortran/io/write_float.def | 20 |
6 files changed, 80 insertions, 80 deletions
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c index ff3c6804699..c64596baf52 100644 --- a/libgfortran/io/format.c +++ b/libgfortran/io/format.c @@ -31,7 +31,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "format.h" #include <ctype.h> #include <string.h> -#include <stdbool.h> #include <stdlib.h> diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index fb8a841b229..e7ae98fcf28 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -1433,7 +1433,6 @@ read_real (st_parameter_dt *dtp, void * dest, int length) goto got_sign; CASE_SEPARATORS: - case EOF: unget_char (dtp, c); /* Single null. */ eat_separator (dtp); return; @@ -2052,7 +2051,7 @@ calls: /* 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, @@ -2079,7 +2078,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, /* 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. */ @@ -2093,7 +2092,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, /* Process a potential sign. */ if ((c = next_char (dtp)) == EOF) - return FAILURE; + return false; switch (c) { case '-': @@ -2112,7 +2111,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, for (;;) { if ((c = next_char (dtp)) == EOF) - return FAILURE; + return false; switch (c) { @@ -2141,7 +2140,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, case ' ': case '\t': eat_spaces (dtp); if ((c = next_char (dtp) == EOF)) - return FAILURE; + return false; break; default: @@ -2279,11 +2278,11 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, ls[dim].idx = ls[dim].start; } eat_spaces (dtp); - return SUCCESS; + return true; err_ret: - return FAILURE; + return false; } static namelist_info * @@ -2467,7 +2466,7 @@ query_return: 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) @@ -2485,7 +2484,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, /* This object not touched in name parsing. */ if (!nl->touched) - return SUCCESS; + return true; dtp->u.p.repeat_count = 0; eat_spaces (dtp); @@ -2532,11 +2531,11 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, 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); @@ -2578,30 +2577,30 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, 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), + 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; } } @@ -2625,7 +2624,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, 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) @@ -2711,11 +2710,11 @@ incr_idx: "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 @@ -2725,7 +2724,7 @@ nml_err_ret: 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) { @@ -2743,20 +2742,20 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, 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, @@ -2764,11 +2763,11 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, goto nml_err_ret; } nml_query (dtp, '='); - return SUCCESS; + return true; case '?': nml_query (dtp, '?'); - return SUCCESS; + return true; case '$': case '&': @@ -2781,7 +2780,7 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, } case '/': dtp->u.p.input_complete = 1; - return SUCCESS; + return true; default : break; @@ -2806,7 +2805,7 @@ get_name: 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); @@ -2866,9 +2865,9 @@ get_name: 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, @@ -2882,7 +2881,7 @@ get_name: qualifier_flag = 1; if ((c = next_char (dtp)) == EOF) - return FAILURE; + return false; unget_char (dtp, c); } else if (nl->var_rank > 0) @@ -2901,14 +2900,15 @@ get_name: 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; + return false; goto get_name; } @@ -2923,9 +2923,8 @@ 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, @@ -2946,7 +2945,7 @@ get_name: } if ((c = next_char (dtp)) == EOF) - return FAILURE; + return false; unget_char (dtp, c); } @@ -2978,15 +2977,15 @@ get_name: 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 != '=') { @@ -3013,15 +3012,15 @@ get_name: 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 @@ -3104,8 +3103,7 @@ find_nml_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; diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index d9cfde853f5..19fab1d683f 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -818,10 +818,6 @@ st_open (st_parameter_open *opp) flags.convert = conv; - if (!(opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT) && opp->common.unit < 0) - generate_error (&opp->common, LIBERROR_BAD_OPTION, - "Bad unit number in OPEN statement"); - if (flags.position != POSITION_UNSPECIFIED && flags.access == ACCESS_DIRECT) generate_error (&opp->common, LIBERROR_BAD_OPTION, @@ -848,8 +844,16 @@ st_open (st_parameter_open *opp) { if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT)) opp->common.unit = get_unique_unit_number(opp); + else if (opp->common.unit < 0) + { + u = find_unit (opp->common.unit); + if (u == NULL) /* Negative unit and no NEWUNIT-created unit found. */ + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Bad unit number in OPEN statement"); + } - u = find_or_create_unit (opp->common.unit); + if (u == NULL) + u = find_or_create_unit (opp->common.unit); if (u->s == NULL) { u = new_unit (opp, u, &flags); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index d97a325a772..6fa954ce287 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -401,7 +401,7 @@ read_sf (st_parameter_dt *dtp, int * length) /* 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. @@ -774,7 +774,7 @@ write_block (st_parameter_dt *dtp, int length) 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) { @@ -790,12 +790,12 @@ 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. */ @@ -805,23 +805,23 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) 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. */ @@ -854,7 +854,7 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) 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; @@ -871,9 +871,9 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) if (unlikely (short_record)) { generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); - return FAILURE; + return false; } - return SUCCESS; + return true; } diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index f17528edc56..153da2e2038 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -31,7 +31,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include <ctype.h> #include <stdlib.h> -#include <stdbool.h> #include <errno.h> #define star_fill(p, n) memset(p, '*', n) diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index 5b76fd59650..a157f0b6328 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -110,7 +110,7 @@ determine_precision (st_parameter_dt * dtp, const fnode * f, int len) /* 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) { @@ -244,13 +244,13 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, { 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) @@ -532,7 +532,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, /* 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)) @@ -541,10 +541,10 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, { 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. */ @@ -652,7 +652,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, 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. */ @@ -745,7 +745,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, dtp->u.p.no_leading_blank = 0; } - return SUCCESS; + return true; } @@ -995,7 +995,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \ 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;\ @@ -1087,7 +1087,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \ p = write_block (dtp, nb);\ if (p == NULL)\ return;\ - if (result == FAILURE)\ + if (!result)\ pad = '*';\ if (unlikely (is_char4_unit (dtp)))\ {\ |