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