gcc/testsuite/gfortran.dg/dtio_16.f90

   1 ! { dg-do run }
   2 ! Tests that inquire(iolength=) treats derived types as if they do not
   3 ! have User Defined procedures. Fortran Draft F2016 Standard, 9.10.3
   4 MODULE p
   5   TYPE :: person
   6     CHARACTER (LEN=20) :: name
   7     INTEGER(4) :: age
   8   END TYPE person
   9   INTERFACE WRITE(FORMATTED)
  10      MODULE procedure pwf
  11   END INTERFACE
  12   INTERFACE WRITE(UNFORMATTED)
  13      MODULE procedure pwuf
  14   END INTERFACE
  15   INTERFACE read(FORMATTED)
  16      MODULE procedure prf
  17   END INTERFACE
  18   INTERFACE read(UNFORMATTED)
  19      MODULE procedure pruf
  20   END INTERFACE
  21 CONTAINS
  22   SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg)
  23     CLASS(person), INTENT(IN) :: dtv
  24     INTEGER, INTENT(IN) :: unit
  25     CHARACTER (LEN=*), INTENT(IN) :: iotype
  26     INTEGER, INTENT(IN) :: vlist(:)
  27     INTEGER, INTENT(OUT) :: iostat
  28     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  29     WRITE(unit, FMT = *, IOSTAT=iostat) dtv%name, dtv%age
  30   END SUBROUTINE pwf
  31
  32   SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg)
  33     CLASS(person), INTENT(INOUT) :: dtv
  34     INTEGER, INTENT(IN) :: unit
  35     CHARACTER (LEN=*), INTENT(IN) :: iotype
  36     INTEGER, INTENT(IN) :: vlist(:)
  37     INTEGER, INTENT(OUT) :: iostat
  38     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  39     READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
  40   END SUBROUTINE prf
  41
  42   SUBROUTINE pwuf (dtv,unit,iostat,iomsg)
  43     CLASS(person), INTENT(IN) :: dtv
  44     INTEGER, INTENT(IN) :: unit
  45     INTEGER, INTENT(OUT) :: iostat
  46     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  47     print *, "in pwuf"
  48     WRITE (UNIT=UNIT, FMT = *) DTV%name, DTV%age
  49   END SUBROUTINE pwuf
  50
  51   SUBROUTINE pruf (dtv,unit,iostat,iomsg)
  52     CLASS(person), INTENT(INOUT) :: dtv
  53     INTEGER, INTENT(IN) :: unit
  54     INTEGER, INTENT(OUT) :: iostat
  55     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  56     print *, "in pruf"
  57     READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
  58   END SUBROUTINE pruf
  59
  60 END MODULE p
  61
  62 PROGRAM test
  63   USE p
  64   IMPLICIT NONE
  65   TYPE (person) :: chairman
  66   integer(4) :: rl, tl, kl
  67
  68   chairman%name="Charlie"
  69   chairman%age=62
  70
  71   inquire(iolength=rl) rl, kl, chairman, rl, chairman, tl
  72   if (rl.ne.64) call abort
  73 END PROGRAM test