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: 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
  83   subroutine test4(ch)
  84     type :: t
  85       real, allocatable :: x
  86     end type
  87     type(t) :: a(1), b(1)
  88     character(*), intent(in) :: ch
  89     allocate (b(1)%x)
  90     ! Intrinsic functions and a couple subroutines are pure; do not emit errors
  91     do concurrent (j=1:1)
  92       b(j)%x = cos(1.) + len(ch)
  93       call move_alloc(from=b(j)%x, to=a(j)%x)
  94     end do
  95   end subroutine
  96
  97 end module