! { dg-do run }
!
! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length)
!
! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>

  type t
    character(len=:), allocatable :: str_comp
    character(len=:), allocatable :: str_comp1
  end type t
  type(t) :: x
  type(t), allocatable, dimension(:) :: array

  ! Check scalars
  allocate (x%str_comp, source = "abc")
  call check (x%str_comp, "abc")
  deallocate (x%str_comp)
  allocate (x%str_comp, source = "abcdefghijklmnop")
  call check (x%str_comp, "abcdefghijklmnop")
  x%str_comp = "xyz"
  call check (x%str_comp, "xyz")
  x%str_comp = "abcdefghijklmnop"
  x%str_comp1 = "lmnopqrst"
  call foo (x%str_comp1, "lmnopqrst")
  call bar (x, "abcdefghijklmnop", "lmnopqrst")

  ! Check arrays and structure constructors
  allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")])
  call check (array(1)%str_comp, "abcedefg")
  call check (array(1)%str_comp1, "hi")
  call check (array(2)%str_comp, "jkl")
  call check (array(2)%str_comp1, "mnop")
  deallocate (array)
  allocate (array(3), source = [x, x, x])
  array(2)%str_comp = "blooey"
  call bar (array(1), "abcdefghijklmnop", "lmnopqrst")
  call bar (array(2), "blooey", "lmnopqrst")
  call bar (array(3), "abcdefghijklmnop", "lmnopqrst")

contains

  subroutine foo (chr1, chr2)
    character (*) :: chr1, chr2
    call check (chr1, chr2)
  end subroutine

  subroutine bar (a, chr1, chr2)
    character (*) :: chr1, chr2
    type(t) :: a
    call check (a%str_comp, chr1)
    call check (a%str_comp1, chr2)
  end subroutine

  subroutine check (chr1, chr2)
    character (*) :: chr1, chr2
    if (len(chr1) .ne. len (chr2)) STOP 1
    if (chr1 .ne. chr2) STOP 2
  end subroutine

end