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