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