1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Test 15.7 C1591 & others: contexts requiring pure subprograms
4
5module m
6
7  type :: t
8   contains
9    procedure, nopass :: tbp_pure => pure
10    procedure, nopass :: tbp_impure => impure
11  end type
12  type, extends(t) :: t2
13   contains
14    !ERROR: An overridden pure type-bound procedure binding must also be pure
15    procedure, nopass :: tbp_pure => impure ! 7.5.7.3
16  end type
17
18 contains
19
20  pure integer function pure(n)
21    integer, value :: n
22    pure = n
23  end function
24  impure integer function impure(n)
25    integer, value :: n
26    impure = n
27  end function
28
29  subroutine test
30    real :: a(pure(1)) ! ok
31    !ERROR: Invalid specification expression: reference to impure function 'impure'
32    real :: b(impure(1)) ! 10.1.11(4)
33    forall (j=1:1)
34      !ERROR: Impure procedure 'impure' may not be referenced in a FORALL
35      a(j) = impure(j) ! C1037
36    end forall
37    forall (j=1:1)
38      !ERROR: Impure procedure 'impure' may not be referenced in a FORALL
39      a(j) = pure(impure(j)) ! C1037
40    end forall
41    !ERROR: DO CONCURRENT mask expression may not reference impure procedure 'impure'
42    do concurrent (j=1:1, impure(j) /= 0) ! C1121
43      !ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
44      a(j) = impure(j) ! C1139
45    end do
46  end subroutine
47
48  subroutine test2
49    type(t) :: x
50    real :: a(x%tbp_pure(1)) ! ok
51    !ERROR: Invalid specification expression: reference to impure function 'impure'
52    real :: b(x%tbp_impure(1))
53    forall (j=1:1)
54      a(j) = x%tbp_pure(j) ! ok
55    end forall
56    forall (j=1:1)
57      !ERROR: Impure procedure 'impure' may not be referenced in a FORALL
58      a(j) = x%tbp_impure(j) ! C1037
59    end forall
60    do concurrent (j=1:1, x%tbp_pure(j) /= 0) ! ok
61      a(j) = x%tbp_pure(j) ! ok
62    end do
63    !ERROR: DO CONCURRENT mask expression may not reference impure procedure 'impure'
64    do concurrent (j=1:1, x%tbp_impure(j) /= 0) ! C1121
65      !ERROR: Call to an impure procedure component is not allowed in DO CONCURRENT
66      a(j) = x%tbp_impure(j) ! C1139
67    end do
68  end subroutine
69
70  subroutine test3
71    type :: t
72      integer :: i
73    end type
74    type(t) :: a(10), b
75    forall (i=1:10)
76      a(i) = t(pure(i))  ! OK
77    end forall
78    forall (i=1:10)
79      !ERROR: Impure procedure 'impure' may not be referenced in a FORALL
80      a(i) = t(impure(i))  ! C1037
81    end forall
82  end subroutine
83
84  subroutine test4(ch)
85    type :: t
86      real, allocatable :: x
87    end type
88    type(t) :: a(1), b(1)
89    character(*), intent(in) :: ch
90    allocate (b(1)%x)
91    ! Intrinsic functions and a couple subroutines are pure; do not emit errors
92    do concurrent (j=1:1)
93      b(j)%x = cos(1.) + len(ch)
94      call move_alloc(from=b(j)%x, to=a(j)%x)
95    end do
96  end subroutine
97
98end module
99