added new json_value_insert_after routine.

added unit test.

Author: jacobwilliams

src/json_value_module.F90

@@ -518,10 +518,12 @@ module json_value_module
         procedure,public :: print_error_message => json_print_error_message !! simply routine to print error messages
         procedure,public :: swap                => json_value_swap          !! Swap two [[json_value]] pointers
                                                                             !! in a structure (or two different structures).
-        procedure,public :: is_child_of         => json_value_is_child_of   !! Check if a [[json_value]] is a child of another.
+        procedure,public :: is_child_of         => json_value_is_child_of   !! Check if a [[json_value]] is a descendant of another.
         procedure,public :: validate            => json_value_validate      !! Check that a [[json_value]] linked list is valid
                                                                             !! (i.e., is properly constructed). This may be
                                                                             !! useful if it has been constructed externally.
+        procedure,public :: insert_after        => json_value_insert_after  !! insert a new element after an existing one,
+                                                                            !! updating the JSON structure accordingly
 
         !other private routines:
         procedure :: name_equal
@@ -2375,7 +2377,7 @@ subroutine json_update_string(json,p,name,val,found)
         case default
             found = .false.
             call json%throw_exception('Error in json_update_string: '//&
-                                 'the variable is not a scalar value')
+                                      'the variable is not a scalar value')
         end select
 
     else
@@ -2481,6 +2483,72 @@ subroutine json_value_add_member(json,p,member)
     end subroutine json_value_add_member
 !*****************************************************************************************
 
+!*****************************************************************************************
+!>
+!  Inserts `new` after `p`, and updates the JSON structure accordingly.
+!
+!### Example
+!
+!````fortran
+!  program test
+!   use json_module
+!   implicit none
+!   logical(json_LK) :: found
+!   type(json_core) :: json
+!   type(json_value),pointer :: p,new,element
+!   call json%parse(file='myfile.json', p=p)
+!   call json%get(p,'x(3)',element,found) ! get pointer to an array element in the file
+!   call json%create_integer(new,1,'')    ! create a new element
+!   call json%insert_after(element,new)   ! insert new element after x(3)
+!   call json%print(p,'myfile2.json')     ! write it to a file
+!   call json%destroy(p)                  ! cleanup
+!  end program test
+!````
+!
+!@note This routine can be used to insert a new element
+!      into an array or object at a specific index.
+
+    subroutine json_value_insert_after(json,p,element)
+
+    implicit none
+
+    class(json_core),intent(inout) :: json
+    type(json_value),pointer       :: p       !! a value from a JSON structure
+                                              !! (presumably, this is a child of
+                                              !! an object or array).
+    type(json_value),pointer       :: element !! the element to insert after `p`
+
+    type(json_value),pointer :: parent  !! the parent of `p`
+
+    if (.not. json%exception_thrown) then
+
+        parent => p%parent
+
+        if (associated(parent)) then
+            element%parent => parent
+            parent%n_children = parent%n_children + 1
+            ! if p is last in list have to update parent tail:
+            if (associated(parent%tail,p)) parent%tail => element
+        else
+            element%parent => null()
+        end if
+
+        !if are there any in the list after p:
+        if (associated(p%next)) then
+            element%next => p%next
+            element%next%previous => element
+        else
+            element%next => null()
+        end if
+
+        p%next => element
+        element%previous => p
+
+    end if
+
+    end subroutine json_value_insert_after
+!*****************************************************************************************
+
 !*****************************************************************************************
 !> author: Jacob Williams
 !  date: 1/19/2014

src/tests/jf_test_20.f90

@@ -0,0 +1,125 @@
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 7/17/2016
+!
+!  Test the `insert` routine.
+
+module jf_test_20_mod
+
+    use json_module, lk => json_lk, rk => json_rk, ik => json_ik,&
+                     ck => json_ck, cdk => json_cdk
+    use, intrinsic :: iso_fortran_env , only: error_unit,output_unit
+
+    implicit none
+
+contains
+
+    subroutine test_20(error_cnt)
+
+    implicit none
+
+    integer,intent(out) :: error_cnt !! report number of errors to caller
+
+    type(json_core) :: json
+    type(json_value),pointer :: p,new,element
+    logical(lk) :: found,is_valid
+    integer(IK),dimension(:),allocatable :: iarray
+    character(kind=CK,len=:),allocatable :: error_msg
+
+    character(kind=CK,len=*),parameter :: json_example = '{"x":[1,2,3,4]}'
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') '   TEST 20'
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') ''
+
+    error_cnt = 0
+
+    call json%parse(p,json_example)
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    else
+
+        !insert one in the middle:
+        nullify(element)
+        call json%get(p,'x(3)',element) ! get pointer to an array element in the file
+        if (json%failed()) then
+            call json%print_error_message(error_unit)
+            error_cnt = error_cnt + 1
+        else
+            call json%create_integer(new,33,'')   ! create a new element
+            call json%insert_after(element,new)   ! insert new element after x(3)
+            if (json%failed()) then
+                call json%print_error_message(error_unit)
+                error_cnt = error_cnt + 1
+            else
+                call json%get(p,'x',iarray)
+                if (.not. all(iarray==[1,2,3,33,4])) then
+                    write(error_unit,'(A,1x,*(I2,1X))') 'Error: unexpected output:',iarray
+                    error_cnt = error_cnt + 1
+                else
+                    write(error_unit,'(A,1x,*(I2,1X))') 'Success:',iarray
+                end if
+            end if
+        end if
+
+        !insert one at the end:
+        nullify(element)
+        call json%get(p,'x(5)',element) ! get pointer to an array element in the file
+        if (json%failed()) then
+            call json%print_error_message(error_unit)
+            error_cnt = error_cnt + 1
+        else
+            call json%create_integer(new,44,'')   ! create a new element
+            call json%insert_after(element,new)   ! insert new element after x(3)
+            if (json%failed()) then
+                call json%print_error_message(error_unit)
+                error_cnt = error_cnt + 1
+            else
+                call json%get(p,'x',iarray)
+                if (.not. all(iarray==[1,2,3,33,4,44])) then
+                    write(error_unit,'(A,1x,*(I2,1X))') 'Error: unexpected output:',iarray
+                    error_cnt = error_cnt + 1
+                else
+                    write(error_unit,'(A,1x,*(I2,1X))') 'Success:',iarray
+                end if
+            end if
+        end if
+
+        call json%validate(p,is_valid,error_msg)
+        if (.not. is_valid) then
+            write(error_unit,'(A)') trim(error_msg)
+            error_cnt = error_cnt + 1
+        end if
+
+    end if
+
+    ! cleanup:
+    call json%destroy(p)
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') ''
+
+    end subroutine test_20
+
+end module jf_test_20_mod
+!*****************************************************************************************
+
+!*****************************************************************************************
+program jf_test_20
+
+    !! 20th unit test.
+
+    use jf_test_20_mod, only: test_20
+
+    implicit none
+
+    integer :: n_errors
+    call test_20(n_errors)
+    if ( n_errors /= 0) stop 1
+
+end program jf_test_20
+!*****************************************************************************************