Added a deep copy routine. Fixes #160

Added routines for getting the next, previous, and tail pointers. Fixes #161
Updated unit tests for the new routines.

Author: jacobwilliams

src/json_module.F90

@@ -510,15 +510,6 @@ end subroutine traverse_callback_func
     end interface json_get_child
     !*************************************************************************************
 
-    !*************************************************************************************
-    !>
-    !  Get the parent.
-    !  Returns a [[json_value]] pointer.
-    interface json_get_parent
-        module procedure json_value_get_parent
-    end interface json_get_parent
-    !*************************************************************************************
-
     !*************************************************************************************
     !>
     !  Add objects to a linked list of [[json_value]]s.
@@ -677,7 +668,7 @@ end subroutine traverse_callback_func
         module procedure MAYBEWRAP(json_value_remove_if_present)
     end interface
     !*************************************************************************************
-
+  
     !*************************************************************************************
     !>
     !  Allocate a [[json_value]] pointer and make it a double variable.
@@ -840,10 +831,14 @@ end subroutine traverse_callback_func
     public :: json_create_object         ! allocate a json_value object
     public :: json_create_string         ! allocate a json_value string
     public :: json_destroy               ! clear a JSON structure (destructor)
+    public :: json_clone                 ! clone a JSON structure (deep copy)
     public :: json_failed                ! check for error
     public :: json_get                   ! get data from the JSON structure
     public :: json_get_child             ! get a child of a json_value
-    public :: json_get_parent            ! get the parent of a json_value
+    public :: json_get_parent            ! get pointer to json_value parent
+    public :: json_get_next              ! get pointer to json_value next
+    public :: json_get_previous          ! get pointer to json_value previous
+    public :: json_get_tail              ! get pointer to json_value tail
     public :: json_info                  ! get info about a json_value
     public :: json_initialize            ! to initialize the module
     public :: json_parse                 ! read a JSON file and populate the structure
@@ -944,6 +939,112 @@ end subroutine traverse_callback_func
     contains
 !*****************************************************************************************
 
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 10/31/2015
+!
+!  Create a deep copy of a [[json_value]] linked-list structure.
+!
+!# Example
+!
+!```fortran
+!    program test
+!     use json_module
+!     implicit none
+!     type(json_value),pointer :: j1, j2
+!     call json_initialize()
+!     call json_parse('../files/inputs/test1.json',j1)
+!     call json_clone(j1,j2) !now have two independent copies
+!     call json_destroy(j1)  !destroys j1, but j2 remains
+!     call json_print(j2,'j2.json')
+!     call json_destroy(j2)
+!    end program test
+!```
+
+    subroutine json_clone(from,to)
+
+    implicit none
+
+    type(json_value),pointer :: from  !! this is the structure to clone
+    type(json_value),pointer :: to    !! the clone is put here 
+                                      !! (it must not already be associated)
+    
+    !call the main function:
+    call json_value_clone_func(from,to)   
+                                      
+    end subroutine json_clone
+!*****************************************************************************************
+
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 10/31/2015
+!
+!  Recursive deep copy function called by [[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)
+
+    implicit none
+
+    type(json_value),pointer          :: from     !! this is the structure to clone
+    type(json_value),pointer          :: to       !! the clone is put here 
+                                                  !! (it 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
+    
+    nullify(to)
+
+    if (associated(from)) then
+    
+        allocate(to)
+        
+        !copy over the data variables:
+        
+        if (allocated(from%name))      allocate(to%name,     source=from%name)
+        if (allocated(from%dbl_value)) allocate(to%dbl_value,source=from%dbl_value)
+        if (allocated(from%log_value)) allocate(to%log_value,source=from%log_value)
+        if (allocated(from%str_value)) allocate(to%str_value,source=from%str_value)
+        if (allocated(from%int_value)) allocate(to%int_value,source=from%int_value)
+        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
+        if (present(tail)) then
+            if (tail) to%parent%tail => to
+        end if
+        
+        if (associated(from%next)) then
+            allocate(to%next)
+            call json_value_clone_func(from%next,&
+                                       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))) 
+        end if
+        
+    end if
+
+    end subroutine json_value_clone_func
+!*****************************************************************************************
+
 !*****************************************************************************************
 !> author: Izaak Beekman
 !  date: 07/23/2015
@@ -954,8 +1055,8 @@ function initialize_json_file(p) result(file_object)
 
     implicit none
 
-    type(json_value), pointer, optional, intent(in) :: p    !! `json_value` object to cast
-                                                            !! as a `json_file` object
+    type(json_value),pointer,optional,intent(in) :: p  !! `json_value` object to cast
+                                                       !! as a `json_file` object
     type(json_file) :: file_object
 
     if (present(p)) file_object%p => p
@@ -3274,20 +3375,73 @@ end function json_count
 !  Returns a pointer to the parent of a [[json_value]].
 !  If there is no parent, then a null() pointer is returned.
 
-    subroutine json_value_get_parent(me,p)
+    subroutine json_get_parent(me,p)
 
     implicit none
 
     type(json_value),pointer,intent(in) :: me   !! JSON object
-    type(json_value),pointer            :: p    !! pointer to the parent
+    type(json_value),pointer,intent(out) :: p   !! pointer to parent
 
