1! { dg-do run }
2! Tests the fix for the bug PR30746, in which the reference to 'x'
3! in 'inner' wrongly host-associated with the variable 'x' rather
4! than the function.
5!
6! Testcase is due to Malcolm Cohen, NAG.
7!
8real function z (i)
9  integer :: i
10  z = real (i)**i
11end function
12
13MODULE m
14  REAL :: x(3) = (/ 1.5, 2.5, 3.5 /)
15  interface
16    real function z (i)
17      integer :: i
18    end function
19  end interface
20CONTAINS
21  SUBROUTINE s
22    if (x(2, 3) .ne. real (2)**3) STOP 1
23    if (z(3, 3) .ne. real (3)**3) STOP 2
24    CALL inner
25  CONTAINS
26    SUBROUTINE inner
27      i = 7
28      if (x(i, 7) .ne. real (7)**7) STOP 3
29      if (z(i, 7) .ne. real (7)**7) STOP 4
30    END SUBROUTINE
31    FUNCTION x(n, m)
32      x = REAL(n)**m
33    END FUNCTION
34    FUNCTION z(n, m)
35      z = REAL(n)**m
36    END FUNCTION
37
38  END SUBROUTINE
39END MODULE
40  use m
41  call s()
42end
43