1! { dg-do run }
2! Tests the fix for the bug PR40629, in which the reference to 'x'
3! in 'upper' wrongly host-associated with the symbol 'x' at module
4! leve rather than the function.
5!
6! Contributed by Philippe Marguinaud  <philippe.marguinaud@meteo.fr>
7!
8MODULE m
9  REAL :: x = 0
10CONTAINS
11  subroutine s
12    call upper
13    call lower
14  CONTAINS
15    SUBROUTINE upper
16     y = x(3,1)
17     if (int(y) .ne. 3) call abort
18    END SUBROUTINE
19    FUNCTION x(n, m)
20       x = m*n
21    END FUNCTION
22    SUBROUTINE lower
23     y = x(2,1)
24     if (int(y) .ne. 2) call abort
25    END SUBROUTINE
26  END SUBROUTINE
27END MODULE
28
29  use m
30  call s
31end
32