gcc/testsuite/gfortran.dg/dtio_14.f90

   1 ! { dg-do run }
   2 !
   3 ! Functional test of User Defined Derived Type IO with typebound bindings
   4 ! This version tests IO to internal character units.
   5 !
   6 MODULE p
   7   TYPE :: person
   8     CHARACTER (LEN=20) :: name
   9     INTEGER(4) :: age
  10     CONTAINS
  11       procedure :: pwf
  12       procedure :: prf
  13       GENERIC :: WRITE(FORMATTED) => pwf
  14       GENERIC :: READ(FORMATTED) => prf
  15   END TYPE person
  16 CONTAINS
  17   SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg)
  18     CLASS(person), INTENT(IN) :: dtv
  19     INTEGER, INTENT(IN) :: unit
  20     CHARACTER (LEN=*), INTENT(IN) :: iotype
  21     INTEGER, INTENT(IN) :: vlist(:)
  22     INTEGER, INTENT(OUT) :: iostat
  23     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  24     WRITE(unit, FMT = *, IOSTAT=iostat) dtv%name, dtv%age
  25   END SUBROUTINE pwf
  26
  27   SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg)
  28     CLASS(person), INTENT(INOUT) :: dtv
  29     INTEGER, INTENT(IN) :: unit
  30     CHARACTER (LEN=*), INTENT(IN) :: iotype
  31     INTEGER, INTENT(IN) :: vlist(:)
  32     INTEGER, INTENT(OUT) :: iostat
  33     CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
  34     READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
  35   END SUBROUTINE prf
  36 END MODULE p
  37
  38 PROGRAM test
  39   USE p
  40   TYPE (person) :: chairman, answer
  41   character(kind=1,len=80) :: str1
  42   character(kind=4,len=80) :: str4
  43   str1 = ""
  44   str4 = 4_""
  45   chairman%name="Charlie"
  46   chairman%age=62
  47   answer = chairman
  48 ! KIND=1 test
  49   write (str1, *) chairman
  50   if (trim(str1).ne."  Charlie                       62") call abort
  51   chairman%name="Bogus"
  52   chairman%age=99
  53   read (str1, *) chairman
  54   if (chairman%name.ne.answer%name) call abort
  55   if (chairman%age.ne.answer%age) call abort
  56 ! KIND=4 test
  57   write (str4, *) chairman
  58   if (trim(str4).ne.4_"  Charlie                       62") call abort
  59   chairman%name="Bogus"
  60   chairman%age=99
  61   read (str4, *) chairman
  62   if (chairman%name.ne.answer%name) call abort
  63   if (chairman%age.ne.answer%age) call abort
  64 END PROGRAM test