! { dg-do run } ! This checks the correct functioning of derived types with default initializers ! and allocatable components. ! ! Contributed by Salvatore Filippone ! module p_type_mod type m_type integer, allocatable :: p(:) end type m_type type basep_type type(m_type), allocatable :: av(:) type(m_type), pointer :: ap => null () integer :: i = 101 end type basep_type type p_type type(basep_type), allocatable :: basepv(:) integer :: p1 , p2 = 1 end type p_type end module p_type_mod program foo use p_type_mod implicit none type(m_type), target :: a type(p_type) :: pre type(basep_type) :: wee call test_ab8 () a = m_type ((/101,102/)) call p_bld (a, pre) if (associated (wee%ap) .or. wee%i /= 101) call abort () wee%ap => a if (.not.associated (wee%ap) .or. allocated (wee%av)) call abort () wee = basep_type ((/m_type ((/201, 202, 203/))/), null (), 99) if (.not.allocated (wee%av) .or. associated (wee%ap) .or. (wee%i .ne. 99)) call abort () contains ! Check that allocatable components are nullified after allocation. subroutine test_ab8 () type(p_type) :: p integer :: ierr if (.not.allocated(p%basepv)) then allocate(p%basepv(1),stat=ierr) endif if (allocated (p%basepv) .neqv. .true.) call abort () if (allocated (p%basepv(1)%av) .neqv. .false.) call abort if (p%basepv(1)%i .ne. 101) call abort () end subroutine test_ab8 subroutine p_bld (a, p) use p_type_mod type (m_type) :: a type(p_type) :: p if (any (a%p .ne. (/101,102/))) call abort () if (allocated (p%basepv) .or. (p%p2 .ne. 1)) call abort () end subroutine p_bld end program foo ! { dg-final { cleanup-modules "p_type_mod" } }