flang/test/Semantics/call11.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test 15.7 C1591 & others: contexts requiring pure subprograms
   3
   4 module 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
 143 end module