259 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! Tests for the ASSOCIATED() and NULL() intrinsics3subroutine assoc()4 5 abstract interface6 subroutine subrInt(i)7 integer :: i8 end subroutine subrInt9 10 integer function abstractIntFunc(x)11 integer, intent(in) :: x12 end function13 end interface14 15 type :: t116 integer :: n17 end type t118 type :: t219 type(t1) :: t1arr(2)20 type(t1), pointer :: t1ptr(:)21 end type t222 23 contains24 integer function intFunc(x)25 integer, intent(in) :: x26 intFunc = x27 end function28 29 real function realFunc(x)30 real, intent(in) :: x31 realFunc = x32 end function33 34 pure integer function pureFunc()35 pureFunc = 34336 end function pureFunc37 38 elemental integer function elementalFunc(n)39 integer, value :: n40 elementalFunc = n41 end function elementalFunc42 43 subroutine subr(i)44 integer :: i45 end subroutine subr46 47 subroutine subrCannotBeCalledfromImplicit(i)48 integer :: i(:)49 end subroutine subrCannotBeCalledfromImplicit50 51 function objPtrFunc(x)52 integer, target :: x53 integer, pointer :: objPtrFunc54 objPtrFunc => x55 end56 57 !PORTABILITY: nonstandard usage: FUNCTION statement without dummy argument list58 function procPtrFunc59 procedure(intFunc), pointer :: procPtrFunc60 procPtrFunc => intFunc61 end62 63 subroutine test(assumedRank)64 real, pointer, intent(in out) :: assumedRank(..)65 integer :: intVar66 integer, target :: targetIntVar167 integer(kind=2), target :: targetIntVar268 real, target :: targetRealVar, targetRealMat(2,2)69 real, pointer :: realScalarPtr, realVecPtr(:), realMatPtr(:,:)70 integer, pointer :: intPointerVar171 integer, pointer :: intPointerVar272 integer, allocatable :: intAllocVar73 procedure(intFunc) :: intProc74 procedure(intFunc), pointer :: intprocPointer175 procedure(intFunc), pointer :: intprocPointer276 procedure(realFunc) :: realProc77 procedure(realFunc), pointer :: realprocPointer178 procedure(pureFunc), pointer :: pureFuncPointer79 procedure(elementalFunc) :: elementalProc80 external :: externalProc81 procedure(subrInt) :: subProc82 procedure(subrInt), pointer :: subProcPointer83 procedure(), pointer :: implicitProcPointer84 procedure(subrCannotBeCalledfromImplicit), pointer :: cannotBeCalledfromImplicitPointer85 !ERROR: 'neverdeclared' must be an abstract interface or a procedure with an explicit interface86 procedure(neverDeclared), pointer :: badPointer87 logical :: lVar88 type(t1) :: t1x89 type(t1), target :: t1xtarget90 type(t2) :: t2x91 type(t2), target :: t2xtarget92 integer, target :: targetIntArr(2)93 integer, target, save :: targetIntCoarray[*]94 integer, pointer :: intPointerArr(:)95 procedure(objPtrFunc), pointer :: objPtrFuncPointer96 97 lvar = associated(assumedRank, assumedRank) ! ok98 !ERROR: TARGET= argument 'realscalarptr' may not be assumed-rank when POINTER= argument is not99 lvar = associated(realScalarPtr, assumedRank)100 !ERROR: TARGET= argument 'realvecptr' may not be assumed-rank when POINTER= argument is not101 lvar = associated(realVecPtr, assumedRank)102 lvar = associated(assumedRank, targetRealVar) ! ok103 lvar = associated(assumedRank, targetRealMat) ! ok104 lvar = associated(realScalarPtr, targetRealVar) ! ok105 !ERROR: POINTER= argument and TARGET= argument have incompatible ranks 1 and 0106 lvar = associated(realVecPtr, targetRealVar)107 !ERROR: POINTER= argument and TARGET= argument have incompatible ranks 2 and 0108 lvar = associated(realMatPtr, targetRealVar)109 !ERROR: POINTER= argument and TARGET= argument have incompatible ranks 0 and 2110 lvar = associated(realScalarPtr, targetRealMat)111 !ERROR: POINTER= argument and TARGET= argument have incompatible ranks 1 and 2112 lvar = associated(realVecPtr, targetRealMat)113 lvar = associated(realMatPtr, targetRealMat) ! ok114 !ERROR: missing mandatory 'pointer=' argument115 lVar = associated()116 !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument '(targetintvar1)' is not a procedure or procedure pointer117 lvar = associated(intprocPointer1, (targetIntVar1))118 !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument '(targetintvar1)' is not a variable119 lvar = associated(intPointerVar1, (targetIntVar1))120 !ERROR: MOLD= argument to NULL() must be a pointer or allocatable121 lVar = associated(null(intVar))122 !ERROR: A NULL() allocatable is not allowed for 'pointer=' intrinsic argument123 lVar = associated(null(intAllocVar))124 lVar = associated(null()) !OK125 lVar = associated(null(intPointerVar1)) !OK126 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a valid left-hand side of a pointer assignment statement [-Wportability]127 !BECAUSE: 'NULL()' is a null pointer128 lVar = associated(null(), null()) !OK129 lVar = associated(intPointerVar1, null(intPointerVar2)) !OK130 lVar = associated(intPointerVar1, null()) !OK131 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a valid left-hand side of a pointer assignment statement [-Wportability]132 !BECAUSE: 'NULL()' is a null pointer133 lVar = associated(null(), null(intPointerVar1)) !OK134 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer [-Wportability]135 lVar = associated(null(intPointerVar1), null()) !OK136 !ERROR: POINTER= argument of ASSOCIATED() must be a pointer137 lVar = associated(intVar)138 !ERROR: POINTER= argument of ASSOCIATED() must be a pointer139 lVar = associated(intVar, intVar)140 !ERROR: POINTER= argument of ASSOCIATED() must be a pointer141 lVar = associated(intAllocVar)142 !ERROR: Arguments of ASSOCIATED() must be a pointer and an optional valid target143 lVar = associated(intPointerVar1, targetRealVar)144 lVar = associated(intPointerVar1, targetIntVar1) !OK145 !ERROR: Arguments of ASSOCIATED() must be a pointer and an optional valid target146 lVar = associated(intPointerVar1, targetIntVar2)147 lVar = associated(intPointerVar1) !OK148 lVar = associated(intPointerVar1, intPointerVar2) !OK149 !ERROR: In assignment to object pointer 'intpointervar1', the target 'intvar' is not an object with POINTER or TARGET attributes150 intPointerVar1 => intVar151 !ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute152 lVar = associated(intPointerVar1, intVar)153 154 !ERROR: TARGET= argument 't1x%n' must have either the POINTER or the TARGET attribute155 lVar = associated(intPointerVar1, t1x%n)156 lVar = associated(intPointerVar1, t1xtarget%n) ! ok157 !ERROR: TARGET= argument 't2x%t1arr(1_8)%n' must have either the POINTER or the TARGET attribute158 lVar = associated(intPointerVar1, t2x%t1arr(1)%n)159 lVar = associated(intPointerVar1, t2x%t1ptr(1)%n) ! ok160 lVar = associated(intPointerVar1, t2xtarget%t1arr(1)%n) ! ok161 lVar = associated(intPointerVar1, t2xtarget%t1ptr(1)%n) ! ok162 163 ! Procedure pointer tests164 intprocPointer1 => intProc !OK165 lVar = associated(intprocPointer1, intProc) !OK166 intprocPointer1 => intProcPointer2 !OK167 lVar = associated(intprocPointer1, intProcPointer2) !OK168 intProcPointer1 => null(intProcPointer2) ! ok169 lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok170 intProcPointer1 => null() ! ok171 lvar = associated(intProcPointer1, null()) ! ok172 intProcPointer1 => intProcPointer2 ! ok173 lvar = associated(intProcPointer1, intProcPointer2) ! ok174 intProcPointer1 => null(intProcPointer2) ! ok175 lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok176 intProcPointer1 =>null() ! ok177 lvar = associated(intProcPointer1, null())178 intPointerVar1 => null(intPointerVar1) ! ok179 lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok180 181 ! Functions (other than NULL) returning pointers182 lVar = associated(objPtrFunc(targetIntVar1)) ! ok183 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer [-Wportability]184 lVar = associated(objPtrFunc(targetIntVar1), targetIntVar1) ! ok185 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer [-Wportability]186 lVar = associated(objPtrFunc(targetIntVar1), objPtrFunc(targetIntVar1)) ! ok187 lVar = associated(procPtrFunc()) ! ok188 lVar = associated(procPtrFunc(), intFunc) ! ok189 lVar = associated(procPtrFunc(), procPtrFunc()) ! ok190 !ERROR: POINTER= argument 'objptrfunc(targetintvar1)' is an object pointer but the TARGET= argument 'intfunc' is not a variable191 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer [-Wportability]192 lVar = associated(objPtrFunc(targetIntVar1), intFunc)193 !ERROR: POINTER= argument 'objptrfunc(targetintvar1)' is an object pointer but the TARGET= argument 'procptrfunc()' is not a variable194 !PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer [-Wportability]195 lVar = associated(objPtrFunc(targetIntVar1), procPtrFunc())196 !ERROR: POINTER= argument 'procptrfunc()' is a procedure pointer but the TARGET= argument 'objptrfunc(targetintvar1)' is not a procedure or procedure pointer197 lVar = associated(procPtrFunc(), objPtrFunc(targetIntVar1))198 !ERROR: POINTER= argument 'procptrfunc()' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer199 lVar = associated(procPtrFunc(), targetIntVar1)200 201 !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer202 intprocPointer1 => intVar203 !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer204 lVar = associated(intprocPointer1, intVar)205 !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental206 intProcPointer1 => elementalProc207 !WARNING: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental208 !ERROR: Non-intrinsic ELEMENTAL procedure 'elementalproc' may not be passed as an actual argument209 lvar = associated(intProcPointer1, elementalProc)210 !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is not a variable211 lvar = associated (intPointerVar1, intFunc)212 !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'objptrfuncpointer' is not a variable213 lvar = associated (intPointerVar1, objPtrFuncPointer)214 !ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator215 intPointerVar1 => intFunc216 !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer217 intProcPointer1 => targetIntVar1218 !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer219 lvar = associated (intProcPointer1, targetIntVar1)220 !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)221 intProcPointer1 => null(mold=realProcPointer1)222 !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)223 lvar = associated(intProcPointer1, null(mold=realProcPointer1))224 !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'225 pureFuncPointer => intProc226 !WARNING: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'227 lvar = associated(pureFuncPointer, intProc)228 !ERROR: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have distinct types: REAL(4) vs INTEGER(4)229 realProcPointer1 => intProc230 !WARNING: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have distinct types: REAL(4) vs INTEGER(4)231 lvar = associated(realProcPointer1, intProc)232 subProcPointer => externalProc ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface233 lvar = associated(subProcPointer, externalProc) ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface234 !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'235 subProcPointer => intProc236 !WARNING: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'237 lvar = associated(subProcPointer, intProc)238 !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'239 intProcPointer1 => subProc240 !WARNING: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'241 lvar = associated(intProcPointer1, subProc)242 implicitProcPointer => subr ! OK for an implicit point to point to an explicit proc243 lvar = associated(implicitProcPointer, subr) ! OK244 !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 interface245 lvar = associated(implicitProcPointer, subrCannotBeCalledFromImplicit)246 !ERROR: Procedure pointer 'cannotbecalledfromimplicitpointer' with explicit interface that cannot be called via an implicit interface cannot be associated with procedure designator with an implicit interface247 cannotBeCalledfromImplicitPointer => externalProc248 !WARNING: Procedure pointer 'cannotbecalledfromimplicitpointer' with explicit interface that cannot be called via an implicit interface cannot be associated with procedure designator with an implicit interface249 lvar = associated(cannotBeCalledfromImplicitPointer, externalProc)250 !ERROR: TARGET= argument 'targetintarr([INTEGER(8)::2_8,1_8])' may not have a vector subscript or coindexing251 lvar = associated(intPointerArr, targetIntArr([2,1]))252 !ERROR: TARGET= argument 'targetintcoarray[1_8]' may not have a vector subscript or coindexing253 lvar = associated(intPointerVar1, targetIntCoarray[1])254 !ERROR: 'neverdeclared' is not a procedure255 !ERROR: Could not characterize intrinsic function actual argument 'badpointer'256 lvar = associated(badPointer)257 end subroutine test258end subroutine assoc259