xref: /llvm-project/flang/test/Semantics/doconcurrent09.f90 (revision 486be17ddaf639dc13b8df4ba078f2677f0c5829)
1bd92bca5SPeter Klausler! RUN: %python %S/test_errors.py %s %flang_fc1
2bd92bca5SPeter Klausler! Ensure that DO CONCURRENT purity checks apply to specific procedures
3bd92bca5SPeter Klausler! in the case of calls to generic interfaces.
4bd92bca5SPeter Klauslermodule m
5bd92bca5SPeter Klausler  interface purity
6bd92bca5SPeter Klausler    module procedure :: ps, ips
7bd92bca5SPeter Klausler  end interface
8bd92bca5SPeter Klausler  type t
9bd92bca5SPeter Klausler   contains
10bd92bca5SPeter Klausler    procedure :: pb, ipb
11bd92bca5SPeter Klausler    generic :: purity => pb, ipb
12bd92bca5SPeter Klausler  end type
13bd92bca5SPeter Klausler contains
14bd92bca5SPeter Klausler  pure subroutine ps(n)
15bd92bca5SPeter Klausler    integer, intent(in) :: n
16bd92bca5SPeter Klausler  end subroutine
17bd92bca5SPeter Klausler  impure subroutine ips(a)
18bd92bca5SPeter Klausler    real, intent(in) :: a
19bd92bca5SPeter Klausler  end subroutine
20bd92bca5SPeter Klausler  pure subroutine pb(x,n)
21bd92bca5SPeter Klausler    class(t), intent(in) :: x
22bd92bca5SPeter Klausler    integer, intent(in) :: n
23bd92bca5SPeter Klausler  end subroutine
24bd92bca5SPeter Klausler  impure subroutine ipb(x,n)
25bd92bca5SPeter Klausler    class(t), intent(in) :: x
26bd92bca5SPeter Klausler    real, intent(in) :: n
27bd92bca5SPeter Klausler  end subroutine
28bd92bca5SPeter Klauslerend module
29bd92bca5SPeter Klausler
30bd92bca5SPeter Klauslerprogram test
31bd92bca5SPeter Klausler  use m
32bd92bca5SPeter Klausler  type(t) :: x
33bd92bca5SPeter Klausler  do concurrent (j=1:1)
34bd92bca5SPeter Klausler    call ps(1) ! ok
35bd92bca5SPeter Klausler    call purity(1) ! ok
36*486be17dSPeter Klausler    !ERROR: Impure procedure 'ips' may not be referenced in DO CONCURRENT
37bd92bca5SPeter Klausler    call purity(1.)
38*486be17dSPeter Klausler    !ERROR: Impure procedure 'ips' may not be referenced in DO CONCURRENT
39bd92bca5SPeter Klausler    call ips(1.)
40bd92bca5SPeter Klausler    call x%pb(1) ! ok
41bd92bca5SPeter Klausler    call x%purity(1) ! ok
42*486be17dSPeter Klausler    !ERROR: Impure procedure 'ipb' may not be referenced in DO CONCURRENT
43bd92bca5SPeter Klausler    call x%purity(1.)
44*486be17dSPeter Klausler    !ERROR: Impure procedure 'ipb' may not be referenced in DO CONCURRENT
45bd92bca5SPeter Klausler    call x%ipb(1.)
46bd92bca5SPeter Klausler  end do
47bd92bca5SPeter Klauslerend program
48