1! { dg-do run }
2! { dg-options "-std=f2008 -fall-intrinsics" }
3
4! PR fortran/45197
5! Check that IMPURE and IMPURE ELEMENTAL in particular works.
6
7! Contributed by Daniel Kraft, d@domob.eu.
8
9MODULE m
10  IMPLICIT NONE
11
12  INTEGER, PARAMETER :: n = 5
13
14  INTEGER :: i
15  INTEGER :: arr(n)
16
17CONTAINS
18
19  ! This ought to work (without any effect).
20  IMPURE SUBROUTINE foobar ()
21  END SUBROUTINE foobar
22
23  IMPURE ELEMENTAL SUBROUTINE impureSub (a)
24    INTEGER, INTENT(IN) :: a
25
26    arr(i) = a
27    i = i + 1
28
29    PRINT *, a
30  END SUBROUTINE impureSub
31
32END MODULE m
33
34PROGRAM main
35  USE :: m
36  IMPLICIT NONE
37
38  INTEGER :: a(n), b(n), s
39
40  a = (/ (i, i = 1, n) /)
41
42  ! Traverse in forward order.
43  s = 0
44  b = accumulate (a, s)
45  IF (ANY (b /= (/ 1, 3, 6, 10, 15 /))) CALL abort ()
46
47  ! And now backward.
48  s = 0
49  b = accumulate (a(n:1:-1), s)
50  IF (ANY (b /= (/ 5, 9, 12, 14, 15 /))) CALL abort ()
51
52  ! Use subroutine.
53  i = 1
54  arr = 0
55  CALL impureSub (a)
56  IF (ANY (arr /= a)) CALL abort ()
57
58CONTAINS
59
60  IMPURE ELEMENTAL FUNCTION accumulate (a, s)
61    INTEGER, INTENT(IN) :: a
62    INTEGER, INTENT(INOUT) :: s
63    INTEGER :: accumulate
64    
65    s = s + a
66    accumulate = s
67  END FUNCTION accumulate
68
69END PROGRAM main
70