Subversion Repositories openrisc

! { 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" } }