1! RUN: %python %S/test_errors.py %s %flang_fc1
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  type :: t1
16    integer :: n
17  end type t1
18  type :: t2
19    type(t1) :: t1arr(2)
20    type(t1), pointer :: t1ptr(:)
21  end type t2
22
23  contains
24  integer function intFunc(x)
25    integer, intent(in) :: x
26    intFunc = x
27  end function
28
29  real function realFunc(x)
30    real, intent(in) :: x
31    realFunc = x
32  end function
33
34  pure integer function pureFunc()
35    pureFunc = 343
36  end function pureFunc
37
38  elemental integer function elementalFunc(n)
39    integer, value :: n
40    elementalFunc = n
41  end function elementalFunc
42
43  subroutine subr(i)
44    integer :: i
45  end subroutine subr
46
47  subroutine subrCannotBeCalledfromImplicit(i)
48    integer :: i(:)
49  end subroutine subrCannotBeCalledfromImplicit
50
51  subroutine test()
52    integer :: intVar
53    integer, target :: targetIntVar1
54    integer(kind=2), target :: targetIntVar2
55    real, target :: targetRealVar
56    integer, pointer :: intPointerVar1
57    integer, pointer :: intPointerVar2
58    integer, allocatable :: intAllocVar
59    procedure(intFunc) :: intProc
60    procedure(intFunc), pointer :: intprocPointer1
61    procedure(intFunc), pointer :: intprocPointer2
62    procedure(realFunc) :: realProc
63    procedure(realFunc), pointer :: realprocPointer1
64    procedure(pureFunc), pointer :: pureFuncPointer
65    procedure(elementalFunc) :: elementalProc
66    external :: externalProc
67    procedure(subrInt) :: subProc
68    procedure(subrInt), pointer :: subProcPointer
69    procedure(), pointer :: implicitProcPointer
70    procedure(subrCannotBeCalledfromImplicit), pointer :: cannotBeCalledfromImplicitPointer
71    logical :: lVar
72    type(t1) :: t1x
73    type(t1), target :: t1xtarget
74    type(t2) :: t2x
75    type(t2), target :: t2xtarget
76
77    !ERROR: missing mandatory 'pointer=' argument
78    lVar = associated()
79    !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
80    lVar = associated(null(intVar))
81    lVar = associated(null(intAllocVar)) !OK
82    lVar = associated(null()) !OK
83    lVar = associated(null(intPointerVar1)) !OK
84    lVar = associated(null(), null()) !OK
85    lVar = associated(intPointerVar1, null(intPointerVar2)) !OK
86    lVar = associated(intPointerVar1, null()) !OK
87    lVar = associated(null(), null(intPointerVar1)) !OK
88    lVar = associated(null(intPointerVar1), null()) !OK
89    !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
90    lVar = associated(intVar)
91    !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
92    lVar = associated(intVar, intVar)
93    !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
94    lVar = associated(intAllocVar)
95    !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
96    lVar = associated(intPointerVar1, targetRealVar)
97    lVar = associated(intPointerVar1, targetIntVar1) !OK
98    !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
99    lVar = associated(intPointerVar1, targetIntVar2)
100    lVar = associated(intPointerVar1) !OK
101    lVar = associated(intPointerVar1, intPointerVar2) !OK
102    !ERROR: In assignment to object pointer 'intpointervar1', the target 'intvar' is not an object with POINTER or TARGET attributes
103    intPointerVar1 => intVar
104    !ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute
105    lVar = associated(intPointerVar1, intVar)
106
107    !ERROR: TARGET= argument 't1x%n' must have either the POINTER or the TARGET attribute
108    lVar = associated(intPointerVar1, t1x%n)
109    lVar = associated(intPointerVar1, t1xtarget%n) ! ok
110    !ERROR: TARGET= argument 't2x%t1arr(1_8)%n' must have either the POINTER or the TARGET attribute
111    lVar = associated(intPointerVar1, t2x%t1arr(1)%n)
112    lVar = associated(intPointerVar1, t2x%t1ptr(1)%n) ! ok
113    lVar = associated(intPointerVar1, t2xtarget%t1arr(1)%n) ! ok
114    lVar = associated(intPointerVar1, t2xtarget%t1ptr(1)%n) ! ok
115
116    ! Procedure pointer tests
117    intprocPointer1 => intProc !OK
118    lVar = associated(intprocPointer1, intProc) !OK
119    intprocPointer1 => intProcPointer2 !OK
120    lVar = associated(intprocPointer1, intProcPointer2) !OK
121    intProcPointer1  => null(intProcPointer2) ! ok
122    lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
123    intProcPointer1 => null() ! ok
124    lvar = associated(intProcPointer1, null()) ! ok
125    intProcPointer1 => intProcPointer2 ! ok
126    lvar = associated(intProcPointer1, intProcPointer2) ! ok
127    intProcPointer1 => null(intProcPointer2) ! ok
128    lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
129    intProcPointer1 =>null() ! ok
130    lvar = associated(intProcPointer1, null()) ! ok
131    intPointerVar1 => null(intPointerVar1) ! ok
132    lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok
133
134    !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
135    intprocPointer1 => intVar
136    !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer
137    lVar = associated(intprocPointer1, intVar)
138    !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental
139    intProcPointer1 => elementalProc
140    !WARNING: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible dummy argument #1: incompatible dummy data object attributes
141    lvar = associated(intProcPointer1, elementalProc)
142    !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is a procedure designator
143    lvar = associated (intPointerVar1, intFunc)
144    !ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator
145    intPointerVar1 => intFunc
146    !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
147    intProcPointer1 => targetIntVar1
148    !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer
149    lvar = associated (intProcPointer1, targetIntVar1)
150    !ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null' that is an incompatible procedure pointer: function results have incompatible types: INTEGER(4) vs REAL(4)
151    intProcPointer1 => null(mold=realProcPointer1)
152    !WARNING: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null()' that is an incompatible procedure pointer: function results have incompatible types: INTEGER(4) vs REAL(4)
153    lvar = associated(intProcPointer1, null(mold=realProcPointer1))
154    !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
155    pureFuncPointer => intProc
156    !WARNING: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
157    lvar = associated(pureFuncPointer, intProc)
158    !ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc': function results have incompatible types: REAL(4) vs INTEGER(4)
159    realProcPointer1 => intProc
160    !WARNING: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc': function results have incompatible types: REAL(4) vs INTEGER(4)
161    lvar = associated(realProcPointer1, intProc)
162    subProcPointer => externalProc ! OK to associate a procedure pointer  with an explicit interface to a procedure with an implicit interface
163    lvar = associated(subProcPointer, externalProc) ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface
164    !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
165    subProcPointer => intProc
166    !WARNING: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
167    lvar = associated(subProcPointer, intProc)
168    !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
169    intProcPointer1 => subProc
170    !WARNING: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
171    lvar = associated(intProcPointer1, subProc)
172    implicitProcPointer => subr ! OK for an implicit point to point to an explicit proc
173    lvar = associated(implicitProcPointer, subr) ! OK
174    !WARNING: 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
175    lvar = associated(implicitProcPointer, subrCannotBeCalledFromImplicit)
176    !ERROR: Procedure pointer 'cannotbecalledfromimplicitpointer' with explicit interface that cannot be called via an implicit interface cannot be associated with procedure designator with an implicit interface
177    cannotBeCalledfromImplicitPointer => externalProc
178    !WARNING: Procedure pointer 'cannotbecalledfromimplicitpointer' with explicit interface that cannot be called via an implicit interface cannot be associated with procedure designator with an implicit interface
179    lvar = associated(cannotBeCalledfromImplicitPointer, externalProc)
180  end subroutine test
181end subroutine assoc
182