gcc/testsuite/gfortran.dg/class_result_7.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 !  Test the fix for PR80477
   5 !
   6 ! Contributed by Stefano Zaghi  <stefano.zaghi@cnr.it>
   7 !
   8 module a_type_m
   9    implicit none
  10    type :: a_type_t
  11       real :: x
  12    endtype
  13 contains
  14    subroutine assign_a_type(lhs, rhs)
  15       type(a_type_t), intent(inout) :: lhs
  16       type(a_type_t), intent(in)    :: rhs
  17       lhs%x = rhs%x
  18    end subroutine
  19
  20    function add_a_type(lhs, rhs) result( res )
  21       type(a_type_t), intent(in)  :: lhs
  22       type(a_type_t), intent(in)  :: rhs
  23       class(a_type_t), allocatable :: res
  24       allocate (a_type_t :: res)
  25       res%x = lhs%x + rhs%x
  26    end function
  27 end module
  28
  29 program polymorphic_operators_memory_leaks
  30    use a_type_m
  31    implicit none
  32    type(a_type_t) :: a = a_type_t(1) , b = a_type_t(2)
  33    call assign_a_type (a, add_a_type(a,b))              ! generated a memory leak
  34 end
  35 ! { dg-final { scan-tree-dump-times "builtin_free" 1 "original" } }
  36 ! { dg-final { scan-tree-dump-times "builtin_malloc" 1 "original" } }