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 /gcc | |
| 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 'gcc')
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/dtio_17.f90 | 77 |
2 files changed, 81 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b962485..6d57099 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 0000000..a6b1fb3 --- /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 |