1! { dg-do run } 2! 3! Test the fix for PR84523. 4! 5! Contributed by Harald Anlauf <anlauf@gmx.de> 6! 7program 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 !======================================================================== 21contains 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 42end program gfcbug148 43