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     integer, target :: targetIntArr(2)
  77     integer, target :: targetIntCoarray[*]
  78     integer, pointer :: intPointerArr(:)
  79
  80     !ERROR: missing mandatory 'pointer=' argument
  81     lVar = associated()
  82     !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  83     lVar = associated(null(intVar))
  84     lVar = associated(null(intAllocVar)) !OK
  85     lVar = associated(null()) !OK
  86     lVar = associated(null(intPointerVar1)) !OK
  87     !PORTABILITY: POINTER= argument of ASSOCIATED() would not be a valid left-hand side of a pointer assignment statement
  88     !BECAUSE: 'NULL()' is a null pointer
  89     lVar = associated(null(), null()) !OK
  90     lVar = associated(intPointerVar1, null(intPointerVar2)) !OK
  91     lVar = associated(intPointerVar1, null()) !OK
  92     !PORTABILITY: POINTER= argument of ASSOCIATED() would not be a valid left-hand side of a pointer assignment statement
  93     !BECAUSE: 'NULL()' is a null pointer
  94     lVar = associated(null(), null(intPointerVar1)) !OK
  95     !PORTABILITY: POINTER= argument of ASSOCIATED() should be a pointer
  96     lVar = associated(null(intPointerVar1), null()) !OK
  97     !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
  98     lVar = associated(intVar)
  99     !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
 100     lVar = associated(intVar, intVar)
 101     !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
 102     lVar = associated(intAllocVar)
 103     !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
 104     lVar = associated(intPointerVar1, targetRealVar)
 105     lVar = associated(intPointerVar1, targetIntVar1) !OK
 106     !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
 107     lVar = associated(intPointerVar1, targetIntVar2)
 108     lVar = associated(intPointerVar1) !OK
 109     lVar = associated(intPointerVar1, intPointerVar2) !OK
 110     !ERROR: In assignment to object pointer 'intpointervar1', the target 'intvar' is not an object with POINTER or TARGET attributes
 111     intPointerVar1 => intVar
 112     !ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute
 113     lVar = associated(intPointerVar1, intVar)
 114
 115     !ERROR: TARGET= argument 't1x%n' must have either the POINTER or the TARGET attribute
 116     lVar = associated(intPointerVar1, t1x%n)
 117     lVar = associated(intPointerVar1, t1xtarget%n) ! ok
 118     !ERROR: TARGET= argument 't2x%t1arr(1_8)%n' must have either the POINTER or the TARGET attribute
 119     lVar = associated(intPointerVar1, t2x%t1arr(1)%n)
 120     lVar = associated(intPointerVar1, t2x%t1ptr(1)%n) ! ok
 121     lVar = associated(intPointerVar1, t2xtarget%t1arr(1)%n) ! ok
 122     lVar = associated(intPointerVar1, t2xtarget%t1ptr(1)%n) ! ok
 123
 124     ! Procedure pointer tests
 125     intprocPointer1 => intProc !OK
 126     lVar = associated(intprocPointer1, intProc) !OK
 127     intprocPointer1 => intProcPointer2 !OK
 128     lVar = associated(intprocPointer1, intProcPointer2) !OK
 129     intProcPointer1  => null(intProcPointer2) ! ok
 130     lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
 131     intProcPointer1 => null() ! ok
 132     lvar = associated(intProcPointer1, null()) ! ok
 133     intProcPointer1 => intProcPointer2 ! ok
 134     lvar = associated(intProcPointer1, intProcPointer2) ! ok
 135     intProcPointer1 => null(intProcPointer2) ! ok
 136     lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
 137     intProcPointer1 =>null() ! ok
 138     lvar = associated(intProcPointer1, null()) ! ok
 139     intPointerVar1 => null(intPointerVar1) ! ok
 140     lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok
 141
 142     !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
 143     intprocPointer1 => intVar
 144     !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer
 145     lVar = associated(intprocPointer1, intVar)
 146     !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental
 147     intProcPointer1 => elementalProc
 148     !WARNING: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental
 149     !ERROR: Non-intrinsic ELEMENTAL procedure 'elementalproc' may not be passed as an actual argument
 150     lvar = associated(intProcPointer1, elementalProc)
 151     !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is a procedure designator
 152     lvar = associated (intPointerVar1, intFunc)
 153     !ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator
 154     intPointerVar1 => intFunc
 155     !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
 156     intProcPointer1 => targetIntVar1
 157     !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer
 158     lvar = associated (intProcPointer1, targetIntVar1)
 159     !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)
 160     intProcPointer1 => null(mold=realProcPointer1)
 161     !WARNING: 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)
 162     lvar = associated(intProcPointer1, null(mold=realProcPointer1))
 163     !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
 164     pureFuncPointer => intProc
 165     !WARNING: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
 166     lvar = associated(pureFuncPointer, intProc)
 167     !ERROR: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have distinct types: REAL(4) vs INTEGER(4)
 168     realProcPointer1 => intProc
 169     !WARNING: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have distinct types: REAL(4) vs INTEGER(4)
 170     lvar = associated(realProcPointer1, intProc)
 171     subProcPointer => externalProc ! OK to associate a procedure pointer  with an explicit interface to a procedure with an implicit interface
 172     lvar = associated(subProcPointer, externalProc) ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface
 173     !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
 174     subProcPointer => intProc
 175     !WARNING: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
 176     lvar = associated(subProcPointer, intProc)
 177     !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
 178     intProcPointer1 => subProc
 179     !WARNING: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
 180     lvar = associated(intProcPointer1, subProc)
 181     implicitProcPointer => subr ! OK for an implicit point to point to an explicit proc
 182     lvar = associated(implicitProcPointer, subr) ! OK
 183     !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
 184     lvar = associated(implicitProcPointer, subrCannotBeCalledFromImplicit)
 185     !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
 186     cannotBeCalledfromImplicitPointer => externalProc
 187     !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
 188     lvar = associated(cannotBeCalledfromImplicitPointer, externalProc)
 189     !ERROR: TARGET= argument 'targetintarr([INTEGER(8)::2_8,1_8])' may not have a vector subscript or coindexing
 190     lvar = associated(intPointerArr, targetIntArr([2,1]))
 191     !ERROR: TARGET= argument 'targetintcoarray[1_8]' may not have a vector subscript or coindexing
 192     lvar = associated(intPointerVar1, targetIntCoarray[1])
 193   end subroutine test
 194 end subroutine assoc