! { dg-do run } ! ! Test the fix for PR84523. ! ! Contributed by Harald Anlauf ! program gfcbug148 implicit none integer, parameter :: nspots = 80 type t_spot real, allocatable :: vm(:,:,:) end type t_spot type t_rowcol integer :: nh type(t_spot), pointer :: spots(:) => NULL () end type t_rowcol type(t_rowcol) :: col call construct (col, nspots) call destruct (col) !======================================================================== contains !======================================================================== subroutine construct (rc, nh) type(t_rowcol) ,intent(out) :: rc ! row or column to set integer ,intent(in) :: nh ! number of spots in a row rc%nh = nh allocate (rc%spots(nh)) end subroutine construct !------------------------------------------------------------------------ subroutine destruct (rc) type(t_rowcol) ,intent(inout) :: rc ! row or column to free integer :: k if (associated (rc%spots)) then if (size(rc%spots) .ne. nspots) stop 1 do k=1, size(rc% spots) if (allocated (rc%spots(k)%vm)) stop 2 ! Would segfault in runtime. end do deallocate (rc%spots) endif nullify (rc%spots) end subroutine destruct end program gfcbug148