Merge pull request #490 from jacobwilliams/489-clone-leak-fix

489 clone leak fix

Author: jacobwilliams

Diff for: src/json_value_module.F90

@@ -1321,7 +1321,7 @@ end subroutine json_clone
 !@note If new data is added to the [[json_value]] type,
 !      then this would need to be updated.
 
-    recursive subroutine json_value_clone_func(from,to,parent,previous,next,children,tail)
+    recursive subroutine json_value_clone_func(from,to,parent,previous,tail)
 
     implicit none
 
@@ -1330,8 +1330,6 @@ recursive subroutine json_value_clone_func(from,to,parent,previous,next,children
                                                   !! must not already be associated)
     type(json_value),pointer,optional :: parent   !! to%parent
     type(json_value),pointer,optional :: previous !! to%previous
-    type(json_value),pointer,optional :: next     !! to%next
-    type(json_value),pointer,optional :: children !! to%children
     logical,optional                  :: tail     !! if "to" is the tail of
                                                   !! its parent's children
 
@@ -1352,33 +1350,28 @@ recursive subroutine json_value_clone_func(from,to,parent,previous,next,children
         to%var_type   = from%var_type
         to%n_children = from%n_children
 
-        !allocate and associate the pointers as necessary:
-
-        if (present(parent))      to%parent      => parent
-        if (present(previous))    to%previous    => previous
-        if (present(next))        to%next        => next
-        if (present(children))    to%children    => children
+        ! allocate and associate the pointers as necessary:
+        if (present(parent))   to%parent   => parent
+        if (present(previous)) to%previous => previous
         if (present(tail)) then
             if (tail .and. associated(to%parent)) to%parent%tail => to
         end if
 
         if (associated(from%next) .and. associated(to%parent)) then
             ! we only clone the next entry in an array
             ! if the parent has also been cloned
-            allocate(to%next)
-            call json_value_clone_func(from%next,&
-                                       to%next,&
-                                       previous=to,&
-                                       parent=to%parent,&
-                                       tail=(.not. associated(from%next%next)))
+            call json_value_clone_func(from     = from%next,&
+                                       to       = to%next,&
+                                       previous = to,&
+                                       parent   = to%parent,&
+                                       tail     = (.not. associated(from%next%next)))
         end if
 
         if (associated(from%children)) then
-            allocate(to%children)
-            call json_value_clone_func(from%children,&
-                                       to%children,&
-                                       parent=to,&
-                                       tail=(.not. associated(from%children%next)))
+            call json_value_clone_func(from   = from%children,&
+                                       to     = to%children,&
+                                       parent = to,&
+                                       tail   = (.not. associated(from%children%next)))
         end if
 
     end if

Diff for: src/tests/jf_test_48.F90

@@ -0,0 +1,103 @@
+!*****************************************************************************************
+!>
+!  Module for the 48th unit test.
+
+module jf_test_48_mod
+
+    use json_module, wp => json_RK, IK => json_IK, LK => json_LK
+    use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
+
+    implicit none
+
+    private
+    public :: test_48
+
+    character(len=*),parameter :: filename = '../files/inputs/big.json' !! large file to open
+
+contains
+
+    subroutine test_48(error_cnt)
+
+    !! Clone test
+
+    implicit none
+
+    integer,intent(out) :: error_cnt
+
+    type(json_value),pointer :: p, p_clone
+    type(json_core) :: json  !! factory for manipulating `json_value` pointers
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') '   EXAMPLE 48'
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') ''
+
+    error_cnt = 0
+    call json%initialize()
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1    
+    end if
+
+    write(error_unit,'(A)') 'open file'
+    call json%load(filename, p)
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+
+    !test the deep copy routine:
+    write(error_unit,'(A)') 'json_clone test'
+    call json%clone(p,p_clone)
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+
+    call json%destroy(p)
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+
+    call json%destroy(p_clone)
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+
+    if (error_cnt==0) then
+        write(error_unit,'(A)') 'Success'
+    else
+        write(error_unit,'(A)') 'Failed'
+    end if 
+
+    write(error_unit,'(A)') ''
+
+    end subroutine test_48
+
+end module jf_test_48_mod
+!*****************************************************************************************
+
+!*****************************************************************************************
+#ifndef INTEGRATED_TESTS
+program jf_test_48
+
+    !! clone test
+
+    use jf_test_48_mod , only: test_48
+    implicit none
+    integer :: n_errors
+    integer :: i !! counter
+
+    integer,parameter :: n_repeat = 1 !! number of times to repeat the test
+
+    do i = 1, n_repeat
+        call test_48(n_errors)
+        if (n_errors /= 0) stop 1
+    end do
+
+end program jf_test_48
+#endif
+!*****************************************************************************************