3 ! Functional test of User Defined DT IO, unformatted WRITE/READ
5 ! 1) Tests unformatted DTV write with other variables in the record
6 ! 2) Tests reading back the recods written.
10 character (len
=20) :: name
15 generic
:: write(unformatted
) => pwuf
16 generic
:: read(unformatted
) => pruf
19 subroutine pwuf (dtv
,unit
,iostat
,iomsg
)
20 class(person
), intent(in
) :: dtv
21 integer, intent(in
) :: unit
22 integer, intent(out
) :: iostat
23 character (len
=*), intent(inout
) :: iomsg
24 write (unit
=unit
, iostat
=iostat
, iomsg
=iomsg
) dtv
%name
, dtv
%age
27 subroutine pruf (dtv
,unit
,iostat
,iomsg
)
28 class(person
), intent(inout
) :: dtv
29 integer, intent(in
) :: unit
30 integer, intent(out
) :: iostat
31 character (len
=*), intent(inout
) :: iomsg
32 read (unit
= unit
) dtv
%name
, dtv
%age
39 type (person
), save :: chairman
40 character(3) :: tmpstr1
, tmpstr2
41 chairman
%name
="charlie"
44 open (unit
=71, file
='myunformatted_data.dat', form
='unformatted')
45 write (71) "abc", chairman
, "efg"
46 write (71) "hij", chairman
, "klm"
47 write (71) "nop", chairman
, "qrs"
49 chairman
%name
="boggle"
51 read (71) tmpstr1
, chairman
, tmpstr2
52 if (tmpstr1
.ne
."abc") call abort
53 if (tmpstr2
.ne
."efg") call abort
54 if (chairman
%name
.ne
."charlie") call abort
55 if (chairman
%age
.ne
.62) call abort
56 chairman
%name
="boggle"
58 read (71) tmpstr1
, chairman
, tmpstr2
59 if (tmpstr1
.ne
."hij") call abort
60 if (tmpstr2
.ne
."klm") call abort
61 if (chairman
%name
.ne
."charlie") call abort
62 if (chairman
%age
.ne
.62) call abort
63 chairman
%name
="boggle"
65 read (71) tmpstr1
, chairman
, tmpstr2
66 if (tmpstr1
.ne
."nop") call abort
67 if (tmpstr2
.ne
."qrs") call abort
68 if (chairman
%name
.ne
."charlie") call abort
69 if (chairman
%age
.ne
.62) call abort
70 close (unit
= 71, status
='delete')