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