1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic 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 function objPtrFunc(x) 52 integer, target :: x 53 integer, pointer :: objPtrFunc 54 objPtrFunc => x 55 end 56 57 !PORTABILITY: nonstandard usage: FUNCTION statement without dummy argument list 58 function procPtrFunc 59 procedure(intFunc), pointer :: procPtrFunc 60 procPtrFunc => intFunc 61 end 62 63 subroutine test(assumedRank) 64 real, pointer, intent(in out) :: assumedRank(..) 65 integer :: intVar 66 integer, target :: targetIntVar1 67 integer(kind=2), target :: targetIntVar2 68 real, target :: targetRealVar, targetRealMat(2,2) 69 real, pointer :: realScalarPtr, realVecPtr(:), realMatPtr(:,:) 70 integer, pointer :: intPointerVar1 71 integer, pointer :: intPointerVar2 72 integer, allocatable :: intAllocVar 73 procedure(intFunc) :: intProc 74 procedure(intFunc), pointer :: intprocPointer1 75 procedure(intFunc), pointer :: intprocPointer2 76 procedure(realFunc) :: realProc 77 procedure(realFunc), pointer :: realprocPointer1 78 procedure(pureFunc), pointer :: pureFuncPointer 79 procedure(elementalFunc) :: elementalProc 80 external :: externalProc 81 procedure(subrInt) :: subProc 82 procedure(subrInt), pointer :: subProcPointer 83 procedure(), pointer :: implicitProcPointer 84 procedure(subrCannotBeCalledfromImplicit), pointer :: cannotBeCalledfromImplicitPointer 85 !ERROR: 'neverdeclared' must be an abstract interface or a procedure with an explicit interface 86 procedure(neverDeclared), pointer :: badPointer 87 logical :: lVar 88 type(t1) :: t1x 89 type(t1), target :: t1xtarget 90 type(t2) :: t2x 91 type(t2), target :: t2xtarget 92 integer, target :: targetIntArr(2) 93 integer, target :: targetIntCoarray[*] 94 integer, pointer :: intPointerArr(:) 95 procedure(objPtrFunc), pointer :: objPtrFuncPointer 96 97 lvar = associated(assumedRank, assumedRank) ! ok 98 !ERROR: TARGET= argument 'realscalarptr' may not be assumed-rank when POINTER= argument is not 99 lvar = associated(realScalarPtr, assumedRank) 100 !ERROR: TARGET= argument 'realvecptr' may not be assumed-rank when POINTER= argument is not 101 lvar = associated(realVecPtr, assumedRank) 102 lvar = associated(assumedRank, targetRealVar) ! ok 103 lvar = associated(assumedRank, targetRealMat) ! ok 104 lvar = associated(realScalarPtr, targetRealVar) ! ok 105 !ERROR: POINTER= argument and TARGET= argument have incompatible ranks 1 and 0 106 lvar = associated(realVecPtr, targetRealVar) 107 !ERROR: POINTER= argument and TARGET= argument have incompatible ranks 2 and 0 108 lvar = associated(realMatPtr, targetRealVar) 109 !ERROR: POINTER= argument and TARGET= argument have incompatible ranks 0 and 2 110 lvar = associated(realScalarPtr, targetRealMat) 111 !ERROR: POINTER= argument and TARGET= argument have incompatible ranks 1 and 2 112 lvar = associated(realVecPtr, targetRealMat) 113 lvar = associated(realMatPtr, targetRealMat) ! ok 114 !ERROR: missing mandatory 'pointer=' argument 115 lVar = associated() 116 !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument '(targetintvar1)' is not a procedure or procedure pointer 117 lvar = associated(intprocPointer1, (targetIntVar1)) 118 !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument '(targetintvar1)' is not a variable 119 lvar = associated(intPointerVar1, (targetIntVar1)) 120 !ERROR: MOLD= argument to NULL() must be a pointer or allocatable 121 lVar = associated(null(intVar)) 122 lVar = associated(null(intAllocVar)) !OK 123 lVar = associated(null()) !OK 124 lVar = associated(null(intPointerVar1)) !OK 125 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a valid left-hand side of a pointer assignment statement 126 !BECAUSE: 'NULL()' is a null pointer 127 lVar = associated(null(), null()) !OK 128 lVar = associated(intPointerVar1, null(intPointerVar2)) !OK 129 lVar = associated(intPointerVar1, null()) !OK 130 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a valid left-hand side of a pointer assignment statement 131 !BECAUSE: 'NULL()' is a null pointer 132 lVar = associated(null(), null(intPointerVar1)) !OK 133 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer 134 lVar = associated(null(intPointerVar1), null()) !OK 135 !ERROR: POINTER= argument of ASSOCIATED() must be a pointer 136 lVar = associated(intVar) 137 !ERROR: POINTER= argument of ASSOCIATED() must be a pointer 138 lVar = associated(intVar, intVar) 139 !ERROR: POINTER= argument of ASSOCIATED() must be a pointer 140 lVar = associated(intAllocVar) 141 !ERROR: Arguments of ASSOCIATED() must be a pointer and an optional valid target 142 lVar = associated(intPointerVar1, targetRealVar) 143 lVar = associated(intPointerVar1, targetIntVar1) !OK 144 !ERROR: Arguments of ASSOCIATED() must be a pointer and an optional valid target 145 lVar = associated(intPointerVar1, targetIntVar2) 146 lVar = associated(intPointerVar1) !OK 147 lVar = associated(intPointerVar1, intPointerVar2) !OK 148 !ERROR: In assignment to object pointer 'intpointervar1', the target 'intvar' is not an object with POINTER or TARGET attributes 149 intPointerVar1 => intVar 150 !ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute 151 lVar = associated(intPointerVar1, intVar) 152 153 !ERROR: TARGET= argument 't1x%n' must have either the POINTER or the TARGET attribute 154 lVar = associated(intPointerVar1, t1x%n) 155 lVar = associated(intPointerVar1, t1xtarget%n) ! ok 156 !ERROR: TARGET= argument 't2x%t1arr(1_8)%n' must have either the POINTER or the TARGET attribute 157 lVar = associated(intPointerVar1, t2x%t1arr(1)%n) 158 lVar = associated(intPointerVar1, t2x%t1ptr(1)%n) ! ok 159 lVar = associated(intPointerVar1, t2xtarget%t1arr(1)%n) ! ok 160 lVar = associated(intPointerVar1, t2xtarget%t1ptr(1)%n) ! ok 161 162 ! Procedure pointer tests 163 intprocPointer1 => intProc !OK 164 lVar = associated(intprocPointer1, intProc) !OK 165 intprocPointer1 => intProcPointer2 !OK 166 lVar = associated(intprocPointer1, intProcPointer2) !OK 167 intProcPointer1 => null(intProcPointer2) ! ok 168 lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok 169 intProcPointer1 => null() ! ok 170 lvar = associated(intProcPointer1, null()) ! ok 171 intProcPointer1 => intProcPointer2 ! ok 172 lvar = associated(intProcPointer1, intProcPointer2) ! ok 173 intProcPointer1 => null(intProcPointer2) ! ok 174 lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok 175 intProcPointer1 =>null() ! ok 176 lvar = associated(intProcPointer1, null()) 177 intPointerVar1 => null(intPointerVar1) ! ok 178 lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok 179 180 ! Functions (other than NULL) returning pointers 181 lVar = associated(objPtrFunc(targetIntVar1)) ! ok 182 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer 183 lVar = associated(objPtrFunc(targetIntVar1), targetIntVar1) ! ok 184 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer 185 lVar = associated(objPtrFunc(targetIntVar1), objPtrFunc(targetIntVar1)) ! ok 186 lVar = associated(procPtrFunc()) ! ok 187 lVar = associated(procPtrFunc(), intFunc) ! ok 188 lVar = associated(procPtrFunc(), procPtrFunc()) ! ok 189 !ERROR: POINTER= argument 'objptrfunc(targetintvar1)' is an object pointer but the TARGET= argument 'intfunc' is not a variable 190 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer 191 lVar = associated(objPtrFunc(targetIntVar1), intFunc) 192 !ERROR: POINTER= argument 'objptrfunc(targetintvar1)' is an object pointer but the TARGET= argument 'procptrfunc()' is not a variable 193 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer 194 lVar = associated(objPtrFunc(targetIntVar1), procPtrFunc()) 195 !ERROR: POINTER= argument 'procptrfunc()' is a procedure pointer but the TARGET= argument 'objptrfunc(targetintvar1)' is not a procedure or procedure pointer 196 lVar = associated(procPtrFunc(), objPtrFunc(targetIntVar1)) 197 !ERROR: POINTER= argument 'procptrfunc()' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer 198 lVar = associated(procPtrFunc(), targetIntVar1) 199 200 !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer 201 intprocPointer1 => intVar 202 !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer 203 lVar = associated(intprocPointer1, intVar) 204 !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental 205 intProcPointer1 => elementalProc 206 !WARNING: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental 207 !ERROR: Non-intrinsic ELEMENTAL procedure 'elementalproc' may not be passed as an actual argument 208 lvar = associated(intProcPointer1, elementalProc) 209 !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is not a variable 210 lvar = associated (intPointerVar1, intFunc) 211 !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'objptrfuncpointer' is not a variable 212 lvar = associated (intPointerVar1, objPtrFuncPointer) 213 !ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator 214 intPointerVar1 => intFunc 215 !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer 216 intProcPointer1 => targetIntVar1 217 !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer 218 lvar = associated (intProcPointer1, targetIntVar1) 219 !ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null' that is an incompatible procedure pointer: function results have distinct types: INTEGER(4) vs REAL(4) 220 intProcPointer1 => null(mold=realProcPointer1) 221 !WARNING: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null(mold=realprocpointer1)' that is an incompatible procedure pointer: function results have distinct types: INTEGER(4) vs REAL(4) 222 lvar = associated(intProcPointer1, null(mold=realProcPointer1)) 223 !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc' 224 pureFuncPointer => intProc 225 !WARNING: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc' 226 lvar = associated(pureFuncPointer, intProc) 227 !ERROR: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have distinct types: REAL(4) vs INTEGER(4) 228 realProcPointer1 => intProc 229 !WARNING: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have distinct types: REAL(4) vs INTEGER(4) 230 lvar = associated(realProcPointer1, intProc) 231 subProcPointer => externalProc ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface 232 lvar = associated(subProcPointer, externalProc) ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface 233 !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc' 234 subProcPointer => intProc 235 !WARNING: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc' 236 lvar = associated(subProcPointer, intProc) 237 !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc' 238 intProcPointer1 => subProc 239 !WARNING: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc' 240 lvar = associated(intProcPointer1, subProc) 241 implicitProcPointer => subr ! OK for an implicit point to point to an explicit proc 242 lvar = associated(implicitProcPointer, subr) ! OK 243 !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 244 lvar = associated(implicitProcPointer, subrCannotBeCalledFromImplicit) 245 !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 246 cannotBeCalledfromImplicitPointer => externalProc 247 !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 248 lvar = associated(cannotBeCalledfromImplicitPointer, externalProc) 249 !ERROR: TARGET= argument 'targetintarr([INTEGER(8)::2_8,1_8])' may not have a vector subscript or coindexing 250 lvar = associated(intPointerArr, targetIntArr([2,1])) 251 !ERROR: TARGET= argument 'targetintcoarray[1_8]' may not have a vector subscript or coindexing 252 lvar = associated(intPointerVar1, targetIntCoarray[1]) 253 !ERROR: 'neverdeclared' is not a procedure 254 !ERROR: Could not characterize intrinsic function actual argument 'badpointer' 255 !ERROR: 'neverdeclared' is not a procedure 256 !ERROR: Could not characterize intrinsic function actual argument 'badpointer' 257 lvar = associated(badPointer) 258 end subroutine test 259end subroutine assoc 260