blob: be4f25177e1b2062e5890e8c4c83b0ec7c87c7e1 [file] [log] [blame]
! { 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
rl = 1
tl = 22
kl = 333
thesize = 9999
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) STOP 1
close(28)
END PROGRAM test