flang/test/Semantics/doconcurrent09.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Ensure that DO CONCURRENT purity checks apply to specific procedures
   3 ! in the case of calls to generic interfaces.
   4 module m
   5   interface purity
   6     module procedure :: ps, ips
   7   end interface
   8   type t
   9    contains
  10     procedure :: pb, ipb
  11     generic :: purity => pb, ipb
  12   end type
  13  contains
  14   pure subroutine ps(n)
  15     integer, intent(in) :: n
  16   end subroutine
  17   impure subroutine ips(a)
  18     real, intent(in) :: a
  19   end subroutine
  20   pure subroutine pb(x,n)
  21     class(t), intent(in) :: x
  22     integer, intent(in) :: n
  23   end subroutine
  24   impure subroutine ipb(x,n)
  25     class(t), intent(in) :: x
  26     real, intent(in) :: n
  27   end subroutine
  28 end module
  29
  30 program test
  31   use m
  32   type(t) :: x
  33   do concurrent (j=1:1)
  34     call ps(1) ! ok
  35     call purity(1) ! ok
  36     !ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
  37     call purity(1.)
  38     !ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
  39     call ips(1.)
  40     call x%pb(1) ! ok
  41     call x%purity(1) ! ok
  42     !ERROR: Call to an impure procedure component is not allowed in DO CONCURRENT
  43     call x%purity(1.)
  44     !ERROR: Call to an impure procedure component is not allowed in DO CONCURRENT
  45     call x%ipb(1.)
  46   end do
  47 end program