1! { dg-do run }
2!
3! PR fortran/47455
4!
5! Based on an example by Thomas Henlich
6!
7
8module class_t
9    type :: tx
10        integer, dimension(:), allocatable :: i
11    end type tx
12    type :: t
13        type(tx), pointer :: x
14        type(tx) :: y
15    contains
16        procedure :: calc
17        procedure :: find_x
18        procedure :: find_y
19    end type t
20contains
21    subroutine calc(this)
22        class(t), target :: this
23        type(tx), target :: that
24        that%i = [1,2]
25        this%x => this%find_x(that, .true.)
26        if (associated (this%x)) call abort()
27        this%x => this%find_x(that, .false.)
28        if(any (this%x%i /= [5, 7])) call abort()
29        if (.not.associated (this%x,that)) call abort()
30        allocate(this%x)
31        if (associated (this%x,that)) call abort()
32        if (allocated(this%x%i)) call abort()
33        this%x = this%find_x(that, .false.)
34        that%i = [3,4]
35        if(any (this%x%i /= [5, 7])) call abort() ! FAILS
36
37        if (allocated (this%y%i)) call abort()
38        this%y = this%find_y()  ! FAILS
39        if (.not.allocated (this%y%i)) call abort()
40        if(any (this%y%i /= [6, 8])) call abort()
41    end subroutine calc
42    function find_x(this, that, l_null)
43       class(t), intent(in) :: this
44       type(tx), target  :: that
45       type(tx), pointer :: find_x
46       logical :: l_null
47       if (l_null) then
48         find_x => null()
49       else
50         find_x => that
51         that%i = [5, 7]
52       end if
53    end function find_x
54    function find_y(this) result(res)
55        class(t), intent(in) :: this
56        type(tx), allocatable :: res
57        allocate(res)
58        res%i = [6, 8]
59   end function find_y
60end module class_t
61
62use class_t
63type(t) :: x
64call x%calc()
65end
66