gcc/testsuite/gfortran.dg/dtio_14.f90

! { dg-do run }
!
! Functional test of User Defined Derived Type IO with typebound bindings
! This version tests IO to internal character units.
!
MODULE p
  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
    WRITE(unit, FMT = *, IOSTAT=iostat) dtv%name, dtv%age
  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
    READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
  END SUBROUTINE prf
END MODULE p

PROGRAM test
  USE p
  TYPE (person) :: chairman, answer
  character(kind=1,len=80) :: str1
  character(kind=4,len=80) :: str4
  str1 = ""
  str4 = 4_""
  chairman%name="Charlie"
  chairman%age=62
  answer = chairman
! KIND=1 test
  write (str1, *) chairman
  if (trim(str1).ne."  Charlie                       62") STOP 1
  chairman%name="Bogus"
  chairman%age=99
  read (str1, *) chairman
  if (chairman%name.ne.answer%name) STOP 2
  if (chairman%age.ne.answer%age) STOP 3
! KIND=4 test
  write (str4, *) chairman
  if (trim(str4).ne.4_"  Charlie                       62") STOP 4
  chairman%name="Bogus"
  chairman%age=99
  read (str4, *) chairman
  if (chairman%name.ne.answer%name) STOP 5
  if (chairman%age.ne.answer%age) STOP 6
END PROGRAM test