flang/test/Semantics/call11.f90

   1 ! RUN: %S/test_errors.sh %s %t %flang_fc1
   2 ! REQUIRES: shell
   3 ! Test 15.7 C1591 & others: contexts requiring pure subprograms
   4
   5 module 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
  98 end module