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