1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
! 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
|
