Skip to content

Commit 2232377

Browse files
jacobwilliamsjacobwilliams
committed
Fixed json_get_path output for arrays of arrays
Fixes #452
1 parent 1805d9a commit 2232377

File tree

3 files changed

+247
-36
lines changed

3 files changed

+247
-36
lines changed

‎src/json_value_module.F90

Lines changed: 83 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -7745,17 +7745,22 @@ subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
77457745
!! (otherwise use `json%path_separator`)
77467746
!! (only used if `path_mode=1`)
77477747

7748-
type(json_value),pointer :: tmp !! for traversing the structure
7749-
type(json_value),pointer :: element !! for traversing the structure
7750-
integer(IK) :: var_type !! JSON variable type flag
7751-
character(kind=CK,len=:),allocatable :: name !! variable name
7752-
character(kind=CK,len=:),allocatable :: parent_name !! variable's parent name
7753-
character(kind=CK,len=max_integer_str_len) :: istr !! for integer to string conversion
7754-
!! (array indices)
7755-
integer(IK) :: i !! counter
7756-
integer(IK) :: n_children !! number of children for parent
7757-
logical(LK) :: use_brackets !! to use '[]' characters for arrays
7758-
logical(LK) :: parent_is_root !! if the parent is the root
7748+
character(kind=CK,len=:),allocatable :: name !! variable name
7749+
character(kind=CK,len=:),allocatable :: parent_name !! variable's parent name
7750+
character(kind=CK,len=max_integer_str_len) :: istr !! for integer to string conversion
7751+
!! (array indices)
7752+
type(json_value),pointer :: tmp !! for traversing the structure
7753+
type(json_value),pointer :: element !! for traversing the structure
7754+
integer(IK) :: var_type !! JSON variable type flag
7755+
integer(IK) :: tmp_var_type !! JSON variable type flag
7756+
integer(IK) :: i !! counter
7757+
integer(IK) :: n_children !! number of children for parent
7758+
logical(LK) :: use_brackets !! to use '[]' characters for arrays
7759+
logical(LK) :: parent_is_root !! if the parent is the root
7760+
character(CK) :: array_start !! for `path_mode=1`, the character to start arrays
7761+
character(CK) :: array_end !! for `path_mode=1`, the character to end arrays
7762+
logical :: consecutive_arrays !! check for array of array case
7763+
integer(IK) :: parents_parent_var_type !! `var_type` for parent's parent
77597764

77607765
!optional input:
77617766
if (present(use_alt_array_tokens)) then
@@ -7764,6 +7769,19 @@ subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
77647769
use_brackets = .true.
77657770
end if
77667771

7772+
if (json%path_mode==1_IK) then
7773+
if (use_brackets) then
7774+
array_start = start_array
7775+
array_end = end_array
7776+
else
7777+
array_start = start_array_alt
7778+
array_end = end_array_alt
7779+
end if
7780+
end if
7781+
7782+
! initialize:
7783+
consecutive_arrays = .false.
7784+
77677785
if (associated(p)) then
77687786

77697787
!traverse the structure via parents up to the root
@@ -7787,6 +7805,13 @@ subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
77877805
if (json%path_mode==2_IK) then
77887806
parent_name = encode_rfc6901(parent_name)
77897807
end if
7808+
if (associated(tmp%parent%parent)) then
7809+
call json%info(tmp%parent%parent,var_type=parents_parent_var_type)
7810+
consecutive_arrays = parents_parent_var_type == json_array .and. &
7811+
var_type == json_array
7812+
else
7813+
consecutive_arrays = .false.
7814+
end if
77907815

