Skip to content

made json_get_array recursive #453

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Apr 7, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions src/json_value_module.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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

Expand Down
115 changes: 115 additions & 0 deletions src/tests/jf_test_44.F90
Original file line number Diff line number Diff line change
@@ -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




1 change: 1 addition & 0 deletions visual_studio/jsonfortrantest/jsonfortrantest.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
!*****************************************************************************************
Expand Down
1 change: 1 addition & 0 deletions visual_studio/jsonfortrantest/jsonfortrantest.vfproj
Original file line number Diff line number Diff line change
Expand Up @@ -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>