48 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Ensure that DO CONCURRENT purity checks apply to specific procedures3! in the case of calls to generic interfaces.4module m5 interface purity6 module procedure :: ps, ips7 end interface8 type t9 contains10 procedure :: pb, ipb11 generic :: purity => pb, ipb12 end type13 contains14 pure subroutine ps(n)15 integer, intent(in) :: n16 end subroutine17 impure subroutine ips(a)18 real, intent(in) :: a19 end subroutine20 pure subroutine pb(x,n)21 class(t), intent(in) :: x22 integer, intent(in) :: n23 end subroutine24 impure subroutine ipb(x,n)25 class(t), intent(in) :: x26 real, intent(in) :: n27 end subroutine28end module29 30program test31 use m32 type(t) :: x33 do concurrent (j=1:1)34 call ps(1) ! ok35 call purity(1) ! ok36 !ERROR: Impure procedure 'ips' may not be referenced in DO CONCURRENT37 call purity(1.)38 !ERROR: Impure procedure 'ips' may not be referenced in DO CONCURRENT39 call ips(1.)40 call x%pb(1) ! ok41 call x%purity(1) ! ok42 !ERROR: Impure procedure 'ipb' may not be referenced in DO CONCURRENT43 call x%purity(1.)44 !ERROR: Impure procedure 'ipb' may not be referenced in DO CONCURRENT45 call x%ipb(1.)46 end do47end program48