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. 4module 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 28end module 29 30program 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: Impure procedure 'ips' may not be referenced in DO CONCURRENT 37 call purity(1.) 38 !ERROR: Impure procedure 'ips' may not be referenced in DO CONCURRENT 39 call ips(1.) 40 call x%pb(1) ! ok 41 call x%purity(1) ! ok 42 !ERROR: Impure procedure 'ipb' may not be referenced in DO CONCURRENT 43 call x%purity(1.) 44 !ERROR: Impure procedure 'ipb' may not be referenced in DO CONCURRENT 45 call x%ipb(1.) 46 end do 47end program 48