77917816
select case (var_type)
77927817
case (json_array)
@@ -7816,36 +7841,52 @@ subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
78167841
! example: `$['key'][1]`
78177842
! [note: this uses 1-based indices]
78187843
call integer_to_string(i,int_fmt,istr)
7819-
call add_to_path(start_array//single_quote//parent_name//&
7820-
single_quote//end_array//&
7821-
start_array//trim(adjustl(istr))//end_array,CK_'')
7844+
if (consecutive_arrays) then
7845+
call add_to_path(start_array//trim(adjustl(istr))//end_array,CK_'')
7846+
else
7847+
call add_to_path(start_array//single_quote//parent_name//&
7848+
single_quote//end_array//&
7849+
start_array//trim(adjustl(istr))//end_array,CK_'')
7850+
end if
78227851
case(2_IK)
78237852
! rfc6901
7853+
! Example: '/key/0'
78247854
call integer_to_string(i-1_IK,int_fmt,istr) ! 0-based index
7825-
call add_to_path(parent_name//slash//trim(adjustl(istr)))
7855+
if (consecutive_arrays) then
7856+
call add_to_path(trim(adjustl(istr)))
7857+
else
7858+
call add_to_path(parent_name//slash//trim(adjustl(istr)))
7859+
end if
78267860
case(1_IK)
78277861
! default
7862+
! Example: `key[1]`
78287863
call integer_to_string(i,int_fmt,istr)
7829-
if (use_brackets) then
7830-
call add_to_path(parent_name//start_array//&
7831-
trim(adjustl(istr))//end_array,path_sep)
7864+
if (consecutive_arrays) then
7865+
call add_to_path(array_start//trim(adjustl(istr))//array_end,path_sep)
78327866
else
7833-
call add_to_path(parent_name//start_array_alt//&
7834-
trim(adjustl(istr))//end_array_alt,path_sep)
7867+
call add_to_path(parent_name//array_start//&
7868+
trim(adjustl(istr))//array_end,path_sep)
78357869
end if
78367870
end select
7837-
tmp => tmp%parent ! already added parent name
7871+
7872+
if (.not. consecutive_arrays) tmp => tmp%parent ! already added parent name
78387873

78397874
case (json_object)
78407875

7841-
!process parent on the next pass
7842-
select case(json%path_mode)
7843-
case(3_IK)
7844-
call add_to_path(start_array//single_quote//name//&
7845-
single_quote//end_array,CK_'')
7846-
case default
7847-
call add_to_path(name,path_sep)
7848-
end select
7876+
if (.not. consecutive_arrays) then
7877+
! idea is not to print the array name if
7878+
! it was already printed with the array
7879+
7880+
!process parent on the next pass
7881+
select case(json%path_mode)
7882+
case(3_IK)
7883+
call add_to_path(start_array//single_quote//name//&
7884+
single_quote//end_array,CK_'')
7885+
case default
7886+
call add_to_path(name,path_sep)
7887+
end select
7888+
7889+
end if
78497890

78507891
case default
78517892

@@ -7938,12 +7979,20 @@ subroutine add_to_path(str,path_sep)
79387979
if (.not. allocated(path)) then
79397980
path = str
79407981
else
7941-
if (present(path_sep)) then
7942-
! use user specified:
7943-
path = str//path_sep//path
7982+
! shouldn't add the path_sep for cases like x[1][2]
7983+
! [if current is an array element, and the previous was
7984+
! also an array element] so check for that here:
7985+
if (.not. ( str(len(str):len(str))==array_end .and. &
7986+
path(1:1)==array_start )) then
7987+
if (present(path_sep)) then
7988+
! use user specified:
7989+
path = str//path_sep//path
7990+
else
7991+
! use the default:
7992+
path = str//json%path_separator//path
7993+
end if
79447994
else
7945-
! use the default:
7946-
path = str//json%path_separator//path
7995+
path = str//path
79477996
end if
79487997
end if
79497998
end select

‎src/tests/jf_test_44.F90

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -84,8 +84,7 @@ recursive subroutine callback(json, element, i, count)
8484
call json%get(element, callback)
8585
else if (var_type == json_integer) then
8686
call json%get(element,ival)
87-
!write(output_unit,'(A,1X,I2)') trim(path)//' = ', ival ! see Issue #452
88-
write(output_unit,'(I2,A,I2)') i,' : ', ival
87+
write(output_unit,'(A,1X,I2)') trim(path)//' = ', ival
8988
end if
9089

9190
end subroutine callback

‎src/tests/jf_test_45.F90

Lines changed: 163 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,163 @@
1+
!*****************************************************************************************
2+
!>
3+
! Module for the 45th unit test
4+
5+
module jf_test_45_mod
6+
7+
use json_module, CK => json_CK, IK => json_IK, RK => json_RK, LK => json_LK
8+
use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
9+
10+
implicit none
11+
12+
private
13+
public :: test_45
14+
15+
contains
16+
17+
subroutine test_45(error_cnt)
18+
19+
!! testing of `json_get_path`
20+
21+
implicit none
22+
23+
integer,intent(out) :: error_cnt !! error counter
24+
25+
! character(kind=CK,len=*),parameter :: str = CK_'{ "x": [0, [1,2,[3,3,[4,4]]], [4,5,6] ] }'
26+
character(kind=CK,len=*),parameter :: str = CK_'{ "x": [[1], [1,2,3,[4]]] }'
27+
28+
type(json_core) :: json
29+
type(json_value),pointer :: p, x
30+
logical(LK) :: found
31+
integer(IK) :: ival
32+
integer(IK) :: path_mode
33+
character(kind=CK,len=:),allocatable :: key
34+
35+
write(error_unit,'(A)') ''
36+
write(error_unit,'(A)') '================================='
37+
write(error_unit,'(A)') ' TEST 45'
38+
write(error_unit,'(A)') '================================='
39+
write(error_unit,'(A)') ''
40+
41+
error_cnt = 0
42+
43+
call json%deserialize(p,str)
44+
call json%print(p)
45+
46+
do path_mode = 1_IK, 3_IK
47+
48+
write(output_unit,'(A)') ''
49+
write(output_unit,'(A)') '------------------------------'
50+
write(output_unit,'(A,1X,I2)') 'path_mode = ', path_mode
51+
write(output_unit,'(A)') '------------------------------'
52+
53+
call json%initialize(path_mode=path_mode)
54+
55+
if (json%failed()) then
56+
call json%print_error_message(error_unit)
57+
error_cnt = error_cnt + 1
58+
else
59+
select case (path_mode)
60+
case(1_IK)
61+
key = CK_'x'
62+
case(2_IK)
63+
key = CK_'/x'
64+
case(3_IK)
65+
key = CK_"$['x']"
66+
end select
67+
call json%get(p,key,x)
68+
call json%traverse(x, callback)
69+
end if
70+
71+
if (json%failed()) then
72+
call json%print_error_message(error_unit)
73+
error_cnt = error_cnt + 1
74+
end if
75+
76+
! now, try to get values using the path:
77+
write(output_unit,'(A)') ''
78+
select case (path_mode)
79+
case(1_IK)
80+
key = CK_'x[2][4][1]'
81+
case(2_IK)
82+
key = CK_'/x/1/3/0'
83+
case(3_IK)
84+
key = CK_"$['x'][2][4][1]"
85+
end select
86+
call json%get(p, key, ival, found)
87+
if (found) then
88+
if (ival == 4_IK) then
89+
write(output_unit,'(A)') 'Successfully got '//key//' = 4'
90+
else
91+
write(error_unit,'(A)') 'Error: '//key//' /= 4'
92+
error_cnt = error_cnt + 1
93+
end if
94+
else
95+
write(error_unit,'(A)') 'Error: could not find '//key
96+
error_cnt = error_cnt + 1
97+
end if
98+
99+
end do
100+
101+
call json%destroy(p)
102+
103+
if (error_cnt==0) then
104+
write(error_unit,'(A)') 'Success!'
105+
else
106+
write(error_unit,'(A)') 'Failed!'
107+
end if
108+
write(error_unit,'(A)') ''
109+
110+
end subroutine test_45
111+
112+
subroutine callback(json,p,finished)
113+
!! Callback function used by [[json_traverse]]
114+
115+
implicit none
116+
117+
class(json_core),intent(inout) :: json
118+
type(json_value),pointer,intent(in) :: p
119+
logical(LK),intent(out) :: finished !! set true to stop traversing
120+
121+
integer(IK) :: var_type
122+
character(kind=CK,len=:),allocatable :: path
123+
integer(IK) :: ival
124+
125+
call json%get_path(p, path)
126+
127+
call json%info(p,var_type=var_type)
128+
129+
if (var_type == json_array) then
130+
write(output_unit,'(A)') ''
131+
write(output_unit,'(A)') trim(path)
132+
else if (var_type == json_integer) then
133+
call json%get(p,ival)
134+
write(output_unit,'(A,1X,I2)') trim(path)//' = ', ival
135+
end if
136+
137+
finished = .false.
138+
139+
end subroutine callback
140+
141+
end module jf_test_45_mod
142+
!*****************************************************************************************
143+
144+
#ifndef INTEGRATED_TESTS
145+
!*****************************************************************************************
146+
program jf_test_45
147+
148+
!! 45th unit test.
149+
150+
use jf_test_45_mod , only: test_45
151+
implicit none
152+
integer :: n_errors
153+
n_errors = 0
154+
call test_45(n_errors)
155+
if (n_errors /= 0) stop 1
156+
157+
end program jf_test_45
158+
!*****************************************************************************************
159+
#endif
160+
161+
162+
163+

0 commit comments

Comments
 (0)