1! { dg-do compile }
2! { dg-options "-fdump-tree-optimized -O" }
3!
4! PR 50960: [OOP] vtables not marked as constant
5!
6! This test case checks whether the type-bound call to "x%bar"
7! is optimized into a static call to "base".
8!
9! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
10
11module m
12  type t
13  contains
14    procedure, nopass :: bar => base
15  end type
16contains
17  subroutine base()
18    write(*,*) 'base'
19  end subroutine
20end module
21
22program test
23  use m
24  class(t), allocatable :: x
25  allocate (t :: x)
26  call x%bar ()
27end program
28
29! { dg-final { scan-tree-dump-times "base \\(\\);" 1 "optimized" } }
30