1! { dg-do compile }
2!
3! PR fortran/52024
4!
5! The test case was segfaulting before
6!
7
8module m_sort
9  implicit none
10  type, abstract :: sort_t
11  contains
12    generic :: operator(.gt.) => gt_cmp
13    procedure :: gt_cmp
14    end type sort_t
15contains
16  logical function gt_cmp(a,b)
17    class(sort_t), intent(in) :: a, b
18    gt_cmp = .true.
19  end function gt_cmp
20end module
21
22module test
23  use m_sort
24  implicit none
25  type, extends(sort_t) :: sort_int_t
26    integer :: i
27  contains
28    generic :: operator(.gt.) => gt_cmp_int ! { dg-error "are ambiguous" }
29    procedure :: gt_cmp_int
30  end type
31contains
32  logical function gt_cmp_int(a,b) result(cmp)
33    class(sort_int_t), intent(in) :: a, b
34    if (a%i > b%i) then
35      cmp = .true.
36     else
37      cmp = .false.
38     end if
39  end function gt_cmp_int
40end module
41
42