1! { dg-do run } 2! This checks the correct functioning of derived types with default initializers 3! and allocatable components. 4! 5! Contributed by Salvatore Filippone <salvatore.filippone@uniroma2.it> 6! 7module p_type_mod 8 9 type m_type 10 integer, allocatable :: p(:) 11 end type m_type 12 13 type basep_type 14 type(m_type), allocatable :: av(:) 15 type(m_type), pointer :: ap => null () 16 integer :: i = 101 17 end type basep_type 18 19 type p_type 20 type(basep_type), allocatable :: basepv(:) 21 integer :: p1 , p2 = 1 22 end type p_type 23end module p_type_mod 24 25program foo 26 27 use p_type_mod 28 implicit none 29 30 type(m_type), target :: a 31 type(p_type) :: pre 32 type(basep_type) :: wee 33 34 call test_ab8 () 35 36 a = m_type ((/101,102/)) 37 38 call p_bld (a, pre) 39 40 if (associated (wee%ap) .or. wee%i /= 101) call abort () 41 wee%ap => a 42 if (.not.associated (wee%ap) .or. allocated (wee%av)) call abort () 43 wee = basep_type ((/m_type ((/201, 202, 203/))/), null (), 99) 44 if (.not.allocated (wee%av) .or. associated (wee%ap) .or. (wee%i .ne. 99)) call abort () 45 46contains 47 48! Check that allocatable components are nullified after allocation. 49 subroutine test_ab8 () 50 type(p_type) :: p 51 integer :: ierr 52 53 if (.not.allocated(p%basepv)) then 54 allocate(p%basepv(1),stat=ierr) 55 endif 56 if (allocated (p%basepv) .neqv. .true.) call abort () 57 if (allocated (p%basepv(1)%av) .neqv. .false.) call abort 58 if (p%basepv(1)%i .ne. 101) call abort () 59 60 end subroutine test_ab8 61 62 subroutine p_bld (a, p) 63 use p_type_mod 64 type (m_type) :: a 65 type(p_type) :: p 66 if (any (a%p .ne. (/101,102/))) call abort () 67 if (allocated (p%basepv) .or. (p%p2 .ne. 1)) call abort () 68 end subroutine p_bld 69 70end program foo 71