1! RUN: %S/test_errors.sh %s %t %f18
2! Test 15.7 C1594 - prohibited assignments in pure subprograms
3
4module used
5  real :: useassociated
6end module
7
8module m
9  type :: t
10    sequence
11    real :: a
12  end type
13  type(t), target :: x
14  type :: hasPtr
15    real, pointer :: p
16  end type
17  type :: hasCoarray
18    real, allocatable :: co[:]
19  end type
20 contains
21  pure function test(ptr, in, hpd)
22    use used
23    type(t), pointer :: ptr, ptr2
24    type(t), target, intent(in) :: in
25    type(t), target :: y, z
26    type(hasPtr) :: hp
27    type(hasPtr), intent(in) :: hpd
28    type(hasPtr), allocatable :: alloc
29    type(hasCoarray), pointer :: hcp
30    integer :: n
31    common /block/ y
32    !ERROR: Pure subprogram 'test' may not define 'x' because it is host-associated
33    x%a = 0.
34    !ERROR: Pure subprogram 'test' may not define 'y' because it is in a COMMON block
35    y%a = 0. ! C1594(1)
36    !ERROR: Pure subprogram 'test' may not define 'useassociated' because it is USE-associated
37    useassociated = 0.  ! C1594(1)
38    !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
39    ptr%a = 0. ! C1594(1)
40    !ERROR: Pure subprogram 'test' may not define 'in' because it is an INTENT(IN) dummy argument
41    in%a = 0. ! C1594(1)
42    !ERROR: A pure subprogram may not define a coindexed object
43    hcp%co[1] = 0. ! C1594(1)
44    !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
45    ptr => z ! C1594(2)
46    !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
47    nullify(ptr) ! C1594(2), 19.6.8
48    !ERROR: A pure subprogram may not use 'ptr' as the target of pointer assignment because it is a POINTER dummy argument of a pure function
49    ptr2 => ptr ! C1594(3)
50    !ERROR: A pure subprogram may not use 'in' as the target of pointer assignment because it is an INTENT(IN) dummy argument
51    ptr2 => in ! C1594(3)
52    !ERROR: A pure subprogram may not use 'y' as the target of pointer assignment because it is in a COMMON block
53    ptr2 => y ! C1594(2)
54    !ERROR: Externally visible object 'block' may not be associated with pointer component 'p' in a pure procedure
55    n = size([hasPtr(y%a)]) ! C1594(4)
56    !ERROR: Externally visible object 'x' may not be associated with pointer component 'p' in a pure procedure
57    n = size([hasPtr(x%a)]) ! C1594(4)
58    !ERROR: Externally visible object 'ptr' may not be associated with pointer component 'p' in a pure procedure
59    n = size([hasPtr(ptr%a)]) ! C1594(4)
60    !ERROR: Externally visible object 'in' may not be associated with pointer component 'p' in a pure procedure
61    n = size([hasPtr(in%a)]) ! C1594(4)
62    !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p'
63    hp = hpd ! C1594(5)
64    !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p'
65    allocate(alloc, source=hpd)
66   contains
67    pure subroutine internal
68      type(hasPtr) :: localhp
69      !ERROR: Pure subprogram 'internal' may not define 'z' because it is host-associated
70      z%a = 0.
71      !ERROR: Externally visible object 'z' may not be associated with pointer component 'p' in a pure procedure
72      localhp = hasPtr(z%a)
73    end subroutine
74  end function
75end module
76