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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
! { dg-do compile }
!
! Tests the checks for interface compliance.
!
!
MODULE p
USE ISO_C_BINDING
TYPE :: person
CHARACTER (LEN=20) :: name
INTEGER(4) :: age
CONTAINS
procedure :: pwf ! { dg-error "Non-polymorphic passed-object" }
procedure :: pwuf
GENERIC :: WRITE(FORMATTED) => pwf
GENERIC :: WRITE(UNFORMATTED) => pwuf
END TYPE person
INTERFACE READ(FORMATTED)
MODULE PROCEDURE prf
END INTERFACE
INTERFACE READ(UNFORMATTED)
MODULE PROCEDURE pruf
END INTERFACE
TYPE :: seq_type
sequence
INTEGER(4) :: i
END TYPE seq_type
INTERFACE WRITE(FORMATTED)
MODULE PROCEDURE pwf_seq
END INTERFACE
TYPE, BIND(C) :: bindc_type
INTEGER(C_INT) :: i
END TYPE bindc_type
INTERFACE WRITE(FORMATTED)
MODULE PROCEDURE pwf_bindc
END INTERFACE
CONTAINS
SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "must be of type CLASS" }
type(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) ! { dg-error "must be an ASSUMED SHAPE ARRAY" }
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
SUBROUTINE pwuf (dtv,unit,iostat,iomsg) ! { dg-error "must have intent IN" }
CLASS(person), INTENT(INOUT) :: dtv
INTEGER, INTENT(IN) :: unit
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
WRITE (UNIT=UNIT, FMT = *) DTV%name, DTV%age
END SUBROUTINE pwuf
SUBROUTINE pruf (dtv,unit,iostat,iomsg) ! { dg-error "must be of KIND = 4" }
CLASS(person), INTENT(INOUT) :: dtv
INTEGER, INTENT(IN) :: unit
INTEGER(8), INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
END SUBROUTINE pruf
SUBROUTINE pwf_seq (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "not extensible|DERIVED" }
class(seq_type), 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%i
END SUBROUTINE pwf_seq
SUBROUTINE pwf_bindc (dtv,unit,iotype,vlist,iostat,iomsg) ! { dg-error "not extensible|DERIVED" }
class(bindc_type), 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%i
END SUBROUTINE pwf_bindc
END MODULE p
|
