1! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s 2! Test WhyNotDefinable() explanations 3 4module prot 5 real, protected :: prot 6 type :: ptype 7 real, pointer :: ptr 8 real :: x 9 end type 10 type(ptype), protected :: protptr 11 contains 12 subroutine ok 13 prot = 0. ! ok 14 end subroutine 15end module 16 17module m 18 use iso_fortran_env 19 use prot 20 type :: t1 21 type(lock_type) :: lock 22 end type 23 type :: t2 24 type(t1) :: x1 25 real :: x2 26 end type 27 type(t2) :: t2static 28 type list 29 real a 30 type(list), pointer :: prev, next 31 end type 32 character(*), parameter :: internal = '0' 33 contains 34 subroutine test1(dummy) 35 real :: arr(2) 36 integer, parameter :: j3 = 666 37 type(ptype), intent(in) :: dummy 38 type(t2) :: t2var 39 associate (a => 3+4) 40 !CHECK: error: Input variable 'a' is not definable 41 !CHECK: because: 'a' is construct associated with an expression 42 read(internal,*) a 43 end associate 44 associate (a => arr([1])) ! vector subscript 45 !CHECK: error: Input variable 'a' is not definable 46 !CHECK: because: Construct association 'a' has a vector subscript 47 read(internal,*) a 48 end associate 49 associate (a => arr(2:1:-1)) 50 read(internal,*) a ! ok 51 end associate 52 !CHECK: error: Input variable 'j3' is not definable 53 !CHECK: because: '666_4' is not a variable 54 read(internal,*) j3 55 !CHECK: error: Left-hand side of assignment is not definable 56 !CHECK: because: 't2var' is an entity with either an EVENT_TYPE or LOCK_TYPE 57 t2var = t2static 58 t2var%x2 = 0. ! ok 59 !CHECK: error: Left-hand side of assignment is not definable 60 !CHECK: because: 'prot' is protected in this scope 61 prot = 0. 62 protptr%ptr = 0. ! ok 63 !CHECK: error: Left-hand side of assignment is not definable 64 !CHECK: because: 'dummy' is an INTENT(IN) dummy argument 65 dummy%x = 0. 66 dummy%ptr = 0. ! ok 67 end subroutine 68 pure subroutine test2(ptr) 69 integer, pointer, intent(in) :: ptr 70 !CHECK: error: Input variable 'ptr' is not definable 71 !CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram 72 read(internal,*) ptr 73 end subroutine 74 subroutine test3(objp, procp) 75 real, intent(in), pointer :: objp 76 procedure(sin), pointer, intent(in) :: procp 77 !CHECK: error: Actual argument associated with INTENT(IN OUT) dummy argument 'op=' is not definable 78 !CHECK: because: 'objp' is an INTENT(IN) dummy argument 79 call test3a(objp) 80 !CHECK: error: Actual argument associated with procedure pointer dummy argument 'pp=' may not be INTENT(IN) 81 call test3b(procp) 82 end subroutine 83 subroutine test3a(op) 84 real, intent(in out), pointer :: op 85 end subroutine 86 subroutine test3b(pp) 87 procedure(sin), pointer, intent(in out) :: pp 88 end subroutine 89 subroutine test4(p) 90 type(ptype), pointer, intent(in) :: p 91 p%x = 1. 92 p%ptr = 1. ! ok 93 nullify(p%ptr) ! ok 94 !CHECK: error: 'p' may not appear in NULLIFY 95 !CHECK: because: 'p' is an INTENT(IN) dummy argument 96 nullify(p) 97 end 98 subroutine test5(np) 99 type(ptype), intent(in) :: np 100 !CHECK: error: 'ptr' may not appear in NULLIFY 101 !CHECK: because: 'np' is an INTENT(IN) dummy argument 102 nullify(np%ptr) 103 end 104 pure function test6(lp) 105 type(list), pointer :: lp 106 !CHECK: error: The left-hand side of a pointer assignment is not definable 107 !CHECK: because: 'lp' may not be defined in pure subprogram 'test6' because it is a POINTER dummy argument of a pure function 108 lp%next%next => null() 109 end 110 pure subroutine test7(lp) 111 type(list), pointer :: lp 112 lp%next%next => null() ! ok 113 end 114end module 115program main 116 use iso_fortran_env, only: lock_type 117 type(lock_type) lock 118 interface 119 subroutine inlock(lock) 120 import lock_type 121 type(lock_type), intent(in) :: lock 122 end 123 subroutine outlock(lock) 124 import lock_type 125 !CHECK: error: An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE 126 type(lock_type), intent(out) :: lock 127 end 128 subroutine inoutlock(lock) 129 import lock_type 130 type(lock_type), intent(in out) :: lock 131 end 132 end interface 133 call inlock(lock) ! ok 134 call inoutlock(lock) ! ok 135 !CHECK: error: Actual argument associated with INTENT(OUT) dummy argument 'lock=' is not definable 136 call outlock(lock) 137end 138