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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
! { dg-do run }
!
! Tests functionality of recursive allocatable derived types.
!
module m
type :: stack
integer :: value
integer :: index
type(stack), allocatable :: next
end type stack
end module
use m
! Here is how to add a new entry at the top of the stack:
type (stack), allocatable :: top, temp, dum
call poke (1)
call poke (2)
call poke (3)
if (top%index .ne. 3) STOP 1
call output (top)
call pop
if (top%index .ne. 2) STOP 2
call output (top)
deallocate (top)
contains
subroutine output (arg)
type(stack), target, allocatable :: arg
type(stack), pointer :: ptr
if (.not.allocated (arg)) then
print *, "empty stack"
return
end if
print *, " idx value"
ptr => arg
do while (associated (ptr))
print *, ptr%index, " ", ptr%value
ptr => ptr%next
end do
end subroutine
subroutine poke(arg)
integer :: arg
integer :: idx
if (allocated (top)) then
idx = top%index + 1
else
idx = 1
end if
allocate (temp)
temp%value = arg
temp%index = idx
call move_alloc(top,temp%next)
call move_alloc(temp,top)
end subroutine
subroutine pop
call move_alloc(top%next,temp)
call move_alloc(temp,top)
end subroutine
end
|