Recursive deep copy function called by json_clone.
If new data is added to the json_value type, then this would need to be updated.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
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), | optional | pointer | :: | parent | to%parent |
|
type(json_value), | optional | pointer | :: | previous | to%previous |
|
logical, | optional | :: | tail | if “to” is the tail of its parent’s children |
recursive subroutine json_value_clone_func(from,to,parent,previous,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
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:
! [note: the allocate() statements don't work here for the
! deferred-length characters in gfortran-4.9]
if (allocated(from%name)) to%name = 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)) to%str_value = 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(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
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
call json_value_clone_func(from = from%children,&
to = to%children,&
parent = to,&
tail = (.not. associated(from%children%next)))
end if
end if
end subroutine json_value_clone_func