! { dg-do run }
!
! Test the fix for PR87151 by exercising deferred length character
! array components.
!
! Based on the contribution by Valery Weber <valeryweber@hotmail.com>
!
module bvec
    type, public :: bvec_t
     private
     character(:), dimension(:), allocatable :: vc
   contains
     PROCEDURE, PASS :: create
     PROCEDURE, PASS :: test_bvec
     PROCEDURE, PASS :: delete
  end type bvec_t
contains
  subroutine create (this, switch)
    class(bvec_t), intent(inout) :: this
    logical :: switch
    if (switch) then
      allocate (character(2)::this%vc(3))
      if (len (this%vc) .ne. 2) stop 1     ! The orignal problem. Gave 0.

! Check that reallocation on assign does what it should do as required by
! F2003 7.4.1.3. ie. reallocation occurs because LEN has changed.
      this%vc = ['abcd','efgh','ijkl']
    else
      allocate (this%vc, source = ['abcd','efgh','ijkl'])
    endif
  end subroutine create

  subroutine test_bvec (this)
    class(bvec_t), intent(inout) :: this
    character(20) :: buffer
    if (allocated (this%vc)) then
      if (len (this%vc) .ne. 4) stop 2
      if (size (this%vc) .ne. 3) stop 3
! Check array referencing and scalarized array referencing
      if (this%vc(2) .ne. 'efgh') stop 4
      if (any (this%vc .ne. ['abcd','efgh','ijkl'])) stop 5
! Check full array io
      write (buffer, *) this%vc
      if (trim (buffer(2:)) .ne. 'abcdefghijkl') stop 6
! Make sure that substrings work correctly
      write (buffer, *) this%vc(:)(2:3)
      if (trim (buffer(2:)) .ne. 'bcfgjk') stop 7
      write (buffer, *) this%vc(2:)(2:3)
      if (trim (buffer(2:)) .ne. 'fgjk') stop 8
    endif
  end subroutine test_bvec

  subroutine delete (this)
    class(bvec_t), intent(inout) :: this
    if (allocated (this%vc)) then
      deallocate (this%vc)
    endif
  end subroutine delete
end module bvec

program test
  use bvec
  type(bvec_t) :: a
  call a%create (.false.)
  call a%test_bvec
  call a%delete

  call a%create (.true.)
  call a%test_bvec
  call a%delete
end program test