1! { dg-do compile } 2! 3! PR fortran/87632 4! 5! Contributed by Jürgen Reuter 6! 7module m 8type t 9 integer :: i 10end type t 11type t2 12 type(t) :: phs_config 13end type t2 14end module m 15 16module m2 17use m 18implicit none 19type t3 20end type t3 21 22type process_t 23 private 24 type(t2), allocatable :: component(:) 25contains 26 procedure :: get_phs_config => process_get_phs_config 27end type process_t 28 29contains 30 subroutine process_extract_resonance_history_set & 31 (process, include_trivial, i_component) 32 class(process_t), intent(in), target :: process 33 logical, intent(in), optional :: include_trivial 34 integer, intent(in), optional :: i_component 35 integer :: i 36 i = 1; if (present (i_component)) i = i_component 37 select type (phs_config => process%get_phs_config (i)) 38 class is (t) 39 call foo() 40 class default 41 call bar() 42 end select 43 end subroutine process_extract_resonance_history_set 44 45 function process_get_phs_config (process, i_component) result (phs_config) 46 class(t), pointer :: phs_config 47 class(process_t), intent(in), target :: process 48 integer, intent(in) :: i_component 49 if (allocated (process%component)) then 50 phs_config => process%component(i_component)%phs_config 51 else 52 phs_config => null () 53 end if 54 end function process_get_phs_config 55end module m2 56 57program main 58 use m2 59end program main 60