From 66757c26c988c4de071dc4aac9e52dc67afd8087 Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Tue, 4 Mar 2014 04:33:40 +0000 Subject: [PATCH] 2014-03-03 Jerry DeLisle PR libfortran/60148 * io/inquire.c (inquire_via_unit): In the case of DELIM_UNSPECIFIED set inquire return string to "NONE". * io/list_read.c (read_character): In the case of DELIM_NONE and namelists, complete the character read using the namelist variable length. * io/open.c (new_unit): Don't set delim status to none if not specified so that DELIM_UNSPECIFIED can be used later. * io/transfer.c (data_transfer_init): For namelist I/O, if the unit delim status is unspecified set the current status to quote. Otherwise, set current status to the unit status. * io/unit.c (get_internel_unit, init_unit): Remember to set flags_delim initially to DELIM_UNSPECIFIED so defaults come out correctly. * io/write.c (write_character): Add a new function argument "mode" to signify that raw output is to be used vs output with delimiters. If the mode is set to DELIM (1) proceed with delimiters. (list_formatted_write_scalar): Write the separator only if a delimiter was previously specified. Update the call to write_character with the mode argument given. (namelist_write_newline): Use the mode argument. (nml_write_obj): Use the mode argument. Remove use of tmp_delim. Write the semi-colon or comma correctly only when needed with using delimiters. Cleanup whitespace. (namelist_write): If delim is not specified in namelist I/O, default to using quotes. Get rid of the tmp_delim variable and use the new mode argument in write_character. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@208302 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgfortran/ChangeLog | 30 +++++++++++ libgfortran/io/inquire.c | 1 + libgfortran/io/list_read.c | 16 +++++- libgfortran/io/open.c | 16 +++--- libgfortran/io/transfer.c | 11 +++-- libgfortran/io/unit.c | 2 + libgfortran/io/write.c | 121 +++++++++++++++++++++++++-------------------- 7 files changed, 129 insertions(+), 68 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index e39607e..0cf04d2 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,33 @@ +2014-03-03 Jerry DeLisle + + PR libfortran/60148 + * io/inquire.c (inquire_via_unit): In the case of + DELIM_UNSPECIFIED set inquire return string to "NONE". + * io/list_read.c (read_character): In the case of DELIM_NONE and + namelists, complete the character read using the namelist + variable length. + * io/open.c (new_unit): Don't set delim status to none if not + specified so that DELIM_UNSPECIFIED can be used later. + * io/transfer.c (data_transfer_init): For namelist I/O, if the + unit delim status is unspecified set the current status to quote. + Otherwise, set current status to the unit status. + * io/unit.c (get_internel_unit, init_unit): Remember to set + flags_delim initially to DELIM_UNSPECIFIED so defaults come out + correctly. + * io/write.c (write_character): Add a new function argument + "mode" to signify that raw output is to be used vs output with + delimiters. If the mode is set to DELIM (1) proceed with + delimiters. (list_formatted_write_scalar): Write the separator + only if a delimiter was previously specified. Update the call to + write_character with the mode argument given. + (namelist_write_newline): Use the mode argument. (nml_write_obj): + Use the mode argument. Remove use of tmp_delim. Write the + semi-colon or comma correctly only when needed with using + delimiters. Cleanup whitespace. + (namelist_write): If delim is not specified in namelist I/O, + default to using quotes. Get rid of the tmp_delim variable and + use the new mode argument in write_character. + 2014-02-21 Tobias Burnus PR fortran/60286 diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index 6801d01..c41237c 100644 --- a/libgfortran/io/inquire.c +++ b/libgfortran/io/inquire.c @@ -523,6 +523,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) switch (u->flags.delim) { case DELIM_NONE: + case DELIM_UNSPECIFIED: p = "NONE"; break; case DELIM_QUOTE: diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 942f311..d1d09b5 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -971,10 +971,24 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) default: if (dtp->u.p.namelist_mode) { + if (dtp->u.p.current_unit->delim_status == DELIM_NONE) + { + /* No delimiters so finish reading the string now. */ + int i; + push_char (dtp, c); + for (i = dtp->u.p.ionml->string_length; i > 1; i--) + { + if ((c = next_char (dtp)) == EOF) + goto done_eof; + push_char (dtp, c); + } + dtp->u.p.saved_type = BT_CHARACTER; + free_line (dtp); + return; + } unget_char (dtp, c); return; } - push_char (dtp, c); goto get_string; } diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 02c3f5a..06fd594 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -332,17 +332,13 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) /* Checks. */ - if (flags->delim == DELIM_UNSPECIFIED) - flags->delim = DELIM_NONE; - else + if (flags->delim != DELIM_UNSPECIFIED + && flags->form == FORM_UNFORMATTED) { - if (flags->form == FORM_UNFORMATTED) - { - generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, - "DELIM parameter conflicts with UNFORMATTED form in " - "OPEN statement"); - goto fail; - } + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "DELIM parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; } if (flags->blank == BLANK_UNSPECIFIED) diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 87415d5..cadbcab 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -2670,16 +2670,21 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) = !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED : find_option (&dtp->common, dtp->delim, dtp->delim_len, delim_opt, "Bad DELIM parameter in data transfer statement"); - + if (dtp->u.p.current_unit->delim_status == DELIM_UNSPECIFIED) - dtp->u.p.current_unit->delim_status = dtp->u.p.current_unit->flags.delim; + { + if (ionml && dtp->u.p.current_unit->flags.delim == DELIM_UNSPECIFIED) + dtp->u.p.current_unit->delim_status = DELIM_QUOTE; + else + dtp->u.p.current_unit->delim_status = dtp->u.p.current_unit->flags.delim; + } /* Check the pad mode. */ dtp->u.p.current_unit->pad_status = !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED : find_option (&dtp->common, dtp->pad, dtp->pad_len, pad_opt, "Bad PAD parameter in data transfer statement"); - + if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED) dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad; diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index f9b594d..901d66f 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -464,6 +464,7 @@ get_internal_unit (st_parameter_dt *dtp) iunit->flags.status = STATUS_UNSPECIFIED; iunit->flags.sign = SIGN_SUPPRESS; iunit->flags.decimal = DECIMAL_POINT; + iunit->flags.delim = DELIM_UNSPECIFIED; iunit->flags.encoding = ENCODING_DEFAULT; iunit->flags.async = ASYNC_NO; iunit->flags.round = ROUND_UNSPECIFIED; @@ -584,6 +585,7 @@ init_units (void) u->flags.position = POSITION_ASIS; u->flags.sign = SIGN_SUPPRESS; u->flags.decimal = DECIMAL_POINT; + u->flags.delim = DELIM_UNSPECIFIED; u->flags.encoding = ENCODING_DEFAULT; u->flags.async = ASYNC_NO; u->flags.round = ROUND_UNSPECIFIED; diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 61b5691..eccbe7e 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1312,24 +1312,32 @@ write_integer (st_parameter_dt *dtp, const char *source, int length) /* Write a list-directed string. We have to worry about delimiting the strings if the file has been opened in that mode. */ +#define DELIM 1 +#define NODELIM 0 + static void -write_character (st_parameter_dt *dtp, const char *source, int kind, int length) +write_character (st_parameter_dt *dtp, const char *source, int kind, int length, int mode) { int i, extra; char *p, d; - switch (dtp->u.p.current_unit->delim_status) + if (mode == DELIM) { - case DELIM_APOSTROPHE: - d = '\''; - break; - case DELIM_QUOTE: - d = '"'; - break; - default: - d = ' '; - break; + switch (dtp->u.p.current_unit->delim_status) + { + case DELIM_APOSTROPHE: + d = '\''; + break; + case DELIM_QUOTE: + d = '"'; + break; + default: + d = ' '; + break; + } } + else + d = ' '; if (kind == 1) { @@ -1551,7 +1559,8 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, else { if (type != BT_CHARACTER || !dtp->u.p.char_flag || - dtp->u.p.current_unit->delim_status != DELIM_NONE) + (dtp->u.p.current_unit->delim_status != DELIM_NONE + && dtp->u.p.current_unit->delim_status != DELIM_UNSPECIFIED)) write_separator (dtp); } @@ -1564,7 +1573,7 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, write_logical (dtp, p, kind); break; case BT_CHARACTER: - write_character (dtp, p, kind, size); + write_character (dtp, p, kind, size, DELIM); break; case BT_REAL: write_real (dtp, p, kind); @@ -1628,9 +1637,9 @@ namelist_write_newline (st_parameter_dt *dtp) if (!is_internal_unit (dtp)) { #ifdef HAVE_CRLF - write_character (dtp, "\r\n", 1, 2); + write_character (dtp, "\r\n", 1, 2, NODELIM); #else - write_character (dtp, "\n", 1, 1); + write_character (dtp, "\n", 1, 1, NODELIM); #endif return; } @@ -1675,7 +1684,7 @@ namelist_write_newline (st_parameter_dt *dtp) } } else - write_character (dtp, " ", 1, 1); + write_character (dtp, " ", 1, 1, NODELIM); } @@ -1704,7 +1713,6 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, size_t base_name_len; size_t base_var_name_len; size_t tot_len; - unit_delim tmp_delim; /* Set the character to be used to separate values to a comma or semi-colon. */ @@ -1718,7 +1726,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, if (obj->type != BT_DERIVED) { namelist_write_newline (dtp); - write_character (dtp, " ", 1, 1); + write_character (dtp, " ", 1, 1, NODELIM); len = 0; if (base) @@ -1728,16 +1736,16 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, for (dim_i = 0; dim_i < base_name_len; dim_i++) { cup = toupper ((int) base_name[dim_i]); - write_character (dtp, &cup, 1, 1); + write_character (dtp, &cup, 1, 1, NODELIM); } } clen = strlen (obj->var_name); for (dim_i = len; dim_i < clen; dim_i++) { cup = toupper ((int) obj->var_name[dim_i]); - write_character (dtp, &cup, 1, 1); + write_character (dtp, &cup, 1, 1, NODELIM); } - write_character (dtp, "=", 1, 1); + write_character (dtp, "=", 1, 1, NODELIM); } /* Counts the number of data output on a line, including names. */ @@ -1807,7 +1815,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, if (rep_ctr > 1) { snprintf(rep_buff, NML_DIGITS, " %d*", rep_ctr); - write_character (dtp, rep_buff, 1, strlen (rep_buff)); + write_character (dtp, rep_buff, 1, strlen (rep_buff), NODELIM); dtp->u.p.no_leading_blank = 1; } num++; @@ -1827,13 +1835,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, break; case BT_CHARACTER: - tmp_delim = dtp->u.p.current_unit->delim_status; - if (dtp->u.p.nml_delim == '"') - dtp->u.p.current_unit->delim_status = DELIM_QUOTE; - if (dtp->u.p.nml_delim == '\'') - dtp->u.p.current_unit->delim_status = DELIM_APOSTROPHE; - write_character (dtp, p, 1, obj->string_length); - dtp->u.p.current_unit->delim_status = tmp_delim; + write_character (dtp, p, 1, obj->string_length, DELIM); break; case BT_REAL: @@ -1921,12 +1923,20 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, to column 2. Reset the repeat counter. */ dtp->u.p.no_leading_blank = 0; - write_character (dtp, &semi_comma, 1, 1); + if (obj->type == BT_CHARACTER) + { + if (dtp->u.p.nml_delim != '\0') + write_character (dtp, &semi_comma, 1, 1, NODELIM); + } + else + write_character (dtp, &semi_comma, 1, 1, NODELIM); if (num > 5) { num = 0; + if (dtp->u.p.nml_delim == '\0') + write_character (dtp, &semi_comma, 1, 1, NODELIM); namelist_write_newline (dtp); - write_character (dtp, " ", 1, 1); + write_character (dtp, " ", 1, 1, NODELIM); } rep_ctr = 1; } @@ -1935,17 +1945,17 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, obj_loop: - nml_carry = 1; - for (dim_i = 0; nml_carry && (dim_i < (size_t) obj->var_rank); dim_i++) - { - obj->ls[dim_i].idx += nml_carry ; - nml_carry = 0; - if (obj->ls[dim_i].idx > GFC_DESCRIPTOR_UBOUND(obj,dim_i)) - { - obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i); - nml_carry = 1; - } - } + nml_carry = 1; + for (dim_i = 0; nml_carry && (dim_i < (size_t) obj->var_rank); dim_i++) + { + obj->ls[dim_i].idx += nml_carry ; + nml_carry = 0; + if (obj->ls[dim_i].idx > GFC_DESCRIPTOR_UBOUND(obj,dim_i)) + { + obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i); + nml_carry = 1; + } + } } /* Return a pointer beyond the furthest object accessed. */ @@ -1967,23 +1977,28 @@ namelist_write (st_parameter_dt *dtp) index_type dummy_offset = 0; char c; char * dummy_name = NULL; - unit_delim tmp_delim = DELIM_UNSPECIFIED; /* Set the delimiter for namelist output. */ - tmp_delim = dtp->u.p.current_unit->delim_status; - - dtp->u.p.nml_delim = tmp_delim == DELIM_APOSTROPHE ? '\'' : '"'; - - /* Temporarily disable namelist delimters. */ - dtp->u.p.current_unit->delim_status = DELIM_NONE; + switch (dtp->u.p.current_unit->delim_status) + { + case DELIM_APOSTROPHE: + dtp->u.p.nml_delim = '\''; + break; + case DELIM_QUOTE: + case DELIM_UNSPECIFIED: + dtp->u.p.nml_delim = '"'; + break; + default: + dtp->u.p.nml_delim = '\0'; + } - write_character (dtp, "&", 1, 1); + write_character (dtp, "&", 1, 1, NODELIM); /* Write namelist name in upper case - f95 std. */ for (i = 0 ;i < dtp->namelist_name_len ;i++ ) { c = toupper ((int) dtp->namelist_name[i]); - write_character (dtp, &c, 1 ,1); + write_character (dtp, &c, 1 ,1, NODELIM); } if (dtp->u.p.ionml != NULL) @@ -1997,9 +2012,7 @@ namelist_write (st_parameter_dt *dtp) } namelist_write_newline (dtp); - write_character (dtp, " /", 1, 2); - /* Restore the original delimiter. */ - dtp->u.p.current_unit->delim_status = tmp_delim; + write_character (dtp, " /", 1, 2, NODELIM); } #undef NML_DIGITS -- 2.7.4