1! { dg-do compile }
2! { dg-options "-fdump-tree-original" }
3!
4! PR 50919: [OOP] Don't use vtable for NON_OVERRIDABLE TBP
5!
6! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
7
8module m
9
10type t
11contains
12  procedure, nopass, NON_OVERRIDABLE :: testsub
13  procedure, nopass, NON_OVERRIDABLE :: testfun
14end type t
15
16contains
17
18  subroutine testsub()
19    print *, "t's test"
20  end subroutine
21
22  integer function testfun()
23    testfun = 1
24  end function
25
26end module m
27
28
29  use m
30  class(t), allocatable :: x
31  allocate(x)
32  call x%testsub()
33  print *,x%testfun()
34end
35
36! { dg-final { scan-tree-dump-times "_vptr->" 0 "original" } }
37! { dg-final { cleanup-tree-dump "original" } }
38