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