-    if (associated(me%parent)) then
-        p => me%parent
-    else
-        p => null()
-    end if
+    p => me%parent
+    
+    end subroutine json_get_parent
+!*****************************************************************************************
+
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 10/31/2015
+!
+!  Returns a pointer to the next of a [[json_value]].
+!  If there is no next, then a null() pointer is returned.
+
+    subroutine json_get_next(me,p)
+
+    implicit none
+
+    type(json_value),pointer,intent(in)  :: me   !! JSON object
+    type(json_value),pointer,intent(out) :: p    !! pointer to next
+    
+    p => me%next
+    
+    end subroutine json_get_next
+!*****************************************************************************************
+
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 10/31/2015
+!
+!  Returns a pointer to the previous of a [[json_value]].
+!  If there is no previous, then a null() pointer is returned.
+
+    subroutine json_get_previous(me,p)
+
+    implicit none
+
+    type(json_value),pointer,intent(in)  :: me   !! JSON object
+    type(json_value),pointer,intent(out) :: p    !! pointer to previous
+    
+    p => me%previous
+    
+    end subroutine json_get_previous
+!*****************************************************************************************
+
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 10/31/2015
+!
+!  Returns a pointer to the tail of a [[json_value]].
+!  If there is no tail, then a null() pointer is returned.
+
+    subroutine json_get_tail(me,p)
+
+    implicit none
+
+    type(json_value),pointer,intent(in) :: me    !! JSON object
+    type(json_value),pointer,intent(out) :: p    !! pointer to tail
+    
+    p => me%tail
 
-    end subroutine json_value_get_parent
+    end subroutine json_get_tail
 !*****************************************************************************************
 
 !*****************************************************************************************

src/tests/jf_test_2.f90

@@ -25,9 +25,12 @@ subroutine test_2(error_cnt)
 
     integer,intent(out) :: error_cnt
 
-    type(json_value),pointer    :: p, inp, traj
+    type(json_value),pointer :: p, inp, traj, p_tmp, p_integer_array, p_clone
 
     integer :: iunit
+    character(len=:),allocatable :: name
+    integer :: ival,ival_clone
+    logical :: found
 
     error_cnt = 0
     call json_initialize()
@@ -144,6 +147,101 @@ subroutine test_2(error_cnt)
         error_cnt = error_cnt + 1
     end if
     close(iunit)
+    
+    !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
+    else        
+        !now, change one and verify that they are independent:
+        call json_update(p_clone,'inputs.integer_scalar',100,found)
+        call json_get(p,'inputs.integer_scalar',ival)
+        call json_get(p_clone,'inputs.integer_scalar',ival_clone)
+        if (json_failed()) then
+            call json_print_error_message(error_unit)
+            error_cnt = error_cnt + 1
+        else
+            if (ival==1 .and. ival_clone==100) then
+                write(error_unit,'(A)') 'json_clone ... passed'
+            else
+                write(error_unit,'(A)') 'Error: ival /= ival_clone'
+                error_cnt = error_cnt + 1
+            end if
+        end if
+    end if
+    
+    !test some of the pointer routines:
+    write(error_unit,'(A)') 'Pointer routine tests'
+    call json_get(p,'inputs.integer_array',p_integer_array)
+    if (json_failed()) then
+        call json_print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    else
+    
+        !get parent test:
+        call json_get_parent(p_integer_array,p_tmp)  !should be "inputs"
+        call json_info(p_tmp,name=name)
+        if (json_failed()) then
+            call json_print_error_message(error_unit)
+            error_cnt = error_cnt + 1
+        else
+            if (name=='inputs') then
+                write(error_unit,'(A)') 'json_get_parent ... passed'
+            else
+                write(error_unit,'(A)') 'Error: parent should be "inputs", is actually: '//trim(name)
+                error_cnt = error_cnt + 1
+            end if
+        end if
+        
+        !get next test:
+        call json_get_next(p_integer_array,p_tmp)  !should be "names"
+        call json_info(p_tmp,name=name)
+        if (json_failed()) then
+            call json_print_error_message(error_unit)
+            error_cnt = error_cnt + 1
+        else
+            if (name=='names') then
+                write(error_unit,'(A)') 'json_get_next ... passed'
+            else
+                write(error_unit,'(A)') 'Error: next should be "names", is actually: '//trim(name)
+                error_cnt = error_cnt + 1
+            end if
+        end if
+        
+        !get previous test:
+        call json_get_previous(p_integer_array,p_tmp)  !should be "integer_scalar"
+        call json_info(p_tmp,name=name)
+        if (json_failed()) then
+            call json_print_error_message(error_unit)
+            error_cnt = error_cnt + 1
+        else
+            if (name=='integer_scalar') then
+                write(error_unit,'(A)') 'json_get_previous ... passed'
+            else
+                write(error_unit,'(A)') 'Error: next should be "integer_scalar", is actually: '//trim(name)
+                error_cnt = error_cnt + 1
+            end if
+        end if
+
+        !get tail test:
+        call json_get_tail(p_integer_array,p_tmp)  !should be 99, the last element in the array
+        call json_get(p_tmp,ival)
+        if (json_failed()) then
+            call json_print_error_message(error_unit)
+            error_cnt = error_cnt + 1
+        else
+            if (ival==99) then
+                write(error_unit,'(A)') 'json_get_tail ... passed'
+            else
+                write(error_unit,'(A,1X,I5)') 'Error: tail value should be 99, is actually: ',ival
+                error_cnt = error_cnt + 1
+            end if
+        end if
+
+    end if
 
     !cleanup:
     call json_destroy(p)