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=:), allocatable :: str_comp 9 character(len=:), 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 = "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") 20 x%str_comp = "xyz" 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") 26 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") 33 deallocate (array) 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") 39 40contains 41 42 subroutine foo (chr1, chr2) 43 character (*) :: chr1, chr2 44 call check (chr1, chr2) 45 end subroutine 46 47 subroutine bar (a, chr1, chr2) 48 character (*) :: 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 (*) :: chr1, chr2 56 if (len(chr1) .ne. len (chr2)) call abort 57 if (chr1 .ne. chr2) call abort 58 end subroutine 59 60end 61