144 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Test 15.7 C1591 & others: contexts requiring pure subprograms3 4module m5 6 type :: t7 contains8 procedure, nopass :: tbp_pure => pure9 procedure, nopass :: tbp_impure => impure10 end type11 type, extends(t) :: t212 contains13 !ERROR: An overridden pure type-bound procedure binding must also be pure14 procedure, nopass :: tbp_pure => impure ! 7.5.7.315 end type16 17 contains18 19 pure integer function pure(n)20 integer, value :: n21 pure = n22 end function23 impure integer function impure(n)24 integer, value :: n25 impure = n26 end function27 28 subroutine test29 real :: a(pure(1)) ! ok30 !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 FORALL34 a(j) = impure(j) ! C103735 end forall36 forall (j=1:1)37 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL38 a(j) = pure(impure(j)) ! C103739 end forall40 !ERROR: DO CONCURRENT mask expression may not reference impure procedure 'impure'41 do concurrent (j=1:1, impure(j) /= 0) ! C112142 !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT43 a(j) = impure(j) ! C113944 end do45 !WARNING: Impure procedure 'impure' should not be referenced in a DO CONCURRENT header46 do concurrent (k=impure(1):1); end do47 !WARNING: Impure procedure 'impure' should not be referenced in a DO CONCURRENT header48 do concurrent (k=1:impure(1)); end do49 !WARNING: Impure procedure 'impure' should not be referenced in a DO CONCURRENT header50 do concurrent (k=1:1:impure(1)); end do51 !WARNING: Impure procedure 'impure' should not be referenced in a FORALL header52 forall (k=impure(1):1); end forall53 !WARNING: Impure procedure 'impure' should not be referenced in a FORALL header54 forall (k=1:impure(1)); end forall55 !WARNING: Impure procedure 'impure' should not be referenced in a FORALL header56 forall (k=1:1:impure(1)); end forall57 do concurrent (j=1:1)58 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT59 do concurrent (k=impure(1):1); end do60 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT61 do concurrent (k=1:impure(1)); end do62 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT63 do concurrent (k=1:1:impure(1)); end do64 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT65 forall (k=impure(1):1); end forall66 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT67 forall (k=1:impure(1)); end forall68 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT69 forall (k=1:1:impure(1)); end forall70 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT71 forall (k=impure(1):1) a(k) = 0.72 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT73 forall (k=1:impure(1)) a(k) = 0.74 !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT75 forall (k=1:1:impure(1)) a(k) = 0.76 end do77 forall (j=1:1)78 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL79 forall (k=impure(1):1); end forall80 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL81 forall (k=1:impure(1)); end forall82 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL83 forall (k=1:1:impure(1)); end forall84 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL85 forall (k=impure(1):1) a(j*k) = 0.86 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL87 forall (k=1:impure(1)) a(j*k) = 0.88 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL89 forall (k=1:1:impure(1)) a(j*k) = 0.90 end forall91 end subroutine92 93 subroutine test294 type(t) :: x95 real :: a(x%tbp_pure(1)) ! ok96 !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) ! ok100 end forall101 forall (j=1:1)102 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL103 a(j) = x%tbp_impure(j) ! C1037104 end forall105 do concurrent (j=1:1, x%tbp_pure(j) /= 0) ! ok106 a(j) = x%tbp_pure(j) ! ok107 end do108 !ERROR: DO CONCURRENT mask expression may not reference impure procedure 'impure'109 do concurrent (j=1:1, x%tbp_impure(j) /= 0) ! C1121110 !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT111 a(j) = x%tbp_impure(j) ! C1139112 end do113 end subroutine114 115 subroutine test3116 type :: t117 integer :: i118 end type119 type(t) :: a(10), b120 forall (i=1:10)121 a(i) = t(pure(i)) ! OK122 end forall123 forall (i=1:10)124 !ERROR: Impure procedure 'impure' may not be referenced in a FORALL125 a(i) = t(impure(i)) ! C1037126 end forall127 end subroutine128 129 subroutine test4(ch)130 type :: t131 real, allocatable :: x132 end type133 type(t) :: a(1), b(1)134 character(*), intent(in) :: ch135 allocate (b(1)%x)136 ! Intrinsic functions and a couple subroutines are pure; do not emit errors137 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 do141 end subroutine142 143end module144