1341b5a0f5
Section 10.2.2.4, paragraph 3 states that a procedure pointer with an explicit interface must have the same characteristics as its target. Previously, we interpreted this as disallowing such pointers to point to procedures with implicit interfaces. But several other compilers allow this. We make an exception for the case where the explicit interface cannot be called via an implicit interface. This change makes us allow this, also Differential Revision: https://reviews.llvm.org/D119404
182 lines
9.0 KiB
Fortran
182 lines
9.0 KiB
Fortran
! RUN: %python %S/test_errors.py %s %flang_fc1
|
|
! Tests for the ASSOCIATED() and NULL() intrinsics
|
|
subroutine assoc()
|
|
|
|
abstract interface
|
|
subroutine subrInt(i)
|
|
integer :: i
|
|
end subroutine subrInt
|
|
|
|
integer function abstractIntFunc(x)
|
|
integer, intent(in) :: x
|
|
end function
|
|
end interface
|
|
|
|
type :: t1
|
|
integer :: n
|
|
end type t1
|
|
type :: t2
|
|
type(t1) :: t1arr(2)
|
|
type(t1), pointer :: t1ptr(:)
|
|
end type t2
|
|
|
|
contains
|
|
integer function intFunc(x)
|
|
integer, intent(in) :: x
|
|
intFunc = x
|
|
end function
|
|
|
|
real function realFunc(x)
|
|
real, intent(in) :: x
|
|
realFunc = x
|
|
end function
|
|
|
|
pure integer function pureFunc()
|
|
pureFunc = 343
|
|
end function pureFunc
|
|
|
|
elemental integer function elementalFunc(n)
|
|
integer, value :: n
|
|
elementalFunc = n
|
|
end function elementalFunc
|
|
|
|
subroutine subr(i)
|
|
integer :: i
|
|
end subroutine subr
|
|
|
|
subroutine subrCannotBeCalledfromImplicit(i)
|
|
integer :: i(:)
|
|
end subroutine subrCannotBeCalledfromImplicit
|
|
|
|
subroutine test()
|
|
integer :: intVar
|
|
integer, target :: targetIntVar1
|
|
integer(kind=2), target :: targetIntVar2
|
|
real, target :: targetRealVar
|
|
integer, pointer :: intPointerVar1
|
|
integer, pointer :: intPointerVar2
|
|
integer, allocatable :: intAllocVar
|
|
procedure(intFunc) :: intProc
|
|
procedure(intFunc), pointer :: intprocPointer1
|
|
procedure(intFunc), pointer :: intprocPointer2
|
|
procedure(realFunc) :: realProc
|
|
procedure(realFunc), pointer :: realprocPointer1
|
|
procedure(pureFunc), pointer :: pureFuncPointer
|
|
procedure(elementalFunc) :: elementalProc
|
|
external :: externalProc
|
|
procedure(subrInt) :: subProc
|
|
procedure(subrInt), pointer :: subProcPointer
|
|
procedure(), pointer :: implicitProcPointer
|
|
procedure(subrCannotBeCalledfromImplicit), pointer :: cannotBeCalledfromImplicitPointer
|
|
logical :: lVar
|
|
type(t1) :: t1x
|
|
type(t1), target :: t1xtarget
|
|
type(t2) :: t2x
|
|
type(t2), target :: t2xtarget
|
|
|
|
!ERROR: missing mandatory 'pointer=' argument
|
|
lVar = associated()
|
|
!ERROR: MOLD= argument to NULL() must be a pointer or allocatable
|
|
lVar = associated(null(intVar))
|
|
lVar = associated(null(intAllocVar)) !OK
|
|
lVar = associated(null()) !OK
|
|
lVar = associated(null(intPointerVar1)) !OK
|
|
lVar = associated(null(), null()) !OK
|
|
lVar = associated(intPointerVar1, null(intPointerVar2)) !OK
|
|
lVar = associated(intPointerVar1, null()) !OK
|
|
lVar = associated(null(), null(intPointerVar1)) !OK
|
|
lVar = associated(null(intPointerVar1), null()) !OK
|
|
!ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
|
|
lVar = associated(intVar)
|
|
!ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
|
|
lVar = associated(intVar, intVar)
|
|
!ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
|
|
lVar = associated(intAllocVar)
|
|
!ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
|
|
lVar = associated(intPointerVar1, targetRealVar)
|
|
lVar = associated(intPointerVar1, targetIntVar1) !OK
|
|
!ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
|
|
lVar = associated(intPointerVar1, targetIntVar2)
|
|
lVar = associated(intPointerVar1) !OK
|
|
lVar = associated(intPointerVar1, intPointerVar2) !OK
|
|
!ERROR: In assignment to object pointer 'intpointervar1', the target 'intvar' is not an object with POINTER or TARGET attributes
|
|
intPointerVar1 => intVar
|
|
!ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute
|
|
lVar = associated(intPointerVar1, intVar)
|
|
|
|
!ERROR: TARGET= argument 't1x%n' must have either the POINTER or the TARGET attribute
|
|
lVar = associated(intPointerVar1, t1x%n)
|
|
lVar = associated(intPointerVar1, t1xtarget%n) ! ok
|
|
!ERROR: TARGET= argument 't2x%t1arr(1_8)%n' must have either the POINTER or the TARGET attribute
|
|
lVar = associated(intPointerVar1, t2x%t1arr(1)%n)
|
|
lVar = associated(intPointerVar1, t2x%t1ptr(1)%n) ! ok
|
|
lVar = associated(intPointerVar1, t2xtarget%t1arr(1)%n) ! ok
|
|
lVar = associated(intPointerVar1, t2xtarget%t1ptr(1)%n) ! ok
|
|
|
|
! Procedure pointer tests
|
|
intprocPointer1 => intProc !OK
|
|
lVar = associated(intprocPointer1, intProc) !OK
|
|
intprocPointer1 => intProcPointer2 !OK
|
|
lVar = associated(intprocPointer1, intProcPointer2) !OK
|
|
intProcPointer1 => null(intProcPointer2) ! ok
|
|
lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
|
|
intProcPointer1 => null() ! ok
|
|
lvar = associated(intProcPointer1, null()) ! ok
|
|
intProcPointer1 => intProcPointer2 ! ok
|
|
lvar = associated(intProcPointer1, intProcPointer2) ! ok
|
|
intProcPointer1 => null(intProcPointer2) ! ok
|
|
lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
|
|
intProcPointer1 =>null() ! ok
|
|
lvar = associated(intProcPointer1, null()) ! ok
|
|
intPointerVar1 => null(intPointerVar1) ! ok
|
|
lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok
|
|
|
|
!ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
|
|
intprocPointer1 => intVar
|
|
!ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer
|
|
lVar = associated(intprocPointer1, intVar)
|
|
!ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc'
|
|
intProcPointer1 => elementalProc
|
|
!ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc'
|
|
lvar = associated(intProcPointer1, elementalProc)
|
|
!ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is a procedure designator
|
|
lvar = associated (intPointerVar1, intFunc)
|
|
!ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator
|
|
intPointerVar1 => intFunc
|
|
!ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
|
|
intProcPointer1 => targetIntVar1
|
|
!ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer
|
|
lvar = associated (intProcPointer1, targetIntVar1)
|
|
!ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null' that is an incompatible procedure pointer
|
|
intProcPointer1 => null(mold=realProcPointer1)
|
|
!ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null()' that is an incompatible procedure pointer
|
|
lvar = associated(intProcPointer1, null(mold=realProcPointer1))
|
|
!ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
|
|
pureFuncPointer => intProc
|
|
!ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
|
|
lvar = associated(pureFuncPointer, intProc)
|
|
!ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
|
|
realProcPointer1 => intProc
|
|
!ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
|
|
lvar = associated(realProcPointer1, intProc)
|
|
subProcPointer => externalProc ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface
|
|
lvar = associated(subProcPointer, externalProc) ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface
|
|
!ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
|
|
subProcPointer => intProc
|
|
!ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
|
|
lvar = associated(subProcPointer, intProc)
|
|
!ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
|
|
intProcPointer1 => subProc
|
|
!ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
|
|
lvar = associated(intProcPointer1, subProc)
|
|
implicitProcPointer => subr ! OK for an implicit point to point to an explicit proc
|
|
lvar = associated(implicitProcPointer, subr) ! OK
|
|
!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
|
|
lvar = associated(implicitProcPointer, subrCannotBeCalledFromImplicit)
|
|
!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
|
|
cannotBeCalledfromImplicitPointer => externalProc
|
|
!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
|
|
lvar = associated(cannotBeCalledfromImplicitPointer, externalProc)
|
|
end subroutine test
|
|
end subroutine assoc
|