Non-recursive deep copy function that clones a json_value structure. This is an alternative to json_value_clone_func that uses iteration instead of recursion.
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) |
subroutine json_value_clone_func_nonrecursive(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) type :: clone_task !! Stack entry for tracking clone operations type(json_value),pointer :: from => null() !! from node type(json_value),pointer :: to => null() !! to node type(json_value),pointer :: parent => null() !! parent node type(json_value),pointer :: previous => null() !! previous node logical :: is_tail = .false. !! if `to` is the tail of its parent's children logical :: is_allocated = .false. !! if `to` has been allocated yet end type clone_task type(clone_task),dimension(:),allocatable :: stack !! stack for tracking tasks integer(IK) :: stack_size !! current stack size integer(IK) :: p !! current stack pointer type(clone_task) :: c !! current task type(json_value),pointer :: new !! newly allocated node integer(IK),parameter :: initial_stack_size = 256_IK !! initial stack size nullify(to) if (.not. associated(from)) return ! Initialize stack with a reasonable size stack_size = initial_stack_size allocate(stack(stack_size)) ! Push the initial task onto the stack p = 1_IK stack(p)%from => from stack(p)%to => null() stack(p)%is_allocated = .false. stack(p)%parent => null() stack(p)%previous => null() stack(p)%is_tail = .false. ! Process stack iteratively do while (p > 0_IK) ! Pop from stack c = stack(p) p = p - 1_IK ! Allocate the to if not already done if (.not. c%is_allocated) then allocate(new) ! Copy over the data variables if (allocated(c%from%name)) new%name = c%from%name if (allocated(c%from%dbl_value)) allocate(new%dbl_value,source=c%from%dbl_value) if (allocated(c%from%log_value)) allocate(new%log_value,source=c%from%log_value) if (allocated(c%from%str_value)) new%str_value = c%from%str_value if (allocated(c%from%int_value)) allocate(new%int_value,source=c%from%int_value) new%var_type = c%from%var_type new%n_children = c%from%n_children ! Set up parent/previous/tail pointers if (associated(c%parent)) new%parent => c%parent if (associated(c%previous)) new%previous => c%previous if (c%is_tail .and. associated(new%parent)) new%parent%tail => new ! Link this node to the output structure if (associated(c%previous)) then ! This is a next sibling c%previous%next => new else if (associated(c%parent)) then ! This is the first child c%parent%children => new else ! This is the root node to => new end if ! Push children onto stack (if any) if (associated(c%from%children)) then call resize_stack(stack, stack_size) p = p + 1_IK stack(p)%from => c%from%children stack(p)%to => null() stack(p)%previous => null() stack(p)%parent => new stack(p)%is_tail = (.not. associated(c%from%children%next)) stack(p)%is_allocated = .false. end if ! Push next sibling onto stack (if any and parent exists) if (associated(c%from%next) .and. & associated(c%parent)) then call resize_stack(stack, stack_size) p = p + 1_IK stack(p)%from => c%from%next stack(p)%to => null() stack(p)%previous => new stack(p)%parent => c%parent stack(p)%is_tail = (.not. associated(c%from%next%next)) stack(p)%is_allocated = .false. end if end if end do deallocate(stack) ! clean up contains subroutine resize_stack(stk, stk_size) !! Resize the stack if needed. type(clone_task),dimension(:),allocatable,intent(inout) :: stk integer(IK),intent(inout) :: stk_size type(clone_task),dimension(:),allocatable :: tmp integer(IK) :: new_size if (p + 1_IK > stack_size) then new_size = stk_size * 2_IK allocate(tmp(new_size)) tmp(1:stk_size) = stk call move_alloc(tmp, stk) stk_size = new_size end if end subroutine resize_stack end subroutine json_value_clone_func_nonrecursive