Skip to content

Commit 572d9f5

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request jacobwilliams#454 from jacobwilliams/452-get-path-fix
Fixed json_get_path output for arrays of arrays
2 parents 1805d9a + 9ce5032 commit 572d9f5

File tree

4 files changed

+248
-38
lines changed

4 files changed

+248
-38
lines changed

‎src/json_parameters.F90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ module json_parameters
3535
!! (see [[json_file_variable_info]] and [[json_info]]).
3636
integer(IK),parameter :: json_real = 6 !! Real number JSON data type (`real(RK)`)
3737
!! (see [[json_file_variable_info]] and [[json_info]])
38-
integer(IK),parameter :: json_string = 7 !! String JSON data type (`character(CK)`)
38+
integer(IK),parameter :: json_string = 7 !! String JSON data type (`character(kind=CK)`)
3939
!! (see [[json_file_variable_info]] and [[json_info]])
4040
integer(IK),parameter :: json_double = json_real !! Equivalent to `json_real` for
4141
!! backward compatibility.

‎src/json_value_module.F90

Lines changed: 84 additions & 35 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(kind=CK,len=1) :: array_start !! for `path_mode=1`, the character to start arrays
7761+
character(kind=CK,len=1) :: 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

@@ -7914,7 +7955,7 @@ subroutine add_to_path(str,path_sep)
79147955
!! prepend the string to the path
79157956
implicit none
79167957
character(kind=CK,len=*),intent(in) :: str !! string to prepend to `path`
7917-
character(kind=CK,len=*),intent(in),optional :: path_sep
7958+
character(kind=CK,len=1),intent(in),optional :: path_sep
79187959
!! path separator (default is '.').
79197960
!! (ignored if `json%path_mode/=1`)
79207961

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

0 commit comments

Comments
 (0)