TheRock/compiler/amd-llvm/flang/test/Semantics/doconcurrent09.f90

! RUN: %python %S/test_errors.py %s %flang_fc1
! Ensure that DO CONCURRENT purity checks apply to specific procedures
! in the case of calls to generic interfaces.
module m
  interface purity
    module procedure :: ps, ips
  end interface
  type t
   contains
    procedure :: pb, ipb
    generic :: purity => pb, ipb
  end type
 contains
  pure subroutine ps(n)
    integer, intent(in) :: n
  end subroutine
  impure subroutine ips(a)
    real, intent(in) :: a
  end subroutine
  pure subroutine pb(x,n)
    class(t), intent(in) :: x
    integer, intent(in) :: n
  end subroutine
  impure subroutine ipb(x,n)
    class(t), intent(in) :: x
    real, intent(in) :: n
  end subroutine
end module

program test
  use m
  type(t) :: x
  do concurrent (j=1:1)
    call ps(1) ! ok
    call purity(1) ! ok
    !ERROR: Impure procedure 'ips' may not be referenced in DO CONCURRENT
    call purity(1.)
    !ERROR: Impure procedure 'ips' may not be referenced in DO CONCURRENT
    call ips(1.)
    call x%pb(1) ! ok
    call x%purity(1) ! ok
    !ERROR: Impure procedure 'ipb' may not be referenced in DO CONCURRENT
    call x%purity(1.)
    !ERROR: Impure procedure 'ipb' may not be referenced in DO CONCURRENT
    call x%ipb(1.)
  end do
end program