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