3 ! Functional test of User Defined Derived Type IO with typebound bindings
4 ! This version tests IO to internal character units.
8 CHARACTER (LEN
=20) :: name
13 GENERIC
:: WRITE(FORMATTED
) => pwf
14 GENERIC
:: READ(FORMATTED
) => prf
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
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
40 TYPE (person
) :: chairman
, answer
41 character(kind
=1,len
=80) :: str1
42 character(kind
=4,len
=80) :: str4
45 chairman
%name
="Charlie"
49 write (str1
, *) chairman
50 if (trim(str1
).ne
." Charlie 62") STOP 1
53 read (str1
, *) chairman
54 if (chairman
%name
.ne
.answer
%name
) STOP 2
55 if (chairman
%age
.ne
.answer
%age
) STOP 3
57 write (str4
, *) chairman
58 if (trim(str4
).ne
.4_
" Charlie 62") STOP 4
61 read (str4
, *) chairman
62 if (chairman
%name
.ne
.answer
%name
) STOP 5
63 if (chairman
%age
.ne
.answer
%age
) STOP 6