|
111
|
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 !
|
|
|
7 module 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
|
|
|
23 end module p_type_mod
|
|
|
24
|
|
|
25 program 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
|
|
131
|
40 if (associated (wee%ap) .or. wee%i /= 101) STOP 1
|
|
111
|
41 wee%ap => a
|
|
131
|
42 if (.not.associated (wee%ap) .or. allocated (wee%av)) STOP 2
|
|
111
|
43 wee = basep_type ((/m_type ((/201, 202, 203/))/), null (), 99)
|
|
131
|
44 if (.not.allocated (wee%av) .or. associated (wee%ap) .or. (wee%i .ne. 99)) STOP 3
|
|
111
|
45
|
|
|
46 contains
|
|
|
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
|
|
131
|
56 if (allocated (p%basepv) .neqv. .true.) STOP 4
|
|
|
57 if (allocated (p%basepv(1)%av) .neqv. .false.) STOP 1
|
|
|
58 if (p%basepv(1)%i .ne. 101) STOP 5
|
|
111
|
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
|
|
131
|
66 if (any (a%p .ne. (/101,102/))) STOP 6
|
|
|
67 if (allocated (p%basepv) .or. (p%p2 .ne. 1)) STOP 7
|
|
111
|
68 end subroutine p_bld
|
|
|
69
|
|
|
70 end program foo
|
