1! { dg-do compile }
2!
3! PR 42167: [OOP] SELECT TYPE with function return value
4!
5! Contributed by Damian Rouson <damian@rouson.net>
6
7module bar_module
8
9  implicit none
10  type :: bar
11    real ,dimension(:) ,allocatable :: f
12  contains
13    procedure :: total
14  end type
15
16contains
17
18  function total(lhs,rhs)
19    class(bar) ,intent(in) :: lhs
20    class(bar) ,intent(in) :: rhs
21    class(bar) ,pointer :: total
22    select type(rhs)
23      type is (bar)
24        allocate(bar :: total)
25        select type(total)
26          type is (bar)
27            total%f = lhs%f + rhs%f
28        end select
29    end select
30  end function
31
32end module 
33