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