1! { dg-do run }
2!
3! PR fortran/53255
4!
5! Contributed by Reinhold Bader.
6!
7! Before TYPE(ext)'s .tr. wrongly called the base type's trace
8! instead of ext's trace_ext.
9!
10module mod_base
11  implicit none
12  private
13  integer, public :: base_cnt = 0
14  type, public :: base
15     private
16     real :: r(2,2) = reshape( (/ 1.0, 2.0, 3.0, 4.0 /), (/ 2, 2 /))
17   contains
18     procedure, private :: trace
19     generic :: operator(.tr.) => trace
20  end type base
21contains
22  complex function trace(this)
23    class(base), intent(in) :: this
24    base_cnt = base_cnt + 1
25!    write(*,*) 'executing base'
26    trace = this%r(1,1) + this%r(2,2)
27  end function trace
28end module mod_base
29
30module mod_ext
31  use mod_base
32  implicit none
33  private
34  integer, public :: ext_cnt = 0
35  public :: base, base_cnt
36  type, public, extends(base) :: ext
37     private
38     real :: i(2,2) = reshape( (/ 1.0, 1.0, 1.0, 1.5 /), (/ 2, 2 /))
39   contains
40     procedure, private :: trace => trace_ext
41  end type ext
42contains
43   complex function trace_ext(this)
44    class(ext), intent(in) :: this
45
46!   the following should be executed through invoking .tr. p below
47!    write(*,*) 'executing override'
48    ext_cnt = ext_cnt + 1
49    trace_ext = .tr. this%base + (0.0, 1.0) * ( this%i(1,1) + this%i(2,2) )
50  end function trace_ext
51
52end module mod_ext
53program test_override
54  use mod_ext
55  implicit none
56  type(base) :: o
57  type(ext) :: p
58  real :: r
59
60  ! Note: ext's ".tr." (trace_ext) calls also base's "trace"
61
62!  write(*,*) .tr. o
63!  write(*,*) .tr. p
64  if (base_cnt /= 0 .or. ext_cnt /= 0) STOP 1
65  r = .tr. o
66  if (base_cnt /= 1 .or. ext_cnt /= 0) STOP 2
67  r = .tr. p
68  if (base_cnt /= 2 .or. ext_cnt /= 1) STOP 3
69
70  if (abs(.tr. o - 5.0 ) < 1.0e-6  .and. abs( .tr. p - (5.0,2.5)) < 1.0e-6) &
71  then
72    if (base_cnt /= 4 .or. ext_cnt /= 2) STOP 4
73!     write(*,*) 'OK'
74  else
75    STOP 5
76!     write(*,*) 'FAIL'
77  end if
78end program test_override
79