gcc/testsuite/gfortran.dg/finalize_44.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for all three variants of PR82996, which used to
   4 ! segfault in the original testcase and ICE in the testcases of
   5 ! comments 1 and 2.
   6 !
   7 ! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
   8 !
   9 module mod0
  10   integer :: final_count_foo = 0
  11   integer :: final_count_bar = 0
  12 end module mod0
  13 !
  14 ! This is the original testcase, with a final routine 'foo' but
  15 ! but not in the container type 'bar1'.
  16 !
  17 module mod1
  18   use mod0
  19   private foo, foo_destroy
  20   type foo
  21     integer, pointer :: f(:) => null()
  22   contains
  23     final :: foo_destroy
  24   end type
  25   type bar1
  26     type(foo) :: b(2)
  27   end type
  28 contains
  29   impure elemental subroutine foo_destroy(this)
  30     type(foo), intent(inout) :: this
  31     final_count_foo = final_count_foo + 1
  32     if (associated(this%f)) deallocate(this%f)
  33   end subroutine
  34 end module mod1
  35 !
  36 ! Comment 1 was the same as original, except that the
  37 ! 'foo' finalizer is elemental and a 'bar' finalizer is added..
  38 !
  39 module mod2
  40   use mod0
  41   private foo, foo_destroy, bar_destroy
  42   type foo
  43     integer, pointer :: f(:) => null()
  44   contains
  45     final :: foo_destroy
  46   end type
  47   type bar2
  48     type(foo) :: b(2)
  49   contains
  50     final :: bar_destroy
  51   end type
  52 contains
  53   impure elemental subroutine foo_destroy(this)
  54     type(foo), intent(inout) :: this
  55     final_count_foo = final_count_foo + 1
  56     if (associated(this%f)) deallocate(this%f)
  57   end subroutine
  58   subroutine bar_destroy(this)
  59     type(bar2), intent(inout) :: this
  60     final_count_bar = final_count_bar + 1
  61     call foo_destroy(this%b)
  62   end subroutine
  63 end module mod2
  64 !
  65 ! Comment 2 was the same as comment 1, except that the 'foo'
  66 ! finalizer is no longer elemental.
  67 !
  68 module mod3
  69   use mod0
  70   private foo, foo_destroy, bar_destroy
  71   type foo
  72     integer, pointer :: f(:) => null()
  73   contains
  74     final :: foo_destroy
  75   end type
  76   type bar3
  77     type(foo) :: b(2)
  78   contains
  79     final :: bar_destroy
  80   end type
  81 contains
  82   subroutine foo_destroy(this)
  83     type(foo), intent(inout) :: this
  84     final_count_foo = final_count_foo + 1
  85     if (associated(this%f)) deallocate(this%f)
  86   end subroutine
  87   subroutine bar_destroy(this)
  88     type(bar3), intent(inout) :: this
  89     final_count_bar = final_count_bar + 1
  90     do j = 1, size(this%b)
  91       call foo_destroy(this%b(j))
  92     end do
  93   end subroutine
  94 end module mod3
  95
  96 program main
  97   use mod0
  98   use mod1
  99   use mod2
 100   use mod3
 101   type(bar1) :: x
 102   type(bar2) :: y
 103   type(bar3) :: z
 104   call sub1(x)
 105   if (final_count_foo /= 2) stop 1
 106   if (final_count_bar /= 0) stop 2
 107   call sub2(y)
 108   if (final_count_foo /= 6) stop 3
 109   if (final_count_bar /= 1) stop 4
 110   call sub3(z)
 111   if (final_count_foo /= 8) stop 5
 112   if (final_count_bar /= 2) stop 6
 113 contains
 114   subroutine sub1(x)
 115     type(bar1), intent(out) :: x
 116   end subroutine
 117   subroutine sub2(x)
 118     type(bar2), intent(out) :: x
 119   end subroutine
 120   subroutine sub3(x)
 121     type(bar3), intent(out) :: x
 122   end subroutine
 123 end program