[flang] Accept polymorphic component element in storage_size
[llvm-project.git] / flang / test / Semantics / definable01.f90
blobfff493fe7a4152fd3c52dc7157877ace57418673
1 ! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
2 ! Test WhyNotDefinable() explanations
4 module 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
15 end module
17 module 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 character(*), parameter :: internal = '0'
29 contains
30 subroutine test1(dummy)
31 real :: arr(2)
32 integer, parameter :: j3 = 666
33 type(ptype), intent(in) :: dummy
34 type(t2) :: t2var
35 associate (a => 3+4)
36 !CHECK: error: Input variable 'a' is not definable
37 !CHECK: because: 'a' is construct associated with an expression
38 read(internal,*) a
39 end associate
40 associate (a => arr([1])) ! vector subscript
41 !CHECK: error: Input variable 'a' is not definable
42 !CHECK: because: Construct association 'a' has a vector subscript
43 read(internal,*) a
44 end associate
45 associate (a => arr(2:1:-1))
46 read(internal,*) a ! ok
47 end associate
48 !CHECK: error: Input variable 'j3' is not definable
49 !CHECK: because: '666_4' is not a variable
50 read(internal,*) j3
51 !CHECK: error: Left-hand side of assignment is not definable
52 !CHECK: because: 't2var' is an entity with either an EVENT_TYPE or LOCK_TYPE
53 t2var = t2static
54 t2var%x2 = 0. ! ok
55 !CHECK: error: Left-hand side of assignment is not definable
56 !CHECK: because: 'prot' is protected in this scope
57 prot = 0.
58 protptr%ptr = 0. ! ok
59 !CHECK: error: Left-hand side of assignment is not definable
60 !CHECK: because: 'dummy' is an INTENT(IN) dummy argument
61 dummy%x = 0.
62 dummy%ptr = 0. ! ok
63 end subroutine
64 pure subroutine test2(ptr)
65 integer, pointer, intent(in) :: ptr
66 !CHECK: error: Input variable 'ptr' is not definable
67 !CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
68 read(internal,*) ptr
69 end subroutine
70 subroutine test3(objp, procp)
71 real, intent(in), pointer :: objp
72 procedure(sin), pointer, intent(in) :: procp
73 !CHECK: error: Actual argument associated with INTENT(IN OUT) dummy argument 'op=' is not definable
74 !CHECK: because: 'objp' is an INTENT(IN) dummy argument
75 call test3a(objp)
76 !CHECK: error: Actual argument associated with procedure pointer dummy argument 'pp=' may not be INTENT(IN)
77 call test3b(procp)
78 end subroutine
79 subroutine test3a(op)
80 real, intent(in out), pointer :: op
81 end subroutine
82 subroutine test3b(pp)
83 procedure(sin), pointer, intent(in out) :: pp
84 end subroutine
85 end module