Merge pull request #281 from jacobwilliams/reverse

added routine to reverse vector or object.

Author: jacobwilliams

src/json_value_module.F90

@@ -643,6 +643,7 @@ module json_value_module
 
         procedure,public :: remove              => json_value_remove        !! Remove a [[json_value]] from a linked-list structure.
         procedure,public :: replace             => json_value_replace       !! Replace a [[json_value]] in a linked-list structure.
+        procedure,public :: reverse             => json_value_reverse       !! Reverse the order of the children of an array of object.
         procedure,public :: check_for_errors    => json_check_for_errors    !! check for error and get error message
         procedure,public :: clear_exceptions    => json_clear_exceptions    !! clear exceptions
         procedure,public :: count               => json_count               !! count the number of children
@@ -2071,6 +2072,54 @@ subroutine json_value_replace(json,p1,p2,destroy)
     end subroutine json_value_replace
 !*****************************************************************************************
 
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 4/11/2017
+!
+!  Reverse the order of the children of an array or object.
+
+    subroutine json_value_reverse(json,p)
+
+    implicit none
+
+    class(json_core),intent(inout) :: json
+    type(json_value),pointer       :: p
+
+    type(json_value),pointer :: tmp       !! temp variable for traversing the list
+    type(json_value),pointer :: current   !! temp variable for traversing the list
+    integer(IK)              :: var_type  !! for getting the variable type
+
+    if (associated(p)) then
+
+        call json%info(p,var_type=var_type)
+
+        ! can only reverse objects or arrays
+        if (var_type==json_object .or. var_type==json_array) then
+
+            nullify(tmp)
+            current => p%children
+            p%tail => current
+
+            ! Swap next and previous for all nodes:
+            do
+                if (.not. associated(current)) exit
+                tmp              => current%previous
+                current%previous => current%next
+                current%next     => tmp
+                current          => current%previous
+            end do
+
+            if (associated(tmp)) then
+                p%children => tmp%previous
+            end if
+
+        end if
+
+    end if
+
+    end subroutine json_value_reverse
+!*****************************************************************************************
+
 !*****************************************************************************************
 !> author: Jacob Williams
 !  date: 4/26/2016

src/tests/jf_test_28.f90

@@ -0,0 +1,100 @@
+!*****************************************************************************************
+!>
+!  Unit test for [[json_value_reverse]].
+!
+!@note This uses Fortran 2008 auto LHS assignments.
+
+    program jf_test_28
+
+    use json_module
+    use iso_fortran_env
+
+    implicit none
+
+    type(json_core) :: json
+    type(json_value),pointer :: p,vec
+    integer(json_IK),dimension(:),allocatable :: ivec
+    integer(json_IK),dimension(:),allocatable :: ivec_value,ivec_value_reversed
+    character(kind=json_CK,len=:),allocatable :: str
+    integer :: i !! counter
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') '   TEST 28'
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') ''
+
+    call json%initialize(compress_vectors=.true.)
+
+    do i=1,4
+
+        ! all the cases:
+        select case (i)
+        case(1)
+            str = json_CK_'{"vec":[1,2,3,4,5]}'
+            ivec_value = [1,2,3,4,5]
+            ivec_value_reversed = [5,4,3,2,1]
+        case(2)
+            str = json_CK_'{"vec":[1]}'
+            ivec_value = [1]
+            ivec_value_reversed = [1]
+        case(3)
+            str = json_CK_'{"vec":[1,2]}'
+            ivec_value = [1,2]
+            ivec_value_reversed = [2,1]
+        case(4)
+            str = json_CK_'{"vec":[]}'
+            !ivec_value = []
+            !ivec_value_reversed = []
+        end select
+
+        call json%parse(p,str)
+        call json%get(p,'vec',vec)
+
+        write(output_unit,'(A)') ''
+        write(output_unit,'(A)') 'Original:'
+        write(output_unit,'(A)') ''
+        call json%print(vec,output_unit)
+
+        call json%reverse(vec)
+
+        write(output_unit,'(A)') ''
+        write(output_unit,'(A)') 'Reversed:'
+        write(output_unit,'(A)') ''
+        call json%print(vec,output_unit)
+
+        call json%get(vec,ivec)
+        call json%destroy(p)
+
+        if (json%failed()) then
+            call json%print_error_message(error_unit)
+            stop 1
+        else
+
+            if (allocated(ivec)) then
+                if (i/=4) then
+                    if (all(ivec==ivec_value_reversed)) then
+                        write(output_unit,'(A)') 'reverse test passed'
+                    else
+                        write(output_unit,'(A,*(I3,1X))') 'reverse test failed: ', ivec
+                        stop 1
+                    end if
+                else
+                    if (size(ivec)==0) then
+                        write(output_unit,'(A)') 'reverse test passed'
+                    else
+                        write(output_unit,'(A,*(I3,1X))') 'reverse test failed: ', ivec
+                        stop 1
+                    end if
+                end if
+            else
+                write(output_unit,'(A)') 'reverse test failed: error getting ivec'
+                stop 1
+            end if
+
+        end if
+
+    end do
+
+    end program jf_test_28
+!*****************************************************************************************