flang/test/Semantics/associated.f90

   1 ! RUN: %S/test_errors.sh %s %t %flang_fc1
   2 ! REQUIRES: shell
   3 ! Tests for the ASSOCIATED() and NULL() intrinsics
   4 subroutine assoc()
   5
   6   abstract interface
   7     subroutine subrInt(i)
   8       integer :: i
   9     end subroutine subrInt
  10
  11     integer function abstractIntFunc(x)
  12       integer, intent(in) :: x
  13     end function
  14   end interface
  15
  16   contains
  17   integer function intFunc(x)
  18     integer, intent(in) :: x
  19     intFunc = x
  20   end function
  21
  22   real function realFunc(x)
  23     real, intent(in) :: x
  24     realFunc = x
  25   end function
  26
  27   pure integer function pureFunc()
  28     pureFunc = 343
  29   end function pureFunc
  30
  31   elemental integer function elementalFunc()
  32     elementalFunc = 343
  33   end function elementalFunc
  34
  35   subroutine subr(i)
  36     integer :: i
  37   end subroutine subr
  38
  39   subroutine test()
  40     integer :: intVar
  41     integer, target :: targetIntVar1
  42     integer(kind=2), target :: targetIntVar2
  43     real, target :: targetRealVar
  44     integer, pointer :: intPointerVar1
  45     integer, pointer :: intPointerVar2
  46     integer, allocatable :: intAllocVar
  47     procedure(intFunc) :: intProc
  48     procedure(intFunc), pointer :: intprocPointer1
  49     procedure(intFunc), pointer :: intprocPointer2
  50     procedure(realFunc) :: realProc
  51     procedure(realFunc), pointer :: realprocPointer1
  52     procedure(pureFunc), pointer :: pureFuncPointer
  53     procedure(elementalFunc) :: elementalProc
  54     external :: externalProc
  55     procedure(subrInt) :: subProc
  56     procedure(subrInt), pointer :: subProcPointer
  57     procedure(), pointer :: implicitProcPointer
  58     logical :: lVar
  59
  60     !ERROR: missing mandatory 'pointer=' argument
  61     lVar = associated()
  62     !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  63     lVar = associated(null(intVar))
  64     lVar = associated(null(intAllocVar)) !OK
  65     lVar = associated(null()) !OK
  66     lVar = associated(null(intPointerVar1)) !OK
  67     lVar = associated(null(), null()) !OK
  68     lVar = associated(intPointerVar1, null(intPointerVar2)) !OK
  69     lVar = associated(intPointerVar1, null()) !OK
  70     lVar = associated(null(), null(intPointerVar1)) !OK
  71     lVar = associated(null(intPointerVar1), null()) !OK
  72     !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
  73     lVar = associated(intVar)
  74     !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
  75     lVar = associated(intVar, intVar)
  76     !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
  77     lVar = associated(intAllocVar)
  78     !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
  79     lVar = associated(intPointerVar1, targetRealVar)
  80     lVar = associated(intPointerVar1, targetIntVar1) !OK
  81     !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
  82     lVar = associated(intPointerVar1, targetIntVar2)
  83     lVar = associated(intPointerVar1) !OK
  84     lVar = associated(intPointerVar1, intPointerVar2) !OK
  85     !ERROR: In assignment to object pointer 'intpointervar1', the target 'intvar' is not an object with POINTER or TARGET attributes
  86     intPointerVar1 => intVar
  87     !ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute
  88     lVar = associated(intPointerVar1, intVar)
  89
  90     ! Procedure pointer tests
  91     intprocPointer1 => intProc !OK
  92     lVar = associated(intprocPointer1, intProc) !OK
  93     intprocPointer1 => intProcPointer2 !OK
  94     lVar = associated(intprocPointer1, intProcPointer2) !OK
  95     intProcPointer1  => null(intProcPointer2) ! ok
  96     lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
  97     intProcPointer1 => null() ! ok
  98     lvar = associated(intProcPointer1, null()) ! ok
  99     intProcPointer1 => intProcPointer2 ! ok
 100     lvar = associated(intProcPointer1, intProcPointer2) ! ok
 101     intProcPointer1 => null(intProcPointer2) ! ok
 102     lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
 103     intProcPointer1 =>null() ! ok
 104     lvar = associated(intProcPointer1, null()) ! ok
 105     intPointerVar1 => null(intPointerVar1) ! ok
 106     lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok
 107
 108     !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
 109     intprocPointer1 => intVar
 110     !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer
 111     lVar = associated(intprocPointer1, intVar)
 112     !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc'
 113     intProcPointer1 => elementalProc
 114     !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc'
 115     lvar = associated(intProcPointer1, elementalProc)
 116     !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is a procedure designator
 117     lvar = associated (intPointerVar1, intFunc)
 118     !ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator
 119     intPointerVar1 => intFunc
 120     !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
 121     intProcPointer1 => targetIntVar1
 122     !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer
 123     lvar = associated (intProcPointer1, targetIntVar1)
 124     !ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null' that is an incompatible procedure pointer
 125     intProcPointer1 => null(mold=realProcPointer1)
 126     !ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null()' that is an incompatible procedure pointer
 127     lvar = associated(intProcPointer1, null(mold=realProcPointer1))
 128     !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
 129     pureFuncPointer => intProc
 130     !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
 131     lvar = associated(pureFuncPointer, intProc)
 132     !ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
 133     realProcPointer1 => intProc
 134     !ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
 135     lvar = associated(realProcPointer1, intProc)
 136     !ERROR: Procedure pointer 'subprocpointer' with explicit interface may not be associated with procedure designator 'externalproc' with implicit interface
 137     subProcPointer => externalProc
 138     !ERROR: Procedure pointer 'subprocpointer' with explicit interface may not be associated with procedure designator 'externalproc' with implicit interface
 139     lvar = associated(subProcPointer, externalProc)
 140     !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
 141     subProcPointer => intProc
 142     !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
 143     lvar = associated(subProcPointer, intProc)
 144     !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
 145     intProcPointer1 => subProc
 146     !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
 147     lvar = associated(intProcPointer1, subProc)
 148     !ERROR: Procedure pointer 'implicitprocpointer' with implicit interface may not be associated with procedure designator 'subr' with explicit interface
 149     implicitProcPointer => subr
 150     !ERROR: Procedure pointer 'implicitprocpointer' with implicit interface may not be associated with procedure designator 'subr' with explicit interface
 151     lvar = associated(implicitProcPointer, subr)
 152   end subroutine test
 153 end subroutine assoc