1! { dg-do run }
2! Tests the fix for the bug PR33233, in which the reference to 'x'
3! in 'inner' wrongly host-associated with the variable 'x' rather
4! than the function.
5!
6! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
7!
8MODULE m
9  REAL :: x(3) = (/ 1.5, 2.5, 3.5 /)
10CONTAINS
11  SUBROUTINE s
12    if (x(2) .eq. 2.5) call abort ()
13  CONTAINS
14    FUNCTION x(n, m)
15      integer, optional :: m
16      if (present(m)) then
17        x = REAL(n)**m
18      else
19        x = 0.0
20      end if
21    END FUNCTION
22  END SUBROUTINE s
23END MODULE m
24  use m
25  call s
26end
27