gcc/testsuite/gfortran.dg/implicit_pure_1.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/51218
   4 !
   5 ! Contributed by Harald Anlauf
   6 !
   7
   8 module a
   9   implicit none
  10   integer :: neval = 0
  11 contains
  12   subroutine inc_eval
  13     neval = neval + 1
  14   end subroutine inc_eval
  15 end module a
  16
  17 module b
  18   use a
  19   implicit none
  20 contains
  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
  33 end module b
  34
  35 program 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 ()
  50 end program gfcbug114a
  51
  52 ! { dg-final { scan-module "b" "IMPLICIT_PURE" } }