1! { dg-do compile }
2!
3! PR fortran/51816
4!
5! Contributed by Harald Anlauf
6!
7module foo
8  implicit none
9  type t
10     integer :: i
11  end type t
12  interface operator (*)
13     module procedure mult
14  end interface
15contains
16  function mult (i, j)
17    type(t), intent(in) :: i, j
18    integer             :: mult
19    mult = i%i * j%i
20  end function mult
21end module foo
22
23module bar
24  implicit none
25  type t2
26     integer :: i
27  end type t2
28  interface operator (>)
29     module procedure gt
30  end interface
31contains
32  function gt (i, j)
33    type(t2), intent(in) :: i, j
34    logical             :: gt
35    gt = i%i > j%i
36  end function gt
37end module bar
38
39use bar, only : t2, operator(>) , operator(>)
40use foo, only : t
41use foo, only : operator (*)
42use foo, only : t
43use foo, only : operator (*)
44implicit none
45type(t) :: i = t(1), j = t(2)
46type(t2) :: k = t2(1), l = t2(2)
47print *, i*j
48print *, k > l
49end
50