From 795f5adc124cb16e71f0c7caf75c2283df0ef668 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Tue, 11 Apr 2017 20:58:45 -0500 Subject: [PATCH] added routine to reverse vector or object. --- src/json_value_module.F90 | 49 +++++++++++++++++++++++ src/tests/jf_test_28.f90 | 100 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 149 insertions(+) create mode 100644 src/tests/jf_test_28.f90 diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index 437da033..77e067e0 100644 --- a/src/json_value_module.F90 +++ b/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 @@ -2073,6 +2074,54 @@ 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 ! ! Swap two elements in a JSON structure. diff --git a/src/tests/jf_test_28.f90 b/src/tests/jf_test_28.f90 new file mode 100644 index 00000000..3a3ec25f --- /dev/null +++ b/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 +!*****************************************************************************************