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