diff options
author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2016-10-18 04:14:25 +0000 |
---|---|---|
committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2016-10-18 04:14:25 +0000 |
commit | c680ada5f527a33ea7c793704019fb46c795d5f4 (patch) | |
tree | 1999f935b9407f3f6f2dea1eb9f1e478784747f9 /libgfortran/io/transfer.c | |
parent | b78027d1a3f9a8fdf3386e24dcfd6679006dd154 (diff) | |
download | gcc-c680ada5f527a33ea7c793704019fb46c795d5f4.zip gcc-c680ada5f527a33ea7c793704019fb46c795d5f4.tar.gz gcc-c680ada5f527a33ea7c793704019fb46c795d5f4.tar.bz2 |
re PR fortran/48298 ([F03] User-Defined Derived-Type IO (DTIO))
2016-10-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/48298
* io/io.h: Move size_used from dtp to unit structure. Add bool
has_size to unit structure.
* read.c (read_x): Use has_size and size_used.
* transfer.c (read_sf_internal,read_sf,read_block_form,
read_block_form4): Likewise.
(data_transfer_init): If parent, initialize the size variables.
(finalize_transfer): Set the size variable using size_used in
gfc_unit. (write_block): Delete bogus/dead code.
* gfortran.dg/dtio_17.f90: New test.
From-SVN: r241294
Diffstat (limited to 'libgfortran/io/transfer.c')
-rw-r--r-- | libgfortran/io/transfer.c | 42 |
1 files changed, 28 insertions, 14 deletions
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 2232417..1f46ca6 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -267,8 +267,9 @@ read_sf_internal (st_parameter_dt *dtp, int * length) dtp->u.p.current_unit->bytes_left -= *length; - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) *length; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) *length; return base; @@ -397,8 +398,9 @@ read_sf (st_parameter_dt *dtp, int * length) dtp->u.p.current_unit->bytes_left -= n; - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) n; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) n; /* We can't call fbuf_getptr before the loop doing fbuf_getc, because fbuf_getc might reallocate the buffer. So return current pointer @@ -478,8 +480,9 @@ read_block_form (st_parameter_dt *dtp, int * nbytes) source = fbuf_read (dtp->u.p.current_unit, nbytes); fbuf_seek (dtp->u.p.current_unit, *nbytes, SEEK_CUR); - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) *nbytes; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) *nbytes; if (norig != *nbytes) { @@ -536,8 +539,9 @@ read_block_form4 (st_parameter_dt *dtp, int * nbytes) dtp->u.p.current_unit->bytes_left -= *nbytes; - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) *nbytes; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) *nbytes; return source; } @@ -770,8 +774,9 @@ write_block (st_parameter_dt *dtp, int length) } } - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) length; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) length; dtp->u.p.current_unit->strm_pos += (gfc_offset) length; @@ -2596,9 +2601,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; - if ((cf & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used = 0; /* Initialize the count. */ - dtp->u.p.current_unit = get_unit (dtp, 1); if (dtp->u.p.current_unit == NULL) @@ -2674,6 +2676,18 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) return; } + if (dtp->u.p.current_unit->child_dtio == 0) + { + if ((cf & IOPARM_DT_HAS_SIZE) != 0) + { + dtp->u.p.current_unit->has_size = true; + /* Initialize the count. */ + dtp->u.p.current_unit->size_used = 0; + } + else + dtp->u.p.current_unit->has_size = false; + } + /* Check the action. */ if (read_flag && dtp->u.p.current_unit->flags.action == ACTION_WRITE) @@ -3772,7 +3786,7 @@ finalize_transfer (st_parameter_dt *dtp) return; if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - *dtp->size = dtp->u.p.size_used; + *dtp->size = dtp->u.p.current_unit->size_used; if (dtp->u.p.eor_condition) { |