1! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
2! Test WhyNotModifiable() 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  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' must be definable
37      !CHECK: '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' must be definable
42      !CHECK: 'a' is construct associated with an expression
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' must be definable
49    !CHECK: '666_4' is not a variable
50    read(internal,*) j3
51    !CHECK: error: Left-hand side of assignment is not modifiable
52    !CHECK: '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 modifiable
56    !CHECK: 'prot' is protected in this scope
57    prot = 0.
58    protptr%ptr = 0. ! ok
59    !CHECK: error: Left-hand side of assignment is not modifiable
60    !CHECK: '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' must be definable
67    !CHECK: 'ptr' is externally visible and referenced in a pure procedure
68    read(internal,*) ptr
69  end subroutine
70end module
71