OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [implicit_pure_1.f90] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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" } }
53
! { dg-final { cleanup-modules "b" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.