1! { dg-do run }
2!
3! Test the fix for PR82375
4!
5! Based on contribution by Ian Chivers  <ian@rhymneyconsulting.co.uk>
6!
7module precision_module
8  implicit none
9  integer, parameter :: sp = selected_real_kind(6, 37)
10  integer, parameter :: dp = selected_real_kind(15, 307)
11  integer, parameter :: qp = selected_real_kind( 30, 291)
12end module precision_module
13
14module link_module
15  use precision_module
16
17  type link(real_kind)
18    integer, kind :: real_kind
19    real (kind=real_kind) :: n
20    type (link(real_kind)), pointer :: next => NULL()
21  end type link
22
23contains
24
25  function push_8 (self, arg) result(current)
26    real(dp) :: arg
27    type (link(real_kind=dp)), pointer :: self
28    type (link(real_kind=dp)), pointer :: current
29
30    if (associated (self)) then
31      current => self
32      do while (associated (current%next))
33        current => current%next
34      end do
35
36      allocate (current%next)
37      current => current%next
38    else
39      allocate (current)
40      self => current
41    end if
42
43    current%n = arg
44    current%next => NULL ()
45  end function push_8
46
47  function pop_8 (self) result(res)
48    type (link(real_kind=dp)), pointer :: self
49    type (link(real_kind=dp)), pointer :: current => NULL()
50    type (link(real_kind=dp)), pointer :: previous => NULL()
51    real(dp) :: res
52
53    res = 0.0_8
54    if (associated (self)) then
55      current => self
56      do while (associated (current) .and. associated (current%next))
57         previous => current
58         current => current%next
59      end do
60
61      previous%next => NULL ()
62
63      res = current%n
64      if (associated (self, current)) then
65        deallocate (self)
66      else
67        deallocate (current)
68      end if
69
70    end if
71  end function pop_8
72
73end module link_module
74
75program ch2701
76  use precision_module
77  use link_module
78  implicit none
79  integer, parameter :: wp = dp
80  type (link(real_kind=wp)), pointer :: root => NULL()
81  type (link(real_kind=wp)), pointer :: current
82
83  current => push_8 (root, 1.0_8)
84  current => push_8 (root, 2.0_8)
85  current => push_8 (root, 3.0_8)
86
87  if (int (pop_8 (root)) .ne. 3) STOP 1
88  if (int (pop_8 (root)) .ne. 2) STOP 2
89  if (int (pop_8 (root)) .ne. 1) STOP 3
90  if (int (pop_8 (root)) .ne. 0) STOP 4
91
92end program ch2701
93