Skip to content

Fixed json_get_path output for arrays of arrays #454

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 3 commits into from
Apr 9, 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
2 changes: 1 addition & 1 deletion src/json_parameters.F90
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ module json_parameters
!! (see [[json_file_variable_info]] and [[json_info]]).
integer(IK),parameter :: json_real = 6 !! Real number JSON data type (`real(RK)`)
!! (see [[json_file_variable_info]] and [[json_info]])
integer(IK),parameter :: json_string = 7 !! String JSON data type (`character(CK)`)
integer(IK),parameter :: json_string = 7 !! String JSON data type (`character(kind=CK)`)
!! (see [[json_file_variable_info]] and [[json_info]])
integer(IK),parameter :: json_double = json_real !! Equivalent to `json_real` for
!! backward compatibility.
Expand Down
119 changes: 84 additions & 35 deletions src/json_value_module.F90
Original file line number Diff line number Diff line change
Expand Up @@ -7745,17 +7745,22 @@ subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
!! (otherwise use `json%path_separator`)
!! (only used if `path_mode=1`)

type(json_value),pointer :: tmp !! for traversing the structure
type(json_value),pointer :: element !! for traversing the structure
integer(IK) :: var_type !! JSON variable type flag
character(kind=CK,len=:),allocatable :: name !! variable name
character(kind=CK,len=:),allocatable :: parent_name !! variable's parent name
character(kind=CK,len=max_integer_str_len) :: istr !! for integer to string conversion
!! (array indices)
integer(IK) :: i !! counter
integer(IK) :: n_children !! number of children for parent
logical(LK) :: use_brackets !! to use '[]' characters for arrays
logical(LK) :: parent_is_root !! if the parent is the root
character(kind=CK,len=:),allocatable :: name !! variable name
character(kind=CK,len=:),allocatable :: parent_name !! variable's parent name
character(kind=CK,len=max_integer_str_len) :: istr !! for integer to string conversion
!! (array indices)
type(json_value),pointer :: tmp !! for traversing the structure
type(json_value),pointer :: element !! for traversing the structure
integer(IK) :: var_type !! JSON variable type flag
integer(IK) :: tmp_var_type !! JSON variable type flag
integer(IK) :: i !! counter
integer(IK) :: n_children !! number of children for parent
logical(LK) :: use_brackets !! to use '[]' characters for arrays
logical(LK) :: parent_is_root !! if the parent is the root
character(kind=CK,len=1) :: array_start !! for `path_mode=1`, the character to start arrays
character(kind=CK,len=1) :: array_end !! for `path_mode=1`, the character to end arrays
logical :: consecutive_arrays !! check for array of array case
integer(IK) :: parents_parent_var_type !! `var_type` for parent's parent

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

if (json%path_mode==1_IK) then
if (use_brackets) then
array_start = start_array
array_end = end_array
else
array_start = start_array_alt
array_end = end_array_alt
end if
end if

! initialize:
consecutive_arrays = .false.

if (associated(p)) then

!traverse the structure via parents up to the root
Expand All @@ -7787,6 +7805,13 @@ subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
if (json%path_mode==2_IK) then
parent_name = encode_rfc6901(parent_name)
end if
if (associated(tmp%parent%parent)) then
call json%info(tmp%parent%parent,var_type=parents_parent_var_type)
consecutive_arrays = parents_parent_var_type == json_array .and. &
var_type == json_array
else
consecutive_arrays = .false.
end if

select case (var_type)
case (json_array)
Expand Down Expand Up @@ -7816,36 +7841,52 @@ subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
! example: `$['key'][1]`
! [note: this uses 1-based indices]
call integer_to_string(i,int_fmt,istr)
call add_to_path(start_array//single_quote//parent_name//&
single_quote//end_array//&
start_array//trim(adjustl(istr))//end_array,CK_'')
if (consecutive_arrays) then
call add_to_path(start_array//trim(adjustl(istr))//end_array,CK_'')
else
call add_to_path(start_array//single_quote//parent_name//&
single_quote//end_array//&
start_array//trim(adjustl(istr))//end_array,CK_'')
end if
case(2_IK)
! rfc6901
! Example: '/key/0'
call integer_to_string(i-1_IK,int_fmt,istr) ! 0-based index
call add_to_path(parent_name//slash//trim(adjustl(istr)))
if (consecutive_arrays) then
call add_to_path(trim(adjustl(istr)))
else
call add_to_path(parent_name//slash//trim(adjustl(istr)))
end if
case(1_IK)
! default
! Example: `key[1]`
call integer_to_string(i,int_fmt,istr)
if (use_brackets) then
call add_to_path(parent_name//start_array//&
trim(adjustl(istr))//end_array,path_sep)
if (consecutive_arrays) then
call add_to_path(array_start//trim(adjustl(istr))//array_end,path_sep)
else
call add_to_path(parent_name//start_array_alt//&
trim(adjustl(istr))//end_array_alt,path_sep)
call add_to_path(parent_name//array_start//&
trim(adjustl(istr))//array_end,path_sep)
end if
end select
tmp => tmp%parent ! already added parent name

if (.not. consecutive_arrays) tmp => tmp%parent ! already added parent name

case (json_object)

!process parent on the next pass
select case(json%path_mode)
case(3_IK)
call add_to_path(start_array//single_quote//name//&
single_quote//end_array,CK_'')
case default
call add_to_path(name,path_sep)
end select
if (.not. consecutive_arrays) then
! idea is not to print the array name if
! it was already printed with the array

!process parent on the next pass
select case(json%path_mode)
case(3_IK)
call add_to_path(start_array//single_quote//name//&
single_quote//end_array,CK_'')
case default
call add_to_path(name,path_sep)
end select

end if

case default

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

Expand All @@ -7938,12 +7979,20 @@ subroutine add_to_path(str,path_sep)
if (.not. allocated(path)) then
path = str
else
if (present(path_sep)) then
! use user specified:
path = str//path_sep//path
! shouldn't add the path_sep for cases like x[1][2]
! [if current is an array element, and the previous was
! also an array element] so check for that here:
if (.not. ( str(len(str):len(str))==array_end .and. &
path(1:1)==array_start )) then
if (present(path_sep)) then
! use user specified:
path = str//path_sep//path
else
! use the default:
path = str//json%path_separator//path
end if
else
! use the default:
path = str//json%path_separator//path
path = str//path
end if
end if
end select
Expand Down
3 changes: 1 addition & 2 deletions src/tests/jf_test_44.F90
Original file line number Diff line number Diff line change
Expand Up @@ -84,8 +84,7 @@ recursive subroutine callback(json, element, i, count)
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
write(output_unit,'(A,1X,I2)') trim(path)//' = ', ival
end if

end subroutine callback
Expand Down
162 changes: 162 additions & 0 deletions src/tests/jf_test_45.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,162 @@
!*****************************************************************************************
!>
! Module for the 45th unit test

module jf_test_45_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_45

contains

subroutine test_45(error_cnt)

!! testing of `json_get_path`

implicit none

integer,intent(out) :: error_cnt !! error counter

character(kind=CK,len=*),parameter :: str = CK_'{ "x": [[1], [1,2,3,[4]]] }'

type(json_core) :: json
type(json_value),pointer :: p, x
logical(LK) :: found
integer(IK) :: ival
integer(IK) :: path_mode
character(kind=CK,len=:),allocatable :: key

write(error_unit,'(A)') ''
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ' TEST 45'
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ''

error_cnt = 0

call json%deserialize(p,str)
call json%print(p)

do path_mode = 1_IK, 3_IK

write(output_unit,'(A)') ''
write(output_unit,'(A)') '------------------------------'
write(output_unit,'(A,1X,I2)') 'path_mode = ', path_mode
write(output_unit,'(A)') '------------------------------'

call json%initialize(path_mode=path_mode)

if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
select case (path_mode)
case(1_IK)
key = CK_'x'
case(2_IK)
key = CK_'/x'
case(3_IK)
key = CK_"$['x']"
end select
call json%get(p,key,x)
call json%traverse(x, callback)
end if

if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if

! now, try to get values using the path:
write(output_unit,'(A)') ''
select case (path_mode)
case(1_IK)
key = CK_'x[2][4][1]'
case(2_IK)
key = CK_'/x/1/3/0'
case(3_IK)
key = CK_"$['x'][2][4][1]"
end select
call json%get(p, key, ival, found)
if (found) then
if (ival == 4_IK) then
write(output_unit,'(A)') 'Successfully got '//key//' = 4'
else
write(error_unit,'(A)') 'Error: '//key//' /= 4'
error_cnt = error_cnt + 1
end if
else
write(error_unit,'(A)') 'Error: could not find '//key
error_cnt = error_cnt + 1
end if

end do

call json%destroy(p)

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_45

subroutine callback(json,p,finished)
!! Callback function used by [[json_traverse]]

implicit none

class(json_core),intent(inout) :: json
type(json_value),pointer,intent(in) :: p
logical(LK),intent(out) :: finished !! set true to stop traversing

integer(IK) :: var_type
character(kind=CK,len=:),allocatable :: path
integer(IK) :: ival

call json%get_path(p, path)

call json%info(p,var_type=var_type)

if (var_type == json_array) then
write(output_unit,'(A)') ''
write(output_unit,'(A)') trim(path)
else if (var_type == json_integer) then
call json%get(p,ival)
write(output_unit,'(A,1X,I2)') trim(path)//' = ', ival
end if

finished = .false.

end subroutine callback

end module jf_test_45_mod
!*****************************************************************************************

#ifndef INTEGRATED_TESTS
!*****************************************************************************************
program jf_test_45

!! 45th unit test.

use jf_test_45_mod , only: test_45
implicit none
integer :: n_errors
n_errors = 0
call test_45(n_errors)
if (n_errors /= 0) stop 1

end program jf_test_45
!*****************************************************************************************
#endif