1! { dg-do link }
2! { dg-additional-sources public_private_module_4.f90 }
3!
4! PR fortran/52916
5! Cf. PR fortran/40973
6!
7! Ensure that PRIVATE specific functions do not get
8! marked as TREE_PUBLIC() = 0, if the generic name is
9! PUBLIC.
10!
11module m
12  interface gen
13    module procedure bar
14  end interface gen
15
16  type t
17  end type t
18
19  interface operator(.myop.)
20    module procedure my_op
21  end interface
22
23  interface operator(+)
24    module procedure my_plus
25  end interface
26
27  interface assignment(=)
28    module procedure my_assign
29  end interface
30
31  private :: bar, my_op, my_plus, my_assign
32contains
33  subroutine bar()
34    print *, "bar"
35  end subroutine bar
36  function my_op(op1, op2) result(res)
37    type(t) :: res
38    type(t), intent(in) :: op1, op2
39  end function my_op
40  function my_plus(op1, op2) result(res)
41    type(t) :: res
42    type(t), intent(in) :: op1, op2
43  end function my_plus
44  subroutine my_assign(lhs, rhs)
45    type(t), intent(out) :: lhs
46    type(t), intent(in) :: rhs
47  end subroutine my_assign
48end module m
49
50module m2
51  type t2
52  contains
53    procedure, nopass :: func => foo
54  end type t2
55  private :: foo
56contains
57  subroutine foo()
58  end subroutine foo
59end module m2
60