1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
! { dg-do run }
!
! Tests dtio of transfer bind-C types.
!
! Note difficulties with c_char at -O1. This is why no character field is used.
!
MODULE p
USE ISO_C_BINDING
TYPE, BIND(C) :: person
integer(c_int) :: id_no
INTEGER(c_int) :: age
END TYPE person
INTERFACE WRITE(UNFORMATTED)
MODULE PROCEDURE pwuf
END INTERFACE
INTERFACE READ(UNFORMATTED)
MODULE PROCEDURE pruf
END INTERFACE
CONTAINS
SUBROUTINE pwuf (dtv,unit,iostat,iomsg)
type(person), INTENT(IN) :: dtv
INTEGER, INTENT(IN) :: unit
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
WRITE (UNIT=UNIT) DTV%id_no, DTV%age
END SUBROUTINE pwuf
SUBROUTINE pruf (dtv,unit,iostat,iomsg)
type(person), INTENT(INOUT) :: dtv
INTEGER, INTENT(IN) :: unit
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
READ (UNIT = UNIT) dtv%id_no, dtv%age
END SUBROUTINE pruf
END MODULE p
PROGRAM test
USE p
TYPE (person) :: chairman
CHARACTER (kind=c_char) :: cname(20)
integer (c_int) :: cage, cid_no
character(10) :: line
cid_no = 1
cage = 62
chairman%id_no = cid_no
chairman%age = cage
OPEN (UNIT=71, status = 'scratch', FORM='UNFORMATTED')
write (71) chairman
rewind (71)
chairman%id_no = 0
chairman%age = 0
read (71) chairman
close (unit = 71)
write(line, "(I4)") chairman%id_no
if (trim (line) .ne. " 1") STOP 1
write(line, "(I4)") chairman%age
if (trim (line) .ne. " 62") STOP 2
end program
|
