! { 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