blob: 69b9c27e5039fcdfbfb9cf705df25ea7f276e589 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
! { 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
|
