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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
! { dg-do run }
! { dg-options "-std=f2008 -fall-intrinsics" }
! PR fortran/45197
! Check that IMPURE and IMPURE ELEMENTAL in particular works.
! Contributed by Daniel Kraft, d@domob.eu.
MODULE m
IMPLICIT NONE
INTEGER, PARAMETER :: n = 5
INTEGER :: i
INTEGER :: arr(n)
CONTAINS
! This ought to work (without any effect).
IMPURE SUBROUTINE foobar ()
END SUBROUTINE foobar
IMPURE ELEMENTAL SUBROUTINE impureSub (a)
INTEGER, INTENT(IN) :: a
arr(i) = a
i = i + 1
PRINT *, a
END SUBROUTINE impureSub
END MODULE m
PROGRAM main
USE :: m
IMPLICIT NONE
INTEGER :: a(n), b(n), s
a = (/ (i, i = 1, n) /)
! Traverse in forward order.
s = 0
b = accumulate (a, s)
IF (ANY (b /= (/ 1, 3, 6, 10, 15 /))) CALL abort ()
! And now backward.
s = 0
b = accumulate (a(n:1:-1), s)
IF (ANY (b /= (/ 5, 9, 12, 14, 15 /))) CALL abort ()
! Use subroutine.
i = 1
arr = 0
CALL impureSub (a)
IF (ANY (arr /= a)) CALL abort ()
CONTAINS
IMPURE ELEMENTAL FUNCTION accumulate (a, s)
INTEGER, INTENT(IN) :: a
INTEGER, INTENT(INOUT) :: s
INTEGER :: accumulate
s = s + a
accumulate = s
END FUNCTION accumulate
END PROGRAM main
! { dg-final { cleanup-modules "m" } }
|
