1! { dg-do compile }
2!
3! PR 44044: [OOP] SELECT TYPE with class-valued function
4!
5! Contributed by Janus Weil <janus@gcc.gnu.org>
6
7implicit none
8
9type :: t1
10  integer :: i
11end type
12
13type, extends(t1) :: t2
14end type
15
16type(t1),target :: x1
17type(t2),target :: x2
18
19select type ( y => fun(1) )
20type is (t1)
21  print *,"t1"
22type is (t2)
23  print *,"t2"
24class default
25  print *,"default"
26end select
27
28select type ( y => fun(-1) )
29type is (t1)
30  print *,"t1"
31type is (t2)
32  print *,"t2"
33class default
34  print *,"default"
35end select
36
37contains
38
39  function fun(i)
40    class(t1),pointer :: fun
41    integer :: i
42    if (i>0) then
43      fun => x1
44    else if (i<0) then
45      fun => x2
46    else
47      fun => NULL()
48    end if
49  end function
50
51end
52