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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
! { dg-do run }
!
! Test the fix for PR82375
!
! Based on contribution by Ian Chivers <ian@rhymneyconsulting.co.uk>
!
module precision_module
implicit none
integer, parameter :: sp = selected_real_kind(6, 37)
integer, parameter :: dp = selected_real_kind(15, 307)
integer, parameter :: qp = selected_real_kind( 30, 291)
end module precision_module
module link_module
use precision_module
type link(real_kind)
integer, kind :: real_kind
real (kind=real_kind) :: n
type (link(real_kind)), pointer :: next => NULL()
end type link
contains
function push_8 (self, arg) result(current)
real(dp) :: arg
type (link(real_kind=dp)), pointer :: self
type (link(real_kind=dp)), pointer :: current
if (associated (self)) then
current => self
do while (associated (current%next))
current => current%next
end do
allocate (current%next)
current => current%next
else
allocate (current)
self => current
end if
current%n = arg
current%next => NULL ()
end function push_8
function pop_8 (self) result(res)
type (link(real_kind=dp)), pointer :: self
type (link(real_kind=dp)), pointer :: current => NULL()
type (link(real_kind=dp)), pointer :: previous => NULL()
real(dp) :: res
res = 0.0_8
if (associated (self)) then
current => self
do while (associated (current) .and. associated (current%next))
previous => current
current => current%next
end do
previous%next => NULL ()
res = current%n
if (associated (self, current)) then
deallocate (self)
else
deallocate (current)
end if
end if
end function pop_8
end module link_module
program ch2701
use precision_module
use link_module
implicit none
integer, parameter :: wp = dp
type (link(real_kind=wp)), pointer :: root => NULL()
type (link(real_kind=wp)), pointer :: current
current => push_8 (root, 1.0_8)
current => push_8 (root, 2.0_8)
current => push_8 (root, 3.0_8)
if (int (pop_8 (root)) .ne. 3) STOP 1
if (int (pop_8 (root)) .ne. 2) STOP 2
if (int (pop_8 (root)) .ne. 1) STOP 3
if (int (pop_8 (root)) .ne. 0) STOP 4
end program ch2701
|
