1! RUN: %python %S/test_errors.py %s %flang_fc1 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: Impure procedure 'impure' may not be referenced in DO CONCURRENT 43 a(j) = impure(j) ! C1139 44 end do 45 !WARNING: Impure procedure 'impure' should not be referenced in a DO CONCURRENT header 46 do concurrent (k=impure(1):1); end do 47 !WARNING: Impure procedure 'impure' should not be referenced in a DO CONCURRENT header 48 do concurrent (k=1:impure(1)); end do 49 !WARNING: Impure procedure 'impure' should not be referenced in a DO CONCURRENT header 50 do concurrent (k=1:1:impure(1)); end do 51 !WARNING: Impure procedure 'impure' should not be referenced in a FORALL header 52 forall (k=impure(1):1); end forall 53 !WARNING: Impure procedure 'impure' should not be referenced in a FORALL header 54 forall (k=1:impure(1)); end forall 55 !WARNING: Impure procedure 'impure' should not be referenced in a FORALL header 56 forall (k=1:1:impure(1)); end forall 57 do concurrent (j=1:1) 58 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT 59 do concurrent (k=impure(1):1); end do 60 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT 61 do concurrent (k=1:impure(1)); end do 62 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT 63 do concurrent (k=1:1:impure(1)); end do 64 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT 65 forall (k=impure(1):1); end forall 66 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT 67 forall (k=1:impure(1)); end forall 68 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT 69 forall (k=1:1:impure(1)); end forall 70 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT 71 forall (k=impure(1):1) a(k) = 0. 72 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT 73 forall (k=1:impure(1)) a(k) = 0. 74 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT 75 forall (k=1:1:impure(1)) a(k) = 0. 76 end do 77 forall (j=1:1) 78 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL 79 forall (k=impure(1):1); end forall 80 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL 81 forall (k=1:impure(1)); end forall 82 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL 83 forall (k=1:1:impure(1)); end forall 84 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL 85 forall (k=impure(1):1) a(j*k) = 0. 86 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL 87 forall (k=1:impure(1)) a(j*k) = 0. 88 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL 89 forall (k=1:1:impure(1)) a(j*k) = 0. 90 end forall 91 end subroutine 92 93 subroutine test2 94 type(t) :: x 95 real :: a(x%tbp_pure(1)) ! ok 96 !ERROR: Invalid specification expression: reference to impure function 'impure' 97 real :: b(x%tbp_impure(1)) 98 forall (j=1:1) 99 a(j) = x%tbp_pure(j) ! ok 100 end forall 101 forall (j=1:1) 102 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL 103 a(j) = x%tbp_impure(j) ! C1037 104 end forall 105 do concurrent (j=1:1, x%tbp_pure(j) /= 0) ! ok 106 a(j) = x%tbp_pure(j) ! ok 107 end do 108 !ERROR: DO CONCURRENT mask expression may not reference impure procedure 'impure' 109 do concurrent (j=1:1, x%tbp_impure(j) /= 0) ! C1121 110 !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT 111 a(j) = x%tbp_impure(j) ! C1139 112 end do 113 end subroutine 114 115 subroutine test3 116 type :: t 117 integer :: i 118 end type 119 type(t) :: a(10), b 120 forall (i=1:10) 121 a(i) = t(pure(i)) ! OK 122 end forall 123 forall (i=1:10) 124 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL 125 a(i) = t(impure(i)) ! C1037 126 end forall 127 end subroutine 128 129 subroutine test4(ch) 130 type :: t 131 real, allocatable :: x 132 end type 133 type(t) :: a(1), b(1) 134 character(*), intent(in) :: ch 135 allocate (b(1)%x) 136 ! Intrinsic functions and a couple subroutines are pure; do not emit errors 137 do concurrent (j=1:1) 138 b(j)%x = cos(1.) + len(ch) 139 call move_alloc(from=b(j)%x, to=a(j)%x) 140 end do 141 end subroutine 142 143end module 144