summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/impure_1.f08
blob: 9d09eaa4c79b39e1fb64f045e46af15e65f8e5d0 (plain)
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" } }