gcc/testsuite/gfortran.dg/pr84523.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR84523.
   4 !
   5 ! Contributed by Harald Anlauf  <anlauf@gmx.de>
   6 !
   7 program gfcbug148
   8   implicit none
   9   integer, parameter :: nspots = 80
  10   type t_spot
  11     real, allocatable     :: vm(:,:,:)
  12   end type t_spot
  13   type t_rowcol
  14     integer               :: nh
  15     type(t_spot), pointer :: spots(:) => NULL ()
  16   end type t_rowcol
  17   type(t_rowcol)          :: col
  18   call construct (col, nspots)
  19   call destruct  (col)
  20   !========================================================================
  21 contains
  22   !========================================================================
  23   subroutine construct (rc, nh)
  24     type(t_rowcol) ,intent(out) :: rc   ! row or column to set
  25     integer        ,intent(in)  :: nh   ! number of spots in a row
  26     rc%nh = nh
  27     allocate (rc%spots(nh))
  28   end subroutine construct
  29   !------------------------------------------------------------------------
  30   subroutine destruct (rc)
  31     type(t_rowcol) ,intent(inout) :: rc   ! row or column to free
  32     integer :: k
  33     if (associated (rc%spots)) then
  34       if (size(rc%spots) .ne. nspots) stop 1
  35       do k=1, size(rc% spots)
  36         if (allocated (rc%spots(k)%vm)) stop 2  ! Would segfault in runtime.
  37       end do
  38       deallocate (rc%spots)
  39     endif
  40     nullify (rc%spots)
  41   end subroutine destruct
  42 end program gfcbug148