Merge pull request #335 from jacobwilliams/clone-fix

json_clone fix

Author: jacobwilliams

src/json_value_module.F90

@@ -1103,6 +1103,13 @@ end function name_strings_equal
 !
 !  Create a deep copy of a [[json_value]] linked-list structure.
 !
+!### Notes
+!
+!  * If `from` has children, then they are also cloned.
+!  * The parent of `from` is not linked to `to`.
+!  * If `from` is an element of an array, then the previous and
+!    next entries are not cloned (only that element and it's children, if any).
+!
 !### Example
 !
 !````fortran
@@ -1182,10 +1189,12 @@ recursive subroutine json_value_clone_func(from,to,parent,previous,next,children
         if (present(next))        to%next        => next
         if (present(children))    to%children    => children
         if (present(tail)) then
-            if (tail) to%parent%tail => to
+            if (tail .and. associated(to%parent)) to%parent%tail => to
         end if
 
-        if (associated(from%next)) then
+        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,&
@@ -2643,7 +2652,9 @@ recursive subroutine check_if_valid(p,require_parent)
 
             ! now, check next one:
             if (associated(p%next)) then
-                call check_if_valid(p%next,require_parent=require_parent)
+                ! if it's an element in an
+                ! array, then require a parent:
+                call check_if_valid(p%next,require_parent=.true.)
             end if
 
             if (associated(p%children)) then

src/tests/jf_test_33.F90

@@ -0,0 +1,112 @@
+!*****************************************************************************************
+!>
+!  Module for the 33rd unit test.
+
+module jf_test_33_mod
+
+    use json_module, rk => json_rk, lk => json_lk, ik => json_ik, ck => json_ck, cdk => json_cdk
+    use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
+
+    implicit none
+
+    private
+    public :: test_33
+
+contains
+
+    subroutine test_33(error_cnt)
+
+    !! Test the clone routine
+
+    implicit none
+
+    integer,intent(out) :: error_cnt
+
+    type(json_core) :: json
+    type(json_value),pointer :: p, p_var, p_var_clone
+    integer :: i !! counter
+    logical(LK) :: is_valid  !! True if the structure is valid.
+    character(kind=CK,len=:),allocatable :: error_msg !! if not valid, this will contain
+                                                      !! a description of the problem
+
+    character(kind=CK,len=*),parameter  :: json_string  = CK_'{ "struct": {"a": [{"b":1},{"b":2}]} }'
+
+    character(kind=CK,len=*),dimension(5),parameter :: keys = [ CK_'$            ',&
+                                                                CK_'struct       ',&
+                                                                CK_'struct.a     ',&
+                                                                CK_'struct.a(1)  ',&
+                                                                CK_'struct.a(1).b' ]
+
+    error_cnt = 0
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') '   TEST 33'
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') ''
+
+    call json%initialize()
+
+    call json%parse(p,json_string)
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    else
+
+        do i = 1, size(keys)
+            write(error_unit,'(A)') 'Cloning "'//trim(keys(i))//'" ...'
+            call json%get(p,trim(keys(i)),p_var)
+            if (json%failed()) then
+                call json%print_error_message(error_unit)
+                error_cnt = error_cnt + 1
+                exit
+            end if
+            call json%clone(p_var, p_var_clone)
+            if (json%failed()) then
+                call json%print_error_message(error_unit)
+                error_cnt = error_cnt + 1
+                exit
+            end if
+            call json%print(p_var_clone,output_unit)
+            call json%validate(p_var_clone,is_valid,error_msg)
+            if (.not. is_valid) then
+                error_cnt = error_cnt + 1
+                write(error_unit,*) error_msg
+            else
+                write(error_unit,*) '... Valid'
+            end if
+            call json%destroy(p_var_clone)    ! free memory
+            write(error_unit,*) ''
+        end do
+
+    end if
+
+    if (.not. json%failed() .and. error_cnt==0) then
+        write(error_unit,'(A)') 'Success!'
+    else
+        write(error_unit,'(A)') 'Test Failed!'
+    end if
+
+    call json%destroy(p)    ! free memory
+
+    end subroutine test_33
+
+end module jf_test_33_mod
+!*****************************************************************************************
+
+#ifndef INTERGATED_TESTS
+!*****************************************************************************************
+program jf_test_33
+
+    !! 33rd unit test.
+
+    use jf_test_33_mod , only: test_33
+    implicit none
+    integer :: n_errors
+    n_errors = 0
+    call test_33(n_errors)
+    if (n_errors /= 0) stop 1
+
+end program jf_test_33
+!*****************************************************************************************
+#endif