gcc/testsuite/gfortran.dg/move_alloc_16.f90

   1 ! { dg-do run }
   2 !
   3 ! Tests the fix for PR67177 in which MOVE_ALLOC was not assigning the string
   4 ! length for deferred length characters.
   5 !
   6 ! Contributed by <templed@tcd.ie>
   7 !
   8 program str
   9   implicit none
  10
  11   type string
  12     character(:), Allocatable :: text
  13   end type string
  14
  15   type strings
  16     type(string), allocatable, dimension(:) :: strlist
  17   end type strings
  18
  19   type(strings) :: teststrs
  20   type(string) :: tmpstr
  21   integer :: strlen = 20
  22
  23   allocate (teststrs%strlist(1))
  24   allocate (character(len=strlen) :: tmpstr%text)
  25
  26   allocate (character(len=strlen) :: teststrs%strlist(1)%text)
  27
  28 ! Full string reference was required because reallocation on assignment is
  29 ! functioning when it should not if the lhs is a substring - PR67977
  30   tmpstr%text(1:3) = 'foo'
  31
  32   if (.not.allocated (teststrs%strlist(1)%text)) call abort
  33   if (len (tmpstr%text) .ne. strlen) call abort
  34
  35   call move_alloc(tmpstr%text,teststrs%strlist(1)%text)
  36
  37   if (.not.allocated (teststrs%strlist(1)%text)) call abort
  38   if (len (teststrs%strlist(1)%text) .ne. strlen) call abort
  39   if (trim (teststrs%strlist(1)%text(1:3)) .ne. 'foo') call abort
  40
  41 ! Clean up so that valgrind reports all allocated memory freed.
  42   if (allocated (teststrs%strlist(1)%text)) deallocate (teststrs%strlist(1)%text)
  43   if (allocated (teststrs%strlist)) deallocate (teststrs%strlist)
  44 end program str