diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/alloc_comp_initializer_1.f90')
-rw-r--r-- | gcc/testsuite/gfortran.dg/alloc_comp_initializer_1.f90 | 71 |
1 files changed, 71 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_initializer_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_1.f90 new file mode 100644 index 000000000..1976509aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_1.f90 @@ -0,0 +1,71 @@ +! { dg-do run } +! This checks the correct functioning of derived types with default initializers +! and allocatable components. +! +! Contributed by Salvatore Filippone <salvatore.filippone@uniroma2.it> +! +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" } } |