gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! PR 42647: Missed initialization/dealloc of allocatable scalar DT with allocatable component
   5 !
   6 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   7
   8 module m
   9 type st
  10   integer , allocatable :: a1
  11 end type st
  12 type at
  13   integer , allocatable :: a2(:)
  14 end type at
  15
  16 type t1
  17   type(st), allocatable :: b1
  18 end type t1
  19 type t2
  20   type(st), allocatable :: b2(:)
  21 end type t2
  22 type t3
  23   type(at), allocatable :: b3
  24 end type t3
  25 type t4
  26   type(at), allocatable :: b4(:)
  27 end type t4
  28 end module m
  29
  30 use m
  31 block ! Start new scoping unit as otherwise the vars are implicitly SAVEd
  32 type(t1) :: na1, a1, aa1(:)
  33 type(t2) :: na2, a2, aa2(:)
  34 type(t3) :: na3, a3, aa3(:)
  35 type(t4) :: na4, a4, aa4(:)
  36
  37 allocatable :: a1, a2, a3, a4, aa1, aa2, aa3,aa4
  38
  39 if(allocated(a1)) call abort()
  40 if(allocated(a2)) call abort()
  41 if(allocated(a3)) call abort()
  42 if(allocated(a4)) call abort()
  43 if(allocated(aa1)) call abort()
  44 if(allocated(aa2)) call abort()
  45 if(allocated(aa3)) call abort()
  46 if(allocated(aa4)) call abort()
  47
  48 if(allocated(na1%b1)) call abort()
  49 if(allocated(na2%b2)) call abort()
  50 if(allocated(na3%b3)) call abort()
  51 if(allocated(na4%b4)) call abort()
  52 end block
  53 end
  54
  55 ! { dg-final { scan-tree-dump-times "__builtin_free" 32 "original" } }
  56 ! { dg-final { cleanup-tree-dump "original" } }