1! { dg-do run }
2! Test the fix for PR43895, in which the dummy 'a' was not
3! dereferenced for the deallocation of component 'a', as required
4! for INTENT(OUT).
5!
6! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
7!
8module d_mat_mod
9  type  :: base_sparse_mat
10  end type base_sparse_mat
11
12  type, extends(base_sparse_mat) :: d_base_sparse_mat
13    integer :: i
14  end type d_base_sparse_mat
15
16  type :: d_sparse_mat
17    class(d_base_sparse_mat), allocatable  :: a
18  end type d_sparse_mat
19end module d_mat_mod
20
21  use d_mat_mod
22  type(d_sparse_mat) :: b
23  allocate (b%a)
24  b%a%i = 42
25  call bug14 (b)
26  if (allocated (b%a)) call abort
27contains
28  subroutine bug14(a)
29    implicit none
30    type(d_sparse_mat), intent(out) :: a
31  end subroutine bug14
32end
33