mirror of
https://github.com/llvm/llvm-project.git
synced 2025-04-17 03:56:42 +00:00
8b7a90b84b
…TENT A dummy procedure pointer with no INTENT attribute may associate with an actual argument that is the result of a reference to a function that returns a procedure pointer, we think. Fixes https://github.com/llvm/llvm-project/issues/126950.
139 lines
4.3 KiB
Fortran
139 lines
4.3 KiB
Fortran
! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
|
|
! Test WhyNotDefinable() explanations
|
|
|
|
module prot
|
|
real, protected :: prot
|
|
type :: ptype
|
|
real, pointer :: ptr
|
|
real :: x
|
|
end type
|
|
type(ptype), protected :: protptr
|
|
contains
|
|
subroutine ok
|
|
prot = 0. ! ok
|
|
end subroutine
|
|
end module
|
|
|
|
module m
|
|
use iso_fortran_env
|
|
use prot
|
|
type :: t1
|
|
type(lock_type) :: lock
|
|
end type
|
|
type :: t2
|
|
type(t1) :: x1
|
|
real :: x2
|
|
end type
|
|
type(t2) :: t2static
|
|
type list
|
|
real a
|
|
type(list), pointer :: prev, next
|
|
end type
|
|
character(*), parameter :: internal = '0'
|
|
contains
|
|
subroutine test1(dummy)
|
|
real :: arr(2)
|
|
integer, parameter :: j3 = 666
|
|
type(ptype), intent(in) :: dummy
|
|
type(t2) :: t2var
|
|
associate (a => 3+4)
|
|
!CHECK: error: Input variable 'a' is not definable
|
|
!CHECK: because: 'a' is construct associated with an expression
|
|
read(internal,*) a
|
|
end associate
|
|
associate (a => arr([1])) ! vector subscript
|
|
!CHECK: error: Input variable 'a' is not definable
|
|
!CHECK: because: Construct association 'a' has a vector subscript
|
|
read(internal,*) a
|
|
end associate
|
|
associate (a => arr(2:1:-1))
|
|
read(internal,*) a ! ok
|
|
end associate
|
|
!CHECK: error: Input variable 'j3' is not definable
|
|
!CHECK: because: '666_4' is not a variable
|
|
read(internal,*) j3
|
|
!CHECK: error: Left-hand side of assignment is not definable
|
|
!CHECK: because: 't2var' is an entity with either an EVENT_TYPE or LOCK_TYPE
|
|
t2var = t2static
|
|
t2var%x2 = 0. ! ok
|
|
!CHECK: error: Left-hand side of assignment is not definable
|
|
!CHECK: because: 'prot' is protected in this scope
|
|
prot = 0.
|
|
protptr%ptr = 0. ! ok
|
|
!CHECK: error: Left-hand side of assignment is not definable
|
|
!CHECK: because: 'dummy' is an INTENT(IN) dummy argument
|
|
dummy%x = 0.
|
|
dummy%ptr = 0. ! ok
|
|
end subroutine
|
|
pure subroutine test2(ptr)
|
|
integer, pointer, intent(in) :: ptr
|
|
!CHECK: error: Input variable 'ptr' is not definable
|
|
!CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
|
|
read(internal,*) ptr
|
|
end subroutine
|
|
subroutine test3(objp, procp)
|
|
real, intent(in), pointer :: objp
|
|
procedure(sin), pointer, intent(in) :: procp
|
|
!CHECK: error: Actual argument associated with INTENT(IN OUT) dummy argument 'op=' is not definable
|
|
!CHECK: because: 'objp' is an INTENT(IN) dummy argument
|
|
call test3a(objp)
|
|
!CHECK: error: Actual argument associated with INTENT(IN OUT) procedure pointer dummy argument 'pp=' is not definable
|
|
!CHECK: because: 'procp' is an INTENT(IN) dummy argument
|
|
call test3b(procp)
|
|
end subroutine
|
|
subroutine test3a(op)
|
|
real, intent(in out), pointer :: op
|
|
end subroutine
|
|
subroutine test3b(pp)
|
|
procedure(sin), pointer, intent(in out) :: pp
|
|
end subroutine
|
|
subroutine test4(p)
|
|
type(ptype), pointer, intent(in) :: p
|
|
p%x = 1.
|
|
p%ptr = 1. ! ok
|
|
nullify(p%ptr) ! ok
|
|
!CHECK: error: 'p' may not appear in NULLIFY
|
|
!CHECK: because: 'p' is an INTENT(IN) dummy argument
|
|
nullify(p)
|
|
end
|
|
subroutine test5(np)
|
|
type(ptype), intent(in) :: np
|
|
!CHECK: error: 'ptr' may not appear in NULLIFY
|
|
!CHECK: because: 'np' is an INTENT(IN) dummy argument
|
|
nullify(np%ptr)
|
|
end
|
|
pure function test6(lp)
|
|
type(list), pointer :: lp
|
|
!CHECK: error: The left-hand side of a pointer assignment is not definable
|
|
!CHECK: because: 'lp' may not be defined in pure subprogram 'test6' because it is a POINTER dummy argument of a pure function
|
|
lp%next%next => null()
|
|
end
|
|
pure subroutine test7(lp)
|
|
type(list), pointer :: lp
|
|
lp%next%next => null() ! ok
|
|
end
|
|
end module
|
|
program main
|
|
use iso_fortran_env, only: lock_type
|
|
type(lock_type) lock
|
|
interface
|
|
subroutine inlock(lock)
|
|
import lock_type
|
|
type(lock_type), intent(in) :: lock
|
|
end
|
|
subroutine outlock(lock)
|
|
import lock_type
|
|
!CHECK: error: An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE
|
|
type(lock_type), intent(out) :: lock
|
|
end
|
|
subroutine inoutlock(lock)
|
|
import lock_type
|
|
type(lock_type), intent(in out) :: lock
|
|
end
|
|
end interface
|
|
call inlock(lock) ! ok
|
|
call inoutlock(lock) ! ok
|
|
!CHECK: error: Actual argument associated with INTENT(OUT) dummy argument 'lock=' is not definable
|
|
call outlock(lock)
|
|
end
|