gcc/testsuite/gfortran.dg/alloc_comp_assign_16.f03

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR88393 in which a segfault occurred as indicated.
   4 !
   5 ! Contributed by Janus Weil  <janus@gcc.gnu.org>
   6 !
   7 module m
   8    implicit none
   9    type :: t
  10       character(len=:), allocatable :: cs
  11    contains
  12       procedure :: ass
  13       generic :: assignment(=) => ass
  14    end type
  15 contains
  16    subroutine ass(a, b)
  17       class(t), intent(inout) :: a
  18       class(t), intent(in)    :: b
  19       a%cs = b%cs
  20       print *, "ass"
  21    end subroutine
  22 end module
  23
  24 program p
  25    use m
  26    implicit none
  27    type :: t2
  28       type(t) :: c
  29    end type
  30    type(t2), dimension(1:2) :: arr
  31    arr(1)%c%cs = "abcd"
  32    arr(2)%c = arr(1)%c  ! Segfault here.
  33    print *, "done", arr(2)%c%cs, arr(2)%c%cs
  34 ! Make sure with valgrind that there are no memory leaks.
  35    deallocate (arr(1)%c%cs)
  36    deallocate (arr(2)%c%cs)
  37 end