flang/test/Semantics/associated.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   2 ! Tests for the ASSOCIATED() and NULL() intrinsics
   3 subroutine 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
 259 end subroutine assoc