gcc/testsuite/gfortran.dg/impure_1.f08

   1 ! { dg-do run }
   2 ! { dg-options "-std=f2008 " }
   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
   9 MODULE m
  10   IMPLICIT NONE
  11
  12   INTEGER, PARAMETER :: n = 5
  13
  14   INTEGER :: i
  15   INTEGER :: arr(n)
  16
  17 CONTAINS
  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
  32 END MODULE m
  33
  34 PROGRAM 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 /))) STOP 1
  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 /))) STOP 2
  51
  52   ! Use subroutine.
  53   i = 1
  54   arr = 0
  55   CALL impureSub (a)
  56   IF (ANY (arr /= a)) STOP 3
  57
  58 CONTAINS
  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
  69 END PROGRAM main