! { dg-do run } ! ! Test the fix for PR82375. This is the allocatable version of pdt_13.f03. ! ! Based on contribution by Ian Chivers ! 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)), allocatable :: next end type link contains function push_8 (self, arg) result(current) real(dp) :: arg type (link(real_kind=dp)), allocatable, target :: self type (link(real_kind=dp)), pointer :: current if (allocated (self)) then current => self do while (allocated (current%next)) current => current%next end do allocate (current%next) current => current%next else allocate (self) current => self end if current%n = arg end function push_8 function pop_8 (self) result(res) type (link(real_kind=dp)), allocatable, target :: self type (link(real_kind=dp)), pointer:: current type (link(real_kind=dp)), pointer :: previous real(dp) :: res res = 0.0_8 if (allocated (self)) then current => self previous => self do while (allocated (current%next)) previous => current current => current%next end do res = current%n if (.not.allocated (previous%next)) then deallocate (self) else deallocate (previous%next) 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)), allocatable :: root 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