gcc/testsuite/gfortran.dg/pr102190.f90

! { dg-do compile }
!
! Contributed by Brad Richardson  <everythingfunctional@protonmail.com>
!
module sub_m
    type :: sub_t
        private
        integer :: val
    end type

    interface sub_t
        module procedure constructor
    end interface

    interface sub_t_val
        module procedure t_val
    end interface
contains
    function constructor(val) result(sub)
        integer, intent(in) :: val
        type(sub_t) :: sub

        sub%val = val
    end function

    function t_val(val) result(res)
        integer :: res
        type(sub_t), intent(in) :: val
        res = val%val
    end function
end module

module obj_m
    use sub_m, only: sub_t
    type :: obj_t
        private
        type(sub_t) :: sub_obj_
    contains
        procedure :: sub_obj
    end type

    interface obj_t
        module procedure constructor
    end interface
contains
    function constructor(sub_obj) result(obj)
        type(sub_t), intent(in) :: sub_obj
        type(obj_t) :: obj

        obj%sub_obj_ = sub_obj
    end function

    function sub_obj(self)
        class(obj_t), intent(in) :: self
        type(sub_t) :: sub_obj

        sub_obj = self%sub_obj_
    end function
end module

program main
    use sub_m, only: sub_t, sub_t_val
    use obj_m, only: obj_t
    type(sub_t), allocatable :: z

    associate(initial_sub => sub_t(42))
        associate(obj => obj_t(initial_sub))
            associate(sub_obj => obj%sub_obj())
              allocate (z, source = obj%sub_obj())
            end associate
        end associate
    end associate
    if (sub_t_val (z) .ne. 42) stop 1
end program