1! { dg-do run }
2! Test assignments of nested derived types with character allocatable
3! components(PR 20541). Subroutine test_ab6 checks out a bug in a test
4! version of gfortran's allocatable arrays.
5!
6! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
7!            and Paul Thomas  <pault@gcc.gnu.org>
8!
9  type :: a
10    character(4), allocatable :: ch(:)
11  end type a
12
13  type :: b
14    type (a), allocatable :: at(:)
15  end type b
16
17  type(a) :: x(2)
18  type(b) :: y(2), z(2)
19
20  character(4) :: chr1(4) = (/"abcd","efgh","ijkl","mnop"/)
21  character(4) :: chr2(4) = (/"qrst","uvwx","yz12","3456"/)
22
23  x(1) = a(chr1)
24
25 ! Check constructor with character array constructors.
26  x(2) = a((/"qrst","uvwx","yz12","3456"/))
27
28  y(1) = b((/x(1),x(2)/))
29  y(2) = b((/x(2),x(1)/))
30
31  y(2) = y(1)
32
33  if (any((/((y(2)%at(i)%ch(j),j=1,4),i=1,2)/) .ne. &
34          (/chr1, chr2/))) STOP 1
35
36  call test_ab6 ()
37
38contains
39
40  subroutine test_ab6 ()
41! This subroutine tests the presence of a scalar derived type, intermediate
42! in a chain of derived types with allocatable components.
43! Contributed by Salvatore Filippone  <salvatore.filippone@uniroma2.it>
44
45    type b
46      type(a)  :: a
47    end type b
48
49    type c
50      type(b), allocatable :: b(:)
51    end type c
52
53    type(c)    :: p
54    type(b)   :: bv
55
56    p = c((/b(a((/"Mary","Lamb"/)))/))
57    bv = p%b(1)
58
59    if (any ((bv%a%ch(:)) .ne. (/"Mary","Lamb"/))) STOP 2
60
61end subroutine test_ab6
62
63end
64