Merge pull request jacobwilliams#453 from jacobwilliams/291-recursive-json-get-array

made json_get_array recursive

Author: jacobwilliams

src/json_value_module.F90

@@ -9476,7 +9476,7 @@ end subroutine wrap_json_get_alloc_string_vec_by_path
 !      higher-level routines are provided (see `get` methods), so
 !      this routine does not have to be used for those cases.
 
-    subroutine json_get_array(json, me, array_callback)
+    recursive subroutine json_get_array(json, me, array_callback)
 
     implicit none
 
@@ -9581,7 +9581,7 @@ end subroutine json_traverse
 !  This routine calls the user-supplied array_callback subroutine
 !  for each element in the array (specified by the path).
 
-    subroutine json_get_array_by_path(json, me, path, array_callback, found)
+    recursive subroutine json_get_array_by_path(json, me, path, array_callback, found)
 
     implicit none
 
@@ -9626,7 +9626,7 @@ end subroutine json_get_array_by_path
 !>
 !  Alternate version of [[json_get_array_by_path]], where "path" is kind=CDK
 
-    subroutine wrap_json_get_array_by_path(json, me, path, array_callback, found)
+    recursive subroutine wrap_json_get_array_by_path(json, me, path, array_callback, found)
 
     implicit none
 

src/tests/jf_test_44.F90

@@ -0,0 +1,115 @@
+!*****************************************************************************************
+!>
+! Module for the 44th unit test
+
+module jf_test_44_mod
+
+    use json_module, CK => json_CK, IK => json_IK, RK => json_RK, LK => json_LK
+    use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
+
+    implicit none
+
+    private
+    public :: test_44
+
+contains
+
+    subroutine test_44(error_cnt)
+
+    !! testing recursive `json_get_array`
+
+    implicit none
+
+    integer,intent(out) :: error_cnt !! error counter
+
+    character(kind=CK,len=*),parameter :: str = CK_'{ "x": [0, [1,2,3], [4,5,6] ] }'
+
+    type(json_core) :: json
+    type(json_value),pointer :: p, x
+    logical :: found
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') '   TEST 44'
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') ''
+
+    error_cnt = 0
+
+    call json%initialize(path_mode=1_IK)
+    call json%deserialize(p,str)
+
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    else
+        call json%get(p,CK_'x',x)
+        call json%get(x, callback)
+    end if
+
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+
+    if (error_cnt==0) then
+        write(error_unit,'(A)') 'Success!'
+    else
+        write(error_unit,'(A)') 'Failed!'
+    end if
+    write(error_unit,'(A)') ''
+
+    end subroutine test_44
+
+    recursive subroutine callback(json, element, i, count)
+        !! Array element callback function.  Used by [[json_get_array]]
+
+        implicit none
+
+        class(json_core),intent(inout)       :: json
+        type(json_value),pointer,intent(in)  :: element
+        integer(IK),intent(in)               :: i        !! index
+        integer(IK),intent(in)               :: count    !! size of array
+
+        integer(IK) :: var_type
+        character(kind=CK,len=:),allocatable :: path
+        integer(IK) :: ival
+
+        call json%get_path(element, path)
+
+        call json%info(element,var_type=var_type)
+
+        if (var_type == json_array) then
+            write(output_unit,'(A)') 'array: '//trim(path)
+            call json%get(element, callback)
+        else if (var_type == json_integer) then
+            call json%get(element,ival)
+            !write(output_unit,'(A,1X,I2)') trim(path)//' = ', ival   ! see Issue #452
+            write(output_unit,'(I2,A,I2)') i,' : ', ival
+        end if
+
+    end subroutine callback
+
+end module jf_test_44_mod
+!*****************************************************************************************
+
+#ifndef INTEGRATED_TESTS
+!*****************************************************************************************
+program jf_test_44
+
+    !! 44th unit test.
+
+    use jf_test_44_mod , only: test_44
+    implicit none
+    integer :: n_errors
+    n_errors = 0
+    call test_44(n_errors)
+    if (n_errors /= 0) stop 1
+
+end program jf_test_44
+!*****************************************************************************************
+#endif
+
+
+
+

visual_studio/jsonfortrantest/jsonfortrantest.f90

@@ -99,6 +99,7 @@ program jsonfortrantest
     call test_41(n_errors); if (n_errors /= 0) stop 1
     call test_42(n_errors); if (n_errors /= 0) stop 1
     call test_43(n_errors); if (n_errors /= 0) stop 1
+    call test_44(n_errors); if (n_errors /= 0) stop 1
 
     end program jsonfortrantest
 !*****************************************************************************************

visual_studio/jsonfortrantest/jsonfortrantest.vfproj

@@ -89,5 +89,6 @@
 		<File RelativePath="..\..\src\tests\jf_test_41.F90"/>
 		<File RelativePath="..\..\src\tests\jf_test_42.F90"/>
 		<File RelativePath="..\..\src\tests\jf_test_43.F90"/>
+		<File RelativePath="..\..\src\tests\jf_test_44.F90"/>
 		<File RelativePath=".\jsonfortrantest.f90"/></Filter></Files>
 	<Globals/></VisualStudioProject>