flang/test/Semantics/associated.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   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   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'
 139     intProcPointer1 => elementalProc
 140     !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc'
 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
 151     intProcPointer1 => null(mold=realProcPointer1)
 152     !ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null()' that is an incompatible procedure pointer
 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     !ERROR: 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'
 159     realProcPointer1 => intProc
 160     !ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
 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     !ERROR: 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     !ERROR: 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     !ERROR: 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     !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
 179     lvar = associated(cannotBeCalledfromImplicitPointer, externalProc)
 180   end subroutine test
 181 end subroutine assoc