1! { dg-do run }
2!
3! PR fortran/51218
4!
5! Contributed by Harald Anlauf
6!
7
8module a
9  implicit none
10  integer :: neval = 0
11contains
12  subroutine inc_eval
13    neval = neval + 1
14  end subroutine inc_eval
15end module a
16
17module b
18  use a
19  implicit none
20contains
21  function f(x) ! Should be implicit pure
22    real :: f
23    real, intent(in) :: x
24    f = x
25  end function f
26
27  function g(x) ! Should NOT be implicit pure
28    real :: g
29    real, intent(in) :: x
30    call inc_eval
31    g = x
32  end function g
33end module b
34
35program gfcbug114a
36  use a
37  use b
38  implicit none
39  real :: x = 1, y = 1, t, u, v, w
40  if (neval /= 0) call abort ()
41  t = f(x)*f(y)
42  if (neval /= 0) call abort ()
43  u = f(x)*f(y) + f(x)*f(y)
44  if (neval /= 0) call abort ()
45  v = g(x)*g(y)
46  if (neval /= 2) call abort ()
47  w = g(x)*g(y) + g(x)*g(y)
48  if (neval /= 6) call abort ()
49  if (t /= 1.0 .or. u /= 2.0 .or. v /= 1.0 .or. w /= 2) call abort ()
50end program gfcbug114a
51
52! { dg-final { scan-module "b" "IMPLICIT_PURE" } }
53