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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
! RUN: %python %S/test_errors.py %s %flang_fc1
! Tests for the ASSOCIATED() and NULL() intrinsics
subroutine assoc()
abstract interface
subroutine subrInt(i)
integer :: i
end subroutine subrInt
integer function abstractIntFunc(x)
integer, intent(in) :: x
end function
end interface
type :: t1
integer :: n
end type t1
type :: t2
type(t1) :: t1arr(2)
type(t1), pointer :: t1ptr(:)
end type t2
contains
integer function intFunc(x)
integer, intent(in) :: x
intFunc = x
end function
real function realFunc(x)
real, intent(in) :: x
realFunc = x
end function
pure integer function pureFunc()
pureFunc = 343
end function pureFunc
elemental integer function elementalFunc(n)
integer, value :: n
elementalFunc = n
end function elementalFunc
subroutine subr(i)
integer :: i
end subroutine subr
subroutine subrCannotBeCalledfromImplicit(i)
integer :: i(:)
end subroutine subrCannotBeCalledfromImplicit
subroutine test()
integer :: intVar
integer, target :: targetIntVar1
integer(kind=2), target :: targetIntVar2
real, target :: targetRealVar
integer, pointer :: intPointerVar1
integer, pointer :: intPointerVar2
integer, allocatable :: intAllocVar
procedure(intFunc) :: intProc
procedure(intFunc), pointer :: intprocPointer1
procedure(intFunc), pointer :: intprocPointer2
procedure(realFunc) :: realProc
procedure(realFunc), pointer :: realprocPointer1
procedure(pureFunc), pointer :: pureFuncPointer
procedure(elementalFunc) :: elementalProc
external :: externalProc
procedure(subrInt) :: subProc
procedure(subrInt), pointer :: subProcPointer
procedure(), pointer :: implicitProcPointer
logical :: lVar
type(t1) :: t1x
type(t1), target :: t1xtarget
type(t2) :: t2x
type(t2), target :: t2xtarget
!ERROR: missing mandatory 'pointer=' argument
lVar = associated()
!ERROR: MOLD= argument to NULL() must be a pointer or allocatable
lVar = associated(null(intVar))
lVar = associated(null(intAllocVar)) !OK
lVar = associated(null()) !OK
lVar = associated(null(intPointerVar1)) !OK
lVar = associated(null(), null()) !OK
lVar = associated(intPointerVar1, null(intPointerVar2)) !OK
lVar = associated(intPointerVar1, null()) !OK
lVar = associated(null(), null(intPointerVar1)) !OK
lVar = associated(null(intPointerVar1), null()) !OK
!ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
lVar = associated(intVar)
!ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
lVar = associated(intVar, intVar)
!ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
lVar = associated(intAllocVar)
!ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
lVar = associated(intPointerVar1, targetRealVar)
lVar = associated(intPointerVar1, targetIntVar1) !OK
!ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
lVar = associated(intPointerVar1, targetIntVar2)
lVar = associated(intPointerVar1) !OK
lVar = associated(intPointerVar1, intPointerVar2) !OK
!ERROR: In assignment to object pointer 'intpointervar1', the target 'intvar' is not an object with POINTER or TARGET attributes
intPointerVar1 => intVar
!ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute
lVar = associated(intPointerVar1, intVar)
!ERROR: TARGET= argument 't1x%n' must have either the POINTER or the TARGET attribute
lVar = associated(intPointerVar1, t1x%n)
lVar = associated(intPointerVar1, t1xtarget%n) ! ok
!ERROR: TARGET= argument 't2x%t1arr(1_8)%n' must have either the POINTER or the TARGET attribute
lVar = associated(intPointerVar1, t2x%t1arr(1)%n)
lVar = associated(intPointerVar1, t2x%t1ptr(1)%n) ! ok
lVar = associated(intPointerVar1, t2xtarget%t1arr(1)%n) ! ok
lVar = associated(intPointerVar1, t2xtarget%t1ptr(1)%n) ! ok
! Procedure pointer tests
intprocPointer1 => intProc !OK
lVar = associated(intprocPointer1, intProc) !OK
intprocPointer1 => intProcPointer2 !OK
lVar = associated(intprocPointer1, intProcPointer2) !OK
intProcPointer1 => null(intProcPointer2) ! ok
lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
intProcPointer1 => null() ! ok
lvar = associated(intProcPointer1, null()) ! ok
intProcPointer1 => intProcPointer2 ! ok
lvar = associated(intProcPointer1, intProcPointer2) ! ok
intProcPointer1 => null(intProcPointer2) ! ok
lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
intProcPointer1 =>null() ! ok
lvar = associated(intProcPointer1, null()) ! ok
intPointerVar1 => null(intPointerVar1) ! ok
lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok
!ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
intprocPointer1 => intVar
!ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer
lVar = associated(intprocPointer1, intVar)
!ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc'
intProcPointer1 => elementalProc
!ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc'
lvar = associated(intProcPointer1, elementalProc)
!ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is a procedure designator
lvar = associated (intPointerVar1, intFunc)
!ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator
intPointerVar1 => intFunc
!ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
intProcPointer1 => targetIntVar1
!ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer
lvar = associated (intProcPointer1, targetIntVar1)
!ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null' that is an incompatible procedure pointer
intProcPointer1 => null(mold=realProcPointer1)
!ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null()' that is an incompatible procedure pointer
lvar = associated(intProcPointer1, null(mold=realProcPointer1))
!ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
pureFuncPointer => intProc
!ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
lvar = associated(pureFuncPointer, intProc)
!ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
realProcPointer1 => intProc
!ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
lvar = associated(realProcPointer1, intProc)
!ERROR: Procedure pointer 'subprocpointer' with explicit interface may not be associated with procedure designator 'externalproc' with implicit interface
subProcPointer => externalProc
!ERROR: Procedure pointer 'subprocpointer' with explicit interface may not be associated with procedure designator 'externalproc' with implicit interface
lvar = associated(subProcPointer, externalProc)
!ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
subProcPointer => intProc
!ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
lvar = associated(subProcPointer, intProc)
!ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
intProcPointer1 => subProc
!ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
lvar = associated(intProcPointer1, subProc)
implicitProcPointer => subr ! OK for an implicit point to point to an explicit proc
lvar = associated(implicitProcPointer, subr) ! OK
!ERROR: Procedure pointer 'implicitprocpointer' with implicit interface may not be associated with procedure designator 'subrcannotbecalledfromimplicit' with explicit interface that cannot be called via an implicit interface
lvar = associated(implicitProcPointer, subrCannotBeCalledFromImplicit)
end subroutine test
end subroutine assoc
|
