1! { dg-do run } 2! PR48298, this tests function of size= specifier with DTIO. 3MODULE p 4 USE ISO_FORTRAN_ENV 5 TYPE :: person 6 CHARACTER (LEN=20) :: name 7 INTEGER(4) :: age 8 CONTAINS 9 procedure :: pwf 10 procedure :: prf 11 GENERIC :: WRITE(FORMATTED) => pwf 12 GENERIC :: READ(FORMATTED) => prf 13 END TYPE person 14CONTAINS 15 SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg) 16 CLASS(person), INTENT(IN) :: dtv 17 INTEGER, INTENT(IN) :: unit 18 CHARACTER (LEN=*), INTENT(IN) :: iotype 19 INTEGER, INTENT(IN) :: vlist(:) 20 INTEGER, INTENT(OUT) :: iostat 21 CHARACTER (LEN=*), INTENT(INOUT) :: iomsg 22 CHARACTER (LEN=30) :: udfmt 23 INTEGER :: myios 24 25 iomsg = "SUCCESS" 26 iostat=0 27 if (iotype.eq."DT") then 28 WRITE(unit, FMT = '(a20,i2)', IOSTAT=iostat, advance='no') dtv%name, dtv%age 29 if (iostat.ne.0) iomsg = "Fail PWF DT" 30 endif 31 if (iotype.eq."LISTDIRECTED") then 32 WRITE(unit, '(*(g0))', IOSTAT=iostat) dtv%name, dtv%age 33 if (iostat.ne.0) iomsg = "Fail PWF DT" 34 endif 35 END SUBROUTINE pwf 36 37 SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg) 38 CLASS(person), INTENT(INOUT) :: dtv 39 INTEGER, INTENT(IN) :: unit 40 CHARACTER (LEN=*), INTENT(IN) :: iotype 41 INTEGER, INTENT(IN) :: vlist(:) 42 INTEGER, INTENT(OUT) :: iostat 43 CHARACTER (LEN=*), INTENT(INOUT) :: iomsg 44 CHARACTER (LEN=30) :: udfmt 45 INTEGER :: myios 46 real :: areal 47 udfmt='(*(g0))' 48 iomsg = "SUCCESS" 49 iostat=0 50 if (iotype.eq."DT") then 51 READ(unit, FMT = '(a20,i2)', IOSTAT=iostat) dtv%name, dtv%age 52 if (iostat.ne.0) iomsg = "Fail PWF DT" 53 endif 54 END SUBROUTINE prf 55 56END MODULE p 57 58PROGRAM test 59 USE p 60 implicit none 61 TYPE (person) :: chairman 62 integer(4) :: rl, tl, kl, thesize 63 64 rl = 1 65 tl = 22 66 kl = 333 67 thesize = 9999 68 chairman%name="Charlie" 69 chairman%age=62 70 71 open(28, status='scratch') 72 write(28, '(i10,i10,DT,i15,DT,i12)') rl, kl, chairman, rl, chairman, tl 73 rewind(28) 74 chairman%name="bogus" 75 chairman%age=99 76 !print *, chairman 77 read(28, '(i10,i10,DT,i15,DT,i12)', advance='no', size=thesize) rl, & 78 & kl, chairman, rl, chairman, tl 79 if (thesize.ne.91) STOP 1 80 close(28) 81END PROGRAM test 82