3 ! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length)
5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
8 character(len
=:), allocatable
:: str_comp
9 character(len
=:), allocatable
:: str_comp1
12 type(t
), allocatable
, dimension(:) :: array
15 allocate (x
%str_comp
, source
= "abc")
16 call check (x
%str_comp
, "abc")
17 deallocate (x
%str_comp
)
18 allocate (x
%str_comp
, source
= "abcdefghijklmnop")
19 call check (x
%str_comp
, "abcdefghijklmnop")
21 call check (x
%str_comp
, "xyz")
22 x
%str_comp
= "abcdefghijklmnop"
23 x
%str_comp1
= "lmnopqrst"
24 call foo (x
%str_comp1
, "lmnopqrst")
25 call bar (x
, "abcdefghijklmnop", "lmnopqrst")
27 ! Check arrays and structure constructors
28 allocate (array(2), source
= [t("abcedefg","hi"), t("jkl","mnop")])
29 call check (array(1)%str_comp
, "abcedefg")
30 call check (array(1)%str_comp1
, "hi")
31 call check (array(2)%str_comp
, "jkl")
32 call check (array(2)%str_comp1
, "mnop")
34 allocate (array(3), source
= [x
, x
, x
])
35 array(2)%str_comp
= "blooey"
36 call bar (array(1), "abcdefghijklmnop", "lmnopqrst")
37 call bar (array(2), "blooey", "lmnopqrst")
38 call bar (array(3), "abcdefghijklmnop", "lmnopqrst")
42 subroutine foo (chr1
, chr2
)
43 character (*) :: chr1
, chr2
44 call check (chr1
, chr2
)
47 subroutine bar (a
, chr1
, chr2
)
48 character (*) :: chr1
, chr2
50 call check (a
%str_comp
, chr1
)
51 call check (a
%str_comp1
, chr2
)
54 subroutine check (chr1
, chr2
)
55 character (*) :: chr1
, chr2
56 if (len(chr1
) .ne
. len (chr2
)) call abort
57 if (chr1
.ne
. chr2
) call abort