diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 18 | ||||
| -rw-r--r-- | libgfortran/io/io.h | 9 | ||||
| -rw-r--r-- | libgfortran/io/list_read.c | 18 | ||||
| -rw-r--r-- | libgfortran/io/transfer.c | 50 |
4 files changed, 74 insertions, 21 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 96b75e9292a..12e3f1fa696 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,21 @@ +2017-03-25 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libgfortran/78881 + * io/io.h (st_parameter_dt): Rename unused component last_char to + child_saved_iostat. Move comment to gfc_unit. + * io/list_read.c (list_formatted_read_scalar): After call to + child READ procedure, save the returned iostat value for later + check. (finish_list_read): Only finish READ if child_saved_iostat + was OK. + * io/transfer.c (read_sf_internal): If there is a saved character + in last character, seek back one. Add a new check for EOR + condition. (read_sf): If there is a saved character + in last character, seek back one. (formatted_transfer_scalar_read): + Initialize last character before invoking child procedure. + (data_transfer_init): If child dtio, set advance + status to nonadvancing. Move update of size and check for EOR + condition to before child dtio return. + 2017-03-17 Thomas Koenig <tkoenig@gcc.gnu.org> PR libfortran/79956 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 277c5ed7806..df491577349 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -534,10 +534,7 @@ typedef struct st_parameter_dt unsigned expanded_read : 1; /* 13 unused bits. */ - /* Used for ungetc() style functionality. Possible values - are an unsigned char, EOF, or EOF - 1 used to mark the - field as not valid. */ - int last_char; /* No longer used, moved to gfc_unit. */ + int child_saved_iostat; int nml_delim; int repeat_count; int saved_length; @@ -701,6 +698,10 @@ typedef struct gfc_unit /* DTIO Parent/Child procedure, 0 = parent, >0 = child level. */ int child_dtio; + + /* Used for ungetc() style functionality. Possible values + are an unsigned char, EOF, or EOF - 1 used to mark the + field as not valid. */ int last_char; bool has_size; GFC_IO_INT size_used; diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 7f57ff1a916..39805baaeab 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2221,6 +2221,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, dtp->u.p.fdtio_ptr (p, &unit, iotype, &vlist, child_iostat, child_iomsg, iotype_len, child_iomsg_len); + dtp->u.p.child_saved_iostat = *child_iostat; dtp->u.p.current_unit->child_dtio--; } break; @@ -2352,15 +2353,18 @@ finish_list_read (st_parameter_dt *dtp) /* Set the next_char and push_char worker functions. */ set_workers (dtp); - c = next_char (dtp); - if (c == EOF) + if (likely (dtp->u.p.child_saved_iostat == LIBERROR_OK)) { - free_line (dtp); - hit_eof (dtp); - return; + c = next_char (dtp); + if (c == EOF) + { + free_line (dtp); + hit_eof (dtp); + return; + } + if (c != '\n') + eat_line (dtp); } - if (c != '\n') - eat_line (dtp); } free_line (dtp); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index fc22d802196..1e56b5de136 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -226,7 +226,7 @@ static char * read_sf_internal (st_parameter_dt *dtp, int * length) { static char *empty_string[0]; - char *base; + char *base = NULL; int lorig; /* Zero size array gives internal unit len of 0. Nothing to read. */ @@ -244,6 +244,15 @@ read_sf_internal (st_parameter_dt *dtp, int * length) return (char*) empty_string; } + /* There are some cases with mixed DTIO where we have read a character + and saved it in the last character buffer, so we need to backup. */ + if (unlikely (dtp->u.p.current_unit->child_dtio > 0 && + dtp->u.p.current_unit->last_char != EOF - 1)) + { + dtp->u.p.current_unit->last_char = EOF - 1; + sseek (dtp->u.p.current_unit->s, -1, SEEK_CUR); + } + lorig = *length; if (is_char4_unit(dtp)) { @@ -263,6 +272,12 @@ read_sf_internal (st_parameter_dt *dtp, int * length) return NULL; } + if (base && *base == 0) + { + generate_error (&dtp->common, LIBERROR_EOR, NULL); + return NULL; + } + dtp->u.p.current_unit->bytes_left -= *length; if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || @@ -304,6 +319,15 @@ read_sf (st_parameter_dt *dtp, int * length) return (char*) empty_string; } + /* There are some cases with mixed DTIO where we have read a character + and saved it in the last character buffer, so we need to backup. */ + if (unlikely (dtp->u.p.current_unit->child_dtio > 0 && + dtp->u.p.current_unit->last_char != EOF - 1)) + { + dtp->u.p.current_unit->last_char = EOF - 1; + fbuf_seek (dtp->u.p.current_unit, -1, SEEK_CUR); + } + n = seen_comma = 0; /* Read data into format buffer and scan through it. */ @@ -1499,6 +1523,7 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind /* Call the user defined formatted READ procedure. */ dtp->u.p.current_unit->child_dtio++; + dtp->u.p.current_unit->last_char = EOF - 1; dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist, child_iostat, child_iomsg, iotype_len, child_iomsg_len); @@ -2856,6 +2881,11 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) } } + /* Child IO is non-advancing and any ADVANCE= specifier is ignored. + F2008 9.6.2.4 */ + if (dtp->u.p.current_unit->child_dtio > 0) + dtp->u.p.advance_status = ADVANCE_NO; + if (read_flag) { dtp->u.p.current_unit->previous_nonadvancing_write = 0; @@ -3856,6 +3886,15 @@ finalize_transfer (st_parameter_dt *dtp) namelist_write (dtp); } + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + *dtp->size = dtp->u.p.current_unit->size_used; + + if (dtp->u.p.eor_condition) + { + generate_error (&dtp->common, LIBERROR_EOR, NULL); + goto done; + } + if (dtp->u.p.current_unit && (dtp->u.p.current_unit->child_dtio > 0)) { if (cf & IOPARM_DT_HAS_FORMAT) @@ -3866,15 +3905,6 @@ finalize_transfer (st_parameter_dt *dtp) return; } - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - *dtp->size = dtp->u.p.current_unit->size_used; - - if (dtp->u.p.eor_condition) - { - generate_error (&dtp->common, LIBERROR_EOR, NULL); - goto done; - } - if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) { if (dtp->u.p.current_unit && current_mode (dtp) == UNFORMATTED_SEQUENTIAL) |