1! RUN: %S/test_errors.sh %s %t %f18
2! Tests for the ASSOCIATED() and NULL() intrinsics
3subroutine assoc()
4
5  abstract interface
6    subroutine subrInt(i)
7      integer :: i
8    end subroutine subrInt
9
10    integer function abstractIntFunc(x)
11      integer, intent(in) :: x
12    end function
13  end interface
14
15  contains
16  integer function intFunc(x)
17    integer, intent(in) :: x
18    intFunc = x
19  end function
20
21  real function realFunc(x)
22    real, intent(in) :: x
23    realFunc = x
24  end function
25
26  pure integer function pureFunc()
27    pureFunc = 343
28  end function pureFunc
29
30  elemental integer function elementalFunc()
31    elementalFunc = 343
32  end function elementalFunc
33
34  subroutine subr(i)
35    integer :: i
36  end subroutine subr
37
38  subroutine test()
39    integer :: intVar
40    integer, target :: targetIntVar1
41    integer(kind=2), target :: targetIntVar2
42    real, target :: targetRealVar
43    integer, pointer :: intPointerVar1
44    integer, pointer :: intPointerVar2
45    integer, allocatable :: intAllocVar
46    procedure(intFunc) :: intProc
47    procedure(intFunc), pointer :: intprocPointer1
48    procedure(intFunc), pointer :: intprocPointer2
49    procedure(realFunc) :: realProc
50    procedure(realFunc), pointer :: realprocPointer1
51    procedure(pureFunc), pointer :: pureFuncPointer
52    procedure(elementalFunc) :: elementalProc
53    external :: externalProc
54    procedure(subrInt) :: subProc
55    procedure(subrInt), pointer :: subProcPointer
56    procedure(), pointer :: implicitProcPointer
57    logical :: lVar
58
59    !ERROR: missing mandatory 'pointer=' argument
60    lVar = associated()
61    !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
62    lVar = associated(null(intVar))
63    lVar = associated(null(intAllocVar)) !OK
64    lVar = associated(null()) !OK
65    lVar = associated(null(intPointerVar1)) !OK
66    lVar = associated(null(), null()) !OK
67    lVar = associated(intPointerVar1, null(intPointerVar2)) !OK
68    lVar = associated(intPointerVar1, null()) !OK
69    lVar = associated(null(), null(intPointerVar1)) !OK
70    lVar = associated(null(intPointerVar1), null()) !OK
71    !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
72    lVar = associated(intVar)
73    !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
74    lVar = associated(intVar, intVar)
75    !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
76    lVar = associated(intAllocVar)
77    !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
78    lVar = associated(intPointerVar1, targetRealVar)
79    lVar = associated(intPointerVar1, targetIntVar1) !OK
80    !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
81    lVar = associated(intPointerVar1, targetIntVar2)
82    lVar = associated(intPointerVar1) !OK
83    lVar = associated(intPointerVar1, intPointerVar2) !OK
84    !ERROR: In assignment to object pointer 'intpointervar1', the target 'intvar' is not an object with POINTER or TARGET attributes
85    intPointerVar1 => intVar
86    !ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute
87    lVar = associated(intPointerVar1, intVar)
88
89    ! Procedure pointer tests
90    intprocPointer1 => intProc !OK
91    lVar = associated(intprocPointer1, intProc) !OK
92    intprocPointer1 => intProcPointer2 !OK
93    lVar = associated(intprocPointer1, intProcPointer2) !OK
94    intProcPointer1  => null(intProcPointer2) ! ok
95    lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
96    intProcPointer1 => null() ! ok
97    lvar = associated(intProcPointer1, null()) ! ok
98    intProcPointer1 => intProcPointer2 ! ok
99    lvar = associated(intProcPointer1, intProcPointer2) ! ok
100    intProcPointer1 => null(intProcPointer2) ! ok
101    lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
102    intProcPointer1 =>null() ! ok
103    lvar = associated(intProcPointer1, null()) ! ok
104    intPointerVar1 => null(intPointerVar1) ! ok
105    lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok
106
107    !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
108    intprocPointer1 => intVar
109    !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer
110    lVar = associated(intprocPointer1, intVar)
111    !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc'
112    intProcPointer1 => elementalProc
113    !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc'
114    lvar = associated(intProcPointer1, elementalProc)
115    !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is a procedure designator
116    lvar = associated (intPointerVar1, intFunc)
117    !ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator
118    intPointerVar1 => intFunc
119    !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
120    intProcPointer1 => targetIntVar1
121    !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer
122    lvar = associated (intProcPointer1, targetIntVar1)
123    !ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null' that is an incompatible procedure pointer
124    intProcPointer1 => null(mold=realProcPointer1)
125    !ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null()' that is an incompatible procedure pointer
126    lvar = associated(intProcPointer1, null(mold=realProcPointer1))
127    !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
128    pureFuncPointer => intProc
129    !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
130    lvar = associated(pureFuncPointer, intProc)
131    !ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
132    realProcPointer1 => intProc
133    !ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
134    lvar = associated(realProcPointer1, intProc)
135    !ERROR: Procedure pointer 'subprocpointer' with explicit interface may not be associated with procedure designator 'externalproc' with implicit interface
136    subProcPointer => externalProc
137    !ERROR: Procedure pointer 'subprocpointer' with explicit interface may not be associated with procedure designator 'externalproc' with implicit interface
138    lvar = associated(subProcPointer, externalProc)
139    !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
140    subProcPointer => intProc
141    !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
142    lvar = associated(subProcPointer, intProc)
143    !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
144    intProcPointer1 => subProc
145    !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
146    lvar = associated(intProcPointer1, subProc)
147    !ERROR: Procedure pointer 'implicitprocpointer' with implicit interface may not be associated with procedure designator 'subr' with explicit interface
148    implicitProcPointer => subr
149    !ERROR: Procedure pointer 'implicitprocpointer' with implicit interface may not be associated with procedure designator 'subr' with explicit interface
150    lvar = associated(implicitProcPointer, subr)
151  end subroutine test
152end subroutine assoc
153