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
|
! { dg-do run }
!
! Functional test of User Defined Derived Type IO with typebound bindings
! This version tests IO to internal character units.
!
MODULE p
TYPE :: person
CHARACTER (LEN=20) :: name
INTEGER(4) :: age
CONTAINS
procedure :: pwf
procedure :: prf
GENERIC :: WRITE(FORMATTED) => pwf
GENERIC :: READ(FORMATTED) => prf
END TYPE person
CONTAINS
SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg)
CLASS(person), INTENT(IN) :: dtv
INTEGER, INTENT(IN) :: unit
CHARACTER (LEN=*), INTENT(IN) :: iotype
INTEGER, INTENT(IN) :: vlist(:)
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
WRITE(unit, FMT = *, IOSTAT=iostat) dtv%name, dtv%age
END SUBROUTINE pwf
SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg)
CLASS(person), INTENT(INOUT) :: dtv
INTEGER, INTENT(IN) :: unit
CHARACTER (LEN=*), INTENT(IN) :: iotype
INTEGER, INTENT(IN) :: vlist(:)
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
END SUBROUTINE prf
END MODULE p
PROGRAM test
USE p
TYPE (person) :: chairman, answer
character(kind=1,len=80) :: str1
character(kind=4,len=80) :: str4
str1 = ""
str4 = 4_""
chairman%name="Charlie"
chairman%age=62
answer = chairman
! KIND=1 test
write (str1, *) chairman
if (trim(str1).ne." Charlie 62") STOP 1
chairman%name="Bogus"
chairman%age=99
read (str1, *) chairman
if (chairman%name.ne.answer%name) STOP 2
if (chairman%age.ne.answer%age) STOP 3
! KIND=4 test
write (str4, *) chairman
if (trim(str4).ne.4_" Charlie 62") STOP 4
chairman%name="Bogus"
chairman%age=99
read (str4, *) chairman
if (chairman%name.ne.answer%name) STOP 5
if (chairman%age.ne.answer%age) STOP 6
END PROGRAM test
|
