1! { dg-do compile }
2!
3! PR fortran/45170
4! PR fortran/52158
5!
6! Contributed by Tobias Burnus
7
8module test
9 implicit none
10 type t
11   procedure(deferred_len), pointer, nopass :: ppt
12 end type t
13contains
14 function deferred_len()
15   character(len=:), allocatable :: deferred_len
16   deferred_len = 'abc'
17 end function deferred_len
18 subroutine doIt()
19   type(t) :: x
20   x%ppt => deferred_len
21   if ("abc" /= x%ppt()) call abort()
22 end subroutine doIt
23end module test
24
25use test
26call doIt ()
27end
28