1! { dg-do compile } 2! { dg-options "-fdump-tree-original" } 3! 4! Test the fix for PR82375. This is a wrinkle on the the allocatable 5! version of pdt_13.f03, pdt_14.f03, whereby 'root' is now declared 6! in a subroutine so that it should be cleaned up automatically. This 7! is best tested with valgrind or its like. 8! In addition, the field 'n' has now become a parameterized length 9! array to verify that the combination of allocatable components and 10! parameterization works correctly. 11! 12! Based on contribution by Ian Chivers <ian@rhymneyconsulting.co.uk> 13! 14module precision_module 15 implicit none 16 integer, parameter :: sp = selected_real_kind(6, 37) 17 integer, parameter :: dp = selected_real_kind(15, 307) 18 integer, parameter :: qp = selected_real_kind( 30, 291) 19end module precision_module 20 21module link_module 22 use precision_module 23 24 type link(real_kind, mat_len) 25 integer, kind :: real_kind 26 integer, len :: mat_len 27 real (kind=real_kind) :: n(mat_len) 28 type (link(real_kind, :)), allocatable :: next 29 end type link 30 31contains 32 33 function push_8 (self, arg) result(current) 34 real(dp) :: arg 35 type (link(real_kind=dp, mat_len=:)), allocatable, target :: self 36 type (link(real_kind=dp, mat_len=:)), pointer :: current 37 38 if (allocated (self)) then 39 current => self 40 do while (allocated (current%next)) 41 current => current%next 42 end do 43 44 allocate (link(real_kind=dp, mat_len=1) :: current%next) 45 current => current%next 46 else 47 allocate (link(real_kind=dp, mat_len=1) :: self) 48 current => self 49 end if 50 51 current%n(1) = arg 52 53 end function push_8 54 55 function pop_8 (self) result(res) 56 type (link(real_kind=dp, mat_len=:)), allocatable, target :: self 57 type (link(real_kind=dp, mat_len=:)), pointer:: current => NULL() 58 type (link(real_kind=dp, mat_len=:)), pointer :: previous => NULL() 59 real(dp) :: res 60 61 res = 0.0_8 62 if (allocated (self)) then 63 current => self 64 previous => self 65 do while (allocated (current%next)) 66 previous => current 67 current => current%next 68 end do 69 res = current%n(1) 70 if (.not.allocated (previous%next)) then 71 deallocate (self) 72 else 73 deallocate (previous%next) 74 end if 75 76 end if 77 end function pop_8 78 79end module link_module 80 81program ch2701 82 use precision_module 83 use link_module 84 implicit none 85 integer, parameter :: wp = dp 86 87 call foo 88contains 89 90 subroutine foo 91 type (link(real_kind=wp, mat_len=:)), allocatable :: root 92 type (link(real_kind=wp, mat_len=:)), pointer :: current => NULL() 93 94 current => push_8 (root, 1.0_8) 95 current => push_8 (root, 2.0_8) 96 current => push_8 (root, 3.0_8) 97 98 if (int (pop_8 (root)) .ne. 3) STOP 1 99 if (int (pop_8 (root)) .ne. 2) STOP 2 100 if (int (pop_8 (root)) .ne. 1) STOP 3 101! if (int (pop_8 (root)) .ne. 0) STOP 4 102 end subroutine 103end program ch2701 104! { dg-final { scan-tree-dump-times "Pdtlink_8._deallocate " 5 "original" } } 105! { dg-final { scan-tree-dump-times ".n.data = 0B" 8 "original" } } 106! { dg-final { scan-tree-dump-times "__builtin_free" 14 "original" } } 107