257 lines
14 KiB
Fortran
257 lines
14 KiB
Fortran
|
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
|
||
|
|
! 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
|
||
|
|
|
||
|
|
function objPtrFunc(x)
|
||
|
|
integer, target :: x
|
||
|
|
integer, pointer :: objPtrFunc
|
||
|
|
objPtrFunc => x
|
||
|
|
end
|
||
|
|
|
||
|
|
!PORTABILITY: nonstandard usage: FUNCTION statement without dummy argument list
|
||
|
|
function procPtrFunc
|
||
|
|
procedure(intFunc), pointer :: procPtrFunc
|
||
|
|
procPtrFunc => intFunc
|
||
|
|
end
|
||
|
|
|
||
|
|
subroutine test(assumedRank)
|
||
|
|
real, pointer, intent(in out) :: assumedRank(..)
|
||
|
|
integer :: intVar
|
||
|
|
integer, target :: targetIntVar1
|
||
|
|
integer(kind=2), target :: targetIntVar2
|
||
|
|
real, target :: targetRealVar, targetRealMat(2,2)
|
||
|
|
real, pointer :: realScalarPtr, realVecPtr(:), realMatPtr(:,:)
|
||
|
|
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
|
||
|
|
!ERROR: 'neverdeclared' must be an abstract interface or a procedure with an explicit interface
|
||
|
|
procedure(neverDeclared), pointer :: badPointer
|
||
|
|
logical :: lVar
|
||
|
|
type(t1) :: t1x
|
||
|
|
type(t1), target :: t1xtarget
|
||
|
|
type(t2) :: t2x
|
||
|
|
type(t2), target :: t2xtarget
|
||
|
|
integer, target :: targetIntArr(2)
|
||
|
|
integer, target :: targetIntCoarray[*]
|
||
|
|
integer, pointer :: intPointerArr(:)
|
||
|
|
procedure(objPtrFunc), pointer :: objPtrFuncPointer
|
||
|
|
|
||
|
|
!ERROR: Assumed-rank array cannot be forwarded to 'target=' argument
|
||
|
|
lvar = associated(assumedRank, assumedRank)
|
||
|
|
lvar = associated(assumedRank, targetRealVar) ! ok
|
||
|
|
lvar = associated(assumedRank, targetRealMat) ! ok
|
||
|
|
lvar = associated(realScalarPtr, targetRealVar) ! ok
|
||
|
|
!ERROR: 'target=' argument has unacceptable rank 0
|
||
|
|
lvar = associated(realVecPtr, targetRealVar)
|
||
|
|
!ERROR: 'target=' argument has unacceptable rank 0
|
||
|
|
lvar = associated(realMatPtr, targetRealVar)
|
||
|
|
!ERROR: 'target=' argument has unacceptable rank 2
|
||
|
|
lvar = associated(realScalarPtr, targetRealMat)
|
||
|
|
!ERROR: 'target=' argument has unacceptable rank 2
|
||
|
|
lvar = associated(realVecPtr, targetRealMat)
|
||
|
|
lvar = associated(realMatPtr, targetRealMat) ! ok
|
||
|
|
!ERROR: missing mandatory 'pointer=' argument
|
||
|
|
lVar = associated()
|
||
|
|
!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: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument '(targetintvar1)' is not a variable
|
||
|
|
lvar = associated(intPointerVar1, (targetIntVar1))
|
||
|
|
!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
|
||
|
|
!PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a valid left-hand side of a pointer assignment statement
|
||
|
|
!BECAUSE: 'NULL()' is a null pointer
|
||
|
|
lVar = associated(null(), null()) !OK
|
||
|
|
lVar = associated(intPointerVar1, null(intPointerVar2)) !OK
|
||
|
|
lVar = associated(intPointerVar1, null()) !OK
|
||
|
|
!PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a valid left-hand side of a pointer assignment statement
|
||
|
|
!BECAUSE: 'NULL()' is a null pointer
|
||
|
|
lVar = associated(null(), null(intPointerVar1)) !OK
|
||
|
|
!PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer
|
||
|
|
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())
|
||
|
|
intPointerVar1 => null(intPointerVar1) ! ok
|
||
|
|
lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok
|
||
|
|
|
||
|
|
! Functions (other than NULL) returning pointers
|
||
|
|
lVar = associated(objPtrFunc(targetIntVar1)) ! ok
|
||
|
|
!PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer
|
||
|
|
lVar = associated(objPtrFunc(targetIntVar1), targetIntVar1) ! ok
|
||
|
|
!PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer
|
||
|
|
lVar = associated(objPtrFunc(targetIntVar1), objPtrFunc(targetIntVar1)) ! ok
|
||
|
|
lVar = associated(procPtrFunc()) ! ok
|
||
|
|
lVar = associated(procPtrFunc(), intFunc) ! ok
|
||
|
|
lVar = associated(procPtrFunc(), procPtrFunc()) ! ok
|
||
|
|
!ERROR: POINTER= argument 'objptrfunc(targetintvar1)' is an object pointer but the TARGET= argument 'intfunc' is not a variable
|
||
|
|
!PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer
|
||
|
|
lVar = associated(objPtrFunc(targetIntVar1), intFunc)
|
||
|
|
!ERROR: POINTER= argument 'objptrfunc(targetintvar1)' is an object pointer but the TARGET= argument 'procptrfunc()' is not a variable
|
||
|
|
!PORTABILITY: POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer
|
||
|
|
lVar = associated(objPtrFunc(targetIntVar1), procPtrFunc())
|
||
|
|
!ERROR: POINTER= argument 'procptrfunc()' is a procedure pointer but the TARGET= argument 'objptrfunc(targetintvar1)' is not a procedure or procedure pointer
|
||
|
|
lVar = associated(procPtrFunc(), objPtrFunc(targetIntVar1))
|
||
|
|
!ERROR: POINTER= argument 'procptrfunc()' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer
|
||
|
|
lVar = associated(procPtrFunc(), targetIntVar1)
|
||
|
|
|
||
|
|
!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': incompatible procedure attributes: Elemental
|
||
|
|
intProcPointer1 => elementalProc
|
||
|
|
!WARNING: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental
|
||
|
|
!ERROR: Non-intrinsic ELEMENTAL procedure 'elementalproc' may not be passed as an actual argument
|
||
|
|
lvar = associated(intProcPointer1, elementalProc)
|
||
|
|
!ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is not a variable
|
||
|
|
lvar = associated (intPointerVar1, intFunc)
|
||
|
|
!ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'objptrfuncpointer' is not a variable
|
||
|
|
lvar = associated (intPointerVar1, objPtrFuncPointer)
|
||
|
|
!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: function results have distinct types: INTEGER(4) vs REAL(4)
|
||
|
|
intProcPointer1 => null(mold=realProcPointer1)
|
||
|
|
!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)
|
||
|
|
lvar = associated(intProcPointer1, null(mold=realProcPointer1))
|
||
|
|
!ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
|
||
|
|
pureFuncPointer => intProc
|
||
|
|
!WARNING: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
|
||
|
|
lvar = associated(pureFuncPointer, intProc)
|
||
|
|
!ERROR: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have distinct types: REAL(4) vs INTEGER(4)
|
||
|
|
realProcPointer1 => intProc
|
||
|
|
!WARNING: Function pointer 'realprocpointer1' associated with incompatible function designator 'intproc': function results have distinct types: REAL(4) vs INTEGER(4)
|
||
|
|
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
|
||
|
|
!WARNING: 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
|
||
|
|
!WARNING: 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
|
||
|
|
!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
|
||
|
|
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
|
||
|
|
!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
|
||
|
|
lvar = associated(cannotBeCalledfromImplicitPointer, externalProc)
|
||
|
|
!ERROR: TARGET= argument 'targetintarr([INTEGER(8)::2_8,1_8])' may not have a vector subscript or coindexing
|
||
|
|
lvar = associated(intPointerArr, targetIntArr([2,1]))
|
||
|
|
!ERROR: TARGET= argument 'targetintcoarray[1_8]' may not have a vector subscript or coindexing
|
||
|
|
lvar = associated(intPointerVar1, targetIntCoarray[1])
|
||
|
|
!ERROR: 'neverdeclared' is not a procedure
|
||
|
|
!ERROR: Could not characterize intrinsic function actual argument 'badpointer'
|
||
|
|
!ERROR: 'neverdeclared' is not a procedure
|
||
|
|
!ERROR: Could not characterize intrinsic function actual argument 'badpointer'
|
||
|
|
lvar = associated(badPointer)
|
||
|
|
end subroutine test
|
||
|
|
end subroutine assoc
|