1! { dg-do run }
2! Test the fix for PR43291, which was a regression that caused
3! incorrect type mismatch errors at line 46. In the course of
4! fixing the PR, it was noted that the dynamic dispatch of the
5! final typebound call was not occurring - hence the dg-do run.
6!
7! Contributed by Janus Weil <janus@gcc.gnu.org>
8!
9module m1
10  type :: t1
11  contains
12    procedure :: sizeof
13  end type
14contains
15  integer function sizeof(a)
16    class(t1) :: a
17    sizeof = 1
18  end function sizeof
19end module
20
21module m2
22  use m1
23  type, extends(t1) :: t2
24  contains
25    procedure :: sizeof => sizeof2
26  end type
27contains
28  integer function sizeof2(a)
29    class(t2) :: a
30    sizeof2 = 2
31  end function
32end module
33
34module m3
35  use m2
36  type :: t3
37  class(t1), pointer :: a
38  contains
39    procedure :: sizeof => sizeof3
40  end type
41contains
42  integer function sizeof3(a)
43    class(t3) :: a
44    sizeof3 = a%a%sizeof()
45  end function
46end module
47
48  use m1
49  use m2
50  use m3
51  type(t1), target :: x
52  type(t2), target :: y
53  type(t3) :: z
54  z%a => x
55  if ((z%sizeof() .ne. 1) .or. (z%a%sizeof() .ne. 1)) STOP 1
56  z%a => y
57  if ((z%sizeof() .ne. 2) .or. (z%a%sizeof() .ne. 2)) STOP 2
58end
59
60