1! { dg-do compile }
2! PR fortran/32738
3!
4! A regression that mysteriously appeared and disappeared again.
5! Added to the testsuite "just in case".
6!
7! Contributed by Michael Richmond <michael DOT a DOT richmond AT nasa DT gov>
8!
9
10module cluster_definition
11  implicit none
12  integer, parameter, public:: cluster_size = 1000
13end module cluster_definition
14module cluster_tree
15  use cluster_definition, only: ct_cluster_size => cluster_size
16  implicit none
17  private
18  private:: ct_initialize, ct_dealloc, ct_tree_size
19  public:: initialize, dealloc, tree_size
20  interface initialize
21     module procedure ct_initialize
22  end interface
23  interface dealloc
24     module procedure ct_dealloc
25  end interface
26  interface tree_size
27     module procedure ct_tree_size
28  end interface
29contains
30  subroutine ct_initialize()
31  end subroutine ct_initialize
32  subroutine ct_dealloc()
33  end subroutine ct_dealloc
34  function ct_tree_size(t) result(s)
35    integer :: t
36    integer :: s
37    s = 0
38  end function ct_tree_size
39end module cluster_tree
40program example
41  use cluster_tree
42  implicit none
43     print *, tree_size(1)
44end program example
45