1! { dg-do run }
2! Checks the fixes for PR34681 and PR34704, in which various mixtures
3! of default initializer and allocatable array were not being handled
4! correctly for derived types with allocatable components.
5!
6! Contributed by Paolo Giannozzi <p.giannozzi@fisica.uniud.it>
7!
8program boh
9  integer :: c1, c2, c3, c4, c5
10  !
11  call mah (0, c1) ! These calls deal with PR34681
12  call mah (1, c2)
13  call mah (2, c3)
14  !
15  if (c1 /= c2) call abort
16  if (c1 /= c3) call abort
17  !
18  call mah0 (c4) ! These calls deal with PR34704
19  call mah1 (c5)
20  !
21  if (c4 /= c5) call abort
22  !
23end program boh
24!
25subroutine mah (i, c)
26  !
27  integer, intent(in) :: i
28  integer, intent(OUT) :: c
29  !
30  type mix_type
31     real(8), allocatable :: a(:)
32     complex(8), allocatable :: b(:)
33  end type mix_type
34  type(mix_type), allocatable, save :: t(:)
35  integer :: j, n=1024
36  !
37  if (i==0) then
38     allocate (t(1))
39     allocate (t(1)%a(n))
40     allocate (t(1)%b(n))
41     do j=1,n
42        t(1)%a(j) = j
43        t(1)%b(j) = n-j
44     end do
45  end if
46  c = sum( t(1)%a(:) ) + sum( t(1)%b(:) )
47  if ( i==2) then
48     deallocate (t(1)%b)
49     deallocate (t(1)%a)
50     deallocate (t)
51  end if
52end subroutine mah
53
54subroutine mah0 (c)
55  !
56  integer, intent(OUT) :: c
57  type mix_type
58     real(8), allocatable :: a(:)
59     integer :: n=1023
60  end type mix_type
61  type(mix_type) :: t
62  !
63  allocate(t%a(1))
64  t%a=3.1415926
65  c = t%n
66  deallocate(t%a)
67  !
68end subroutine mah0
69!
70subroutine mah1 (c)
71  !
72  integer, intent(OUT) :: c
73  type mix_type
74     real(8), allocatable :: a(:)
75     integer :: n=1023
76  end type mix_type
77  type(mix_type), save :: t
78  !
79  allocate(t%a(1))
80  t%a=3.1415926
81  c = t%n
82  deallocate(t%a)
83  !
84end subroutine mah1
85