mirror of
https://github.com/autc04/Retro68.git
synced 2024-06-28 11:30:19 +00:00
43 lines
1.3 KiB
Fortran
43 lines
1.3 KiB
Fortran
! { dg-do run }
|
|
!
|
|
! Test the fix for PR84523.
|
|
!
|
|
! Contributed by Harald Anlauf <anlauf@gmx.de>
|
|
!
|
|
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
|