1! { dg-do run }
2!
3! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length)
4!
5! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
6
7  type t
8    character(len=:,kind=4), allocatable :: str_comp
9    character(len=:,kind=4), allocatable :: str_comp1
10  end type t
11  type(t) :: x
12  type(t), allocatable, dimension(:) :: array
13
14  ! Check scalars
15  allocate (x%str_comp, source = 4_"abc")
16  call check (x%str_comp, 4_"abc")
17  deallocate (x%str_comp)
18  allocate (x%str_comp, source = 4_"abcdefghijklmnop")
19  call check (x%str_comp, 4_"abcdefghijklmnop")
20  x%str_comp = 4_"xyz"
21  call check (x%str_comp, 4_"xyz")
22  x%str_comp = 4_"abcdefghijklmnop"
23  x%str_comp1 = 4_"lmnopqrst"
24  call foo (x%str_comp1, 4_"lmnopqrst")
25  call bar (x, 4_"abcdefghijklmnop", 4_"lmnopqrst")
26
27  ! Check arrays and structure constructors
28  allocate (array(2), source = [t(4_"abcedefg",4_"hi"), t(4_"jkl",4_"mnop")])
29  call check (array(1)%str_comp, 4_"abcedefg")
30  call check (array(1)%str_comp1, 4_"hi")
31  call check (array(2)%str_comp, 4_"jkl")
32  call check (array(2)%str_comp1, 4_"mnop")
33  deallocate (array)
34  allocate (array(3), source = [x, x, x])
35  array(2)%str_comp = 4_"blooey"
36  call bar (array(1), 4_"abcdefghijklmnop", 4_"lmnopqrst")
37  call bar (array(2), 4_"blooey", 4_"lmnopqrst")
38  call bar (array(3), 4_"abcdefghijklmnop", 4_"lmnopqrst")
39
40contains
41
42  subroutine foo (chr1, chr2)
43    character (len=*,kind=4) :: chr1, chr2
44    call check (chr1, chr2)
45  end subroutine
46
47  subroutine bar (a, chr1, chr2)
48    character (len=*,kind=4) :: chr1, chr2
49    type(t) :: a
50    call check (a%str_comp, chr1)
51    call check (a%str_comp1, chr2)
52  end subroutine
53
54  subroutine check (chr1, chr2)
55    character (len=*,kind=4) :: chr1, chr2
56    if (len(chr1) .ne. len (chr2)) call abort
57    if (chr1 .ne. chr2) call abort
58  end subroutine
59
60end
61