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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
! RUN: %S/test_errors.sh %s %t %f18
! Tests for C760:
! The passed-object dummy argument shall be a scalar, nonpointer, nonallocatable
! dummy data object with the same declared type as the type being defined;
! all of its length type parameters shall be assumed; it shall be polymorphic
! (7.3.2.3) if and only if the type being defined is extensible (7.5.7).
! It shall not have the VALUE attribute.
!
! C757 If the procedure pointer component has an implicit interface or has no
! arguments, NOPASS shall be specified.
!
! C758 If PASS (arg-name) appears, the interface of the procedure pointer
! component shall have a dummy argument named arg-name.
module m1
type :: t
procedure(real), pointer, nopass :: a
!ERROR: Procedure component 'b' must have NOPASS attribute or explicit interface
procedure(real), pointer :: b
end type
end
module m2
type :: t
!ERROR: Procedure component 'a' with no dummy arguments must have NOPASS attribute
procedure(s1), pointer :: a
!ERROR: Procedure component 'b' with no dummy arguments must have NOPASS attribute
procedure(s1), pointer, pass :: b
contains
!ERROR: Procedure binding 'p1' with no dummy arguments must have NOPASS attribute
procedure :: p1 => s1
!ERROR: Procedure binding 'p2' with no dummy arguments must have NOPASS attribute
procedure, pass :: p2 => s1
end type
contains
subroutine s1()
end
end
module m3
type :: t
!ERROR: 'y' is not a dummy argument of procedure interface 's'
procedure(s), pointer, pass(y) :: a
contains
!ERROR: 'z' is not a dummy argument of procedure interface 's'
procedure, pass(z) :: p => s
end type
contains
subroutine s(x)
class(t) :: x
end
end
module m4
type :: t
!ERROR: Passed-object dummy argument 'x' of procedure 'a' may not have the POINTER attribute
procedure(s1), pointer :: a
!ERROR: Passed-object dummy argument 'x' of procedure 'b' may not have the ALLOCATABLE attribute
procedure(s2), pointer, pass(x) :: b
!ERROR: Passed-object dummy argument 'f' of procedure 'c' must be a data object
procedure(s3), pointer, pass :: c
!ERROR: Passed-object dummy argument 'x' of procedure 'd' must be scalar
procedure(s4), pointer, pass :: d
end type
contains
subroutine s1(x)
class(t), pointer :: x
end
subroutine s2(w, x)
real :: x
!ERROR: The type of 'x' has already been declared
class(t), allocatable :: x
end
subroutine s3(f)
interface
real function f()
end function
end interface
end
subroutine s4(x)
class(t) :: x(10)
end
end
module m5
type :: t1
sequence
!ERROR: Passed-object dummy argument 'x' of procedure 'a' must be of type 't1' but is 'REAL(4)'
procedure(s), pointer :: a
end type
type :: t2
contains
!ERROR: Passed-object dummy argument 'y' of procedure 's' must be of type 't2' but is 'TYPE(t1)'
procedure, pass(y) :: s
end type
contains
subroutine s(x, y)
real :: x
type(t1) :: y
end
end
module m6
type :: t(k, l)
integer, kind :: k
integer, len :: l
!ERROR: Passed-object dummy argument 'x' of procedure 'a' has non-assumed length parameter 'l'
procedure(s1), pointer :: a
end type
contains
subroutine s1(x)
class(t(1, 2)) :: x
end
end
module m7
type :: t
sequence ! t is not extensible
!ERROR: Passed-object dummy argument 'x' of procedure 'a' may not be polymorphic because 't' is not extensible
procedure(s), pointer :: a
end type
contains
subroutine s(x)
!ERROR: Non-extensible derived type 't' may not be used with CLASS keyword
class(t) :: x
end
end
module m8
type :: t
contains
!ERROR: Passed-object dummy argument 'x' of procedure 's' must be polymorphic because 't' is extensible
procedure :: s
end type
contains
subroutine s(x)
type(t) :: x ! x is not polymorphic
end
end
|
