diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b962485a50adbb1b030929c6a04e3fe0bb49e4bc..6d57099bfc51d1a5832cb61b13d999105d380169 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2016-10-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ * gfortran.dg/dtio_17.f90: New test.
+
2016-10-18 Kugan Vivekanandarajah <kuganv@linaro.org>
* gcc.dg/ipa/vrp4.c: Adjust testcase.
diff --git a/gcc/testsuite/gfortran.dg/dtio_17.f90 b/gcc/testsuite/gfortran.dg/dtio_17.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a6b1fb3988806691536a4467dc46d1b6dd03e740
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dtio_17.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! PR48298, this tests function of size= specifier with DTIO.
+MODULE p
+ USE ISO_FORTRAN_ENV
+ TYPE :: person
+ CHARACTER (LEN=20) :: name
+ INTEGER(4) :: age
+ CONTAINS
+ procedure :: pwf
+ procedure :: prf
+ GENERIC :: WRITE(FORMATTED) => pwf
+ GENERIC :: READ(FORMATTED) => prf
+ END TYPE person
+CONTAINS
+ SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg)
+ CLASS(person), INTENT(IN) :: dtv
+ INTEGER, INTENT(IN) :: unit
+ CHARACTER (LEN=*), INTENT(IN) :: iotype
+ INTEGER, INTENT(IN) :: vlist(:)
+ INTEGER, INTENT(OUT) :: iostat
+ CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+ CHARACTER (LEN=30) :: udfmt
+ INTEGER :: myios
+
+ iomsg = "SUCCESS"
+ iostat=0
+ if (iotype.eq."DT") then
+ WRITE(unit, FMT = '(a20,i2)', IOSTAT=iostat, advance='no') dtv%name, dtv%age
+ if (iostat.ne.0) iomsg = "Fail PWF DT"
+ endif
+ if (iotype.eq."LISTDIRECTED") then
+ WRITE(unit, '(*(g0))', IOSTAT=iostat) dtv%name, dtv%age
+ if (iostat.ne.0) iomsg = "Fail PWF DT"
+ endif
+ END SUBROUTINE pwf
+
+ SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg)
+ CLASS(person), INTENT(INOUT) :: dtv
+ INTEGER, INTENT(IN) :: unit
+ CHARACTER (LEN=*), INTENT(IN) :: iotype
+ INTEGER, INTENT(IN) :: vlist(:)
+ INTEGER, INTENT(OUT) :: iostat
+ CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+ CHARACTER (LEN=30) :: udfmt
+ INTEGER :: myios
+ real :: areal
+ udfmt='(*(g0))'
+ iomsg = "SUCCESS"
+ iostat=0
+ if (iotype.eq."DT") then
+ READ(unit, FMT = '(a20,i2)', IOSTAT=iostat) dtv%name, dtv%age
+ if (iostat.ne.0) iomsg = "Fail PWF DT"
+ endif
+ END SUBROUTINE prf
+
+END MODULE p
+
+PROGRAM test
+ USE p
+ implicit none
+ TYPE (person) :: chairman
+ integer(4) :: rl, tl, kl, thesize
+
+ chairman%name="Charlie"
+ chairman%age=62
+
+ open(28, status='scratch')
+ write(28, '(i10,i10,DT,i15,DT,i12)') rl, kl, chairman, rl, chairman, tl
+ rewind(28)
+ chairman%name="bogus"
+ chairman%age=99
+ !print *, chairman
+ read(28, '(i10,i10,DT,i15,DT,i12)', advance='no', size=thesize) rl, &
+ & kl, chairman, rl, chairman, tl
+ if (thesize.ne.91) call abort
+ close(28)
+END PROGRAM test
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index bfda86df86cf1a8096302020b87725d3460721ab..9662df891f5bf19485bfa995859f2b67e8b4d82d 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,15 @@
+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.
+
2016-10-16 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/48587
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index aaacc089fc7e8d2186e5aa3ac31a3d1ebe5ba344..edc520a920fb17b960666ec9b3fb580095cc9c40 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -514,7 +514,6 @@ typedef struct st_parameter_dt
large enough to hold a complex value (two reals) of the
largest kind. */
char value[32];
- GFC_IO_INT size_used;
formatted_dtio fdtio_ptr;
unformatted_dtio ufdtio_ptr;
} p;
@@ -650,6 +649,8 @@ typedef struct gfc_unit
/* DTIO Parent/Child procedure, 0 = parent, >0 = child level. */
int child_dtio;
int last_char;
+ bool has_size;
+ GFC_IO_INT size_used;
}
gfc_unit;
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index f8d5b72e47b4e3ed2e601fb2e6130b87c3efd6ea..d72cdb37e113c340cb1d887c1bbe87a1de06d792 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -1282,8 +1282,9 @@ read_x (st_parameter_dt *dtp, int n)
}
done:
- 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;
dtp->u.p.current_unit->bytes_left -= n;
dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
}
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 2232417af6b4be3d0fd623c99ea929ece3e18681..1f46ca64cf12244995162ae0ee330c4c1979957f 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)
{