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! 6MODULE 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 16CONTAINS 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 36END MODULE p 37 38PROGRAM 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") STOP 1 51 chairman%name="Bogus" 52 chairman%age=99 53 read (str1, *) chairman 54 if (chairman%name.ne.answer%name) STOP 2 55 if (chairman%age.ne.answer%age) STOP 3 56! KIND=4 test 57 write (str4, *) chairman 58 if (trim(str4).ne.4_" Charlie 62") STOP 4 59 chairman%name="Bogus" 60 chairman%age=99 61 read (str4, *) chairman 62 if (chairman%name.ne.answer%name) STOP 5 63 if (chairman%age.ne.answer%age) STOP 6 64END PROGRAM test 65