gcc/testsuite/gfortran.dg/pdt_26.f03

   1 ! { dg-do run }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! Test the fix for PR83567 in which the parameterized component 'foo' was
   5 ! being deallocated before return from 'addw', with consequent segfault in
   6 ! the main program.
   7 !
   8 ! Contributed by Berke Durak  <berke.durak@gmail.com>
   9 ! The function 'addvv' has been made elemental so that the test can check that
  10 ! arrays are correctly treated and that no memory leaks occur.
  11 !
  12 module pdt_m
  13   implicit none
  14   type :: vec(k)
  15      integer, len :: k=3
  16      integer :: foo(k)=[1,2,3]
  17   end type vec
  18 contains
  19   elemental function addvv(a,b) result(c)
  20     type(vec(k=*)), intent(in) :: a
  21     type(vec(k=*)), intent(in) :: b
  22     type(vec(k=a%k)) :: c
  23
  24     c%foo=a%foo+b%foo
  25   end function
  26 end module pdt_m
  27
  28 program test_pdt
  29   use pdt_m
  30   implicit none
  31   type(vec) :: u,v,w, a(2), b(2), c(2)
  32   integer :: i
  33
  34   u%foo=[1,2,3]
  35   v%foo=[2,3,4]
  36   w=addvv(u,v)
  37   if (any (w%foo .ne. [3,5,7])) STOP 1
  38   do i = 1 , a(1)%k
  39     a%foo(i) = i + 4
  40     b%foo(i) = i + 7
  41   end do
  42   c = addvv(a,b)
  43   if (any (c(1)%foo .ne. [13,15,17])) STOP 2
  44 end program test_pdt
  45 ! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } }
  46 ! { dg-final { scan-tree-dump-times "__builtin_malloc" 9 "original" } }