gcc/testsuite/gfortran.dg/dtio_17.f90

   1 ! { dg-do run }
   2 ! PR48298, this tests function of size= specifier with DTIO.
   3 MODULE 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
  14 CONTAINS
  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
  56 END MODULE p
  57
  58 PROGRAM 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) call abort
  80   close(28)
  81 END PROGRAM test