Skip to content

Commit 3c3a051

Browse files
jacobwilliamsjacobwilliams
committed
Fixed inconsistent use of escaped or unescaped strings.
Now the name and string values are always stored unescaped. User routine string variable input/output is always unescaped. Strings are printed escaped as before. Fixes #287
1 parent 9905db9 commit 3c3a051

File tree

2 files changed

+64
-40
lines changed

2 files changed

+64
-40
lines changed

‎src/json_value_module.F90

Lines changed: 62 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -115,11 +115,12 @@ module json_value_module
115115
type(json_value),pointer :: children => null() !! first child item of this
116116
type(json_value),pointer :: tail => null() !! last child item of this
117117

118-
character(kind=CK,len=:),allocatable :: name !! variable name
118+
character(kind=CK,len=:),allocatable :: name !! variable name (unescaped)
119119

120120
real(RK),allocatable :: dbl_value !! real data for this variable
121121
logical(LK),allocatable :: log_value !! logical data for this variable
122122
character(kind=CK,len=:),allocatable :: str_value !! string data for this variable
123+
!! (unescaped)
123124
integer(IK),allocatable :: int_value !! integer data for this variable
124125

125126
integer(IK) :: var_type = json_unknown !! variable type
@@ -641,9 +642,12 @@ module json_value_module
641642
generic,public :: get_path => MAYBEWRAP(json_get_path)
642643
procedure :: MAYBEWRAP(json_get_path)
643644

644-
procedure,public :: remove => json_value_remove !! Remove a [[json_value]] from a linked-list structure.
645-
procedure,public :: replace => json_value_replace !! Replace a [[json_value]] in a linked-list structure.
646-
procedure,public :: reverse => json_value_reverse !! Reverse the order of the children of an array of object.
645+
procedure,public :: remove => json_value_remove !! Remove a [[json_value]] from a
646+
!! linked-list structure.
647+
procedure,public :: replace => json_value_replace !! Replace a [[json_value]] in a
648+
!! linked-list structure.
649+
procedure,public :: reverse => json_value_reverse !! Reverse the order of the children
650+
!! of an array of object.
647651
procedure,public :: check_for_errors => json_check_for_errors !! check for error and get error message
648652
procedure,public :: clear_exceptions => json_clear_exceptions !! clear exceptions
649653
procedure,public :: count => json_count !! count the number of children
@@ -654,14 +658,19 @@ module json_value_module
654658
procedure,public :: get_previous => json_get_previous !! get pointer to json_value previous
655659
procedure,public :: get_tail => json_get_tail !! get pointer to json_value tail
656660
procedure,public :: initialize => json_initialize !! to initialize some parsing parameters
657-
procedure,public :: traverse => json_traverse !! to traverse all elements of a JSON structure
658-
procedure,public :: print_error_message => json_print_error_message !! simply routine to print error messages
661+
procedure,public :: traverse => json_traverse !! to traverse all elements of a JSON
662+
!! structure
663+
procedure,public :: print_error_message => json_print_error_message !! simply routine to print error
664+
!! messages
659665
procedure,public :: swap => json_value_swap !! Swap two [[json_value]] pointers
660-
!! in a structure (or two different structures).
661-
procedure,public :: is_child_of => json_value_is_child_of !! Check if a [[json_value]] is a descendant of another.
662-
procedure,public :: validate => json_value_validate !! Check that a [[json_value]] linked list is valid
663-
!! (i.e., is properly constructed). This may be
664-
!! useful if it has been constructed externally.
666+
!! in a structure (or two different
667+
!! structures).
668+
procedure,public :: is_child_of => json_value_is_child_of !! Check if a [[json_value]] is a
669+
!! descendant of another.
670+
procedure,public :: validate => json_value_validate !! Check that a [[json_value]] linked
671+
!! list is valid (i.e., is properly
672+
!! constructed). This may be useful
673+
!! if it has been constructed externally.
665674

666675
!other private routines:
667676
procedure :: name_equal
@@ -4223,13 +4232,9 @@ subroutine json_value_add_string(json, p, name, val)
42234232
character(kind=CK,len=*),intent(in) :: val !! value
42244233

42254234
type(json_value),pointer :: var
4226-
character(kind=CK,len=:),allocatable :: str
4227-
4228-
!add escape characters if necessary:
4229-
call escape_string(val, str)
42304235

42314236
!create the variable:
4232-
call json%create_string(var,str,name)
4237+
call json%create_string(var,val,name)
42334238

42344239
!add it:
42354240
call json%add(p, var)
@@ -4855,6 +4860,8 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
48554860
integer(IK) :: var_type,var_type_prev
48564861
logical(LK) :: is_vector !! if all elements of a vector
48574862
!! are scalars of the same type
4863+
character(kind=CK,len=:),allocatable :: str_escaped !! escaped version of
4864+
!! `name` or `str_value`
48584865

48594866
if (.not. json%exception_thrown) then
48604867

@@ -4931,19 +4938,20 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
49314938

49324939
! print the name
49334940
if (allocated(element%name)) then
4941+
call escape_string(element%name,str_escaped)
49344942
if (json%no_whitespace) then
49354943
!compact printing - no extra space
49364944
call write_it(repeat(space, spaces)//quotation_mark//&
4937-
element%name//quotation_mark//colon_char,&
4945+
str_escaped//quotation_mark//colon_char,&
49384946
advance=.false.)
49394947
else
49404948
call write_it(repeat(space, spaces)//quotation_mark//&
4941-
element%name//quotation_mark//colon_char//space,&
4949+
str_escaped//quotation_mark//colon_char//space,&
49424950
advance=.false.)
49434951
end if
49444952
else
49454953
call json%throw_exception('Error in json_value_print:'//&
4946-
' element%name not allocated')
4954+
' element%name not allocated')
49474955
nullify(element)
49484956
return
49494957
end if
@@ -5056,8 +5064,10 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
50565064
case (json_string)
50575065

50585066
if (allocated(p%str_value)) then
5067+
! have to escape the string for printing:
5068+
call escape_string(p%str_value,str_escaped)
50595069
call write_it( s//quotation_mark// &
5060-
p%str_value//quotation_mark, &
5070+
str_escaped//quotation_mark, &
50615071
comma=print_comma, &
50625072
advance=(.not. is_vector),&
50635073
space_after_comma=is_vector )
@@ -5148,7 +5158,7 @@ subroutine write_it(s,advance,comma,space_after_comma)
51485158
! overrides input value:
51495159
add_line_break = .false.
51505160
else
5151-
add_line_break = advance
5161+
add_line_break = advance
51525162
end if
51535163
else
51545164
add_line_break = .not. json%no_whitespace ! default is to advance if
@@ -6828,23 +6838,18 @@ subroutine json_get_string(json, me, value)
68286838
type(json_value),pointer,intent(in) :: me
68296839
character(kind=CK,len=:),allocatable,intent(out) :: value
68306840

6831-
character(kind=CK,len=:),allocatable :: error_message !! for [[unescape_string]]
6832-
68336841
value = CK_''
68346842
if (.not. json%exception_thrown) then
68356843

68366844
if (me%var_type == json_string) then
68376845

68386846
if (allocated(me%str_value)) then
68396847
if (json%unescaped_strings) then
6840-
call unescape_string(me%str_value, value, error_message)
6841-
if (allocated(error_message)) then
6842-
call json%throw_exception(error_message)
6843-
deallocate(error_message)
6844-
value = CK_''
6845-
end if
6846-
else
6848+
! default: it is stored already unescaped:
68476849
value = me%str_value
6850+
else
6851+
! return the escaped version:
6852+
call escape_string(me%str_value, value)
68486853
end if
68496854
else
68506855
call json%throw_exception('Error in json_get_string: '//&
@@ -7829,11 +7834,13 @@ recursive subroutine parse_value(json, unit, str, value)
78297834
select case (value%var_type)
78307835
case (json_string)
78317836
#if defined __GFORTRAN__
7832-
call json%parse_string(unit,str,tmp) ! write to a tmp variable because of
7833-
value%str_value = tmp ! a bug in 4.9 gfortran compiler.
7834-
deallocate(tmp) !
7837+
! write to a tmp variable because of
7838+
! a bug in 4.9 gfortran compiler.
7839+
call json%parse_string(unit,str,tmp)
7840+
value%str_value = tmp
7841+
if (allocated(tmp)) deallocate(tmp)
78357842
#else
7836-
call json%parse_string(unit, str, value%str_value)
7843+
call json%parse_string(unit,tmp,value%str_value)
78377844
#endif
78387845
end select
78397846

@@ -8225,7 +8232,8 @@ subroutine to_logical(p,val,name)
82258232
implicit none
82268233

82278234
type(json_value),intent(inout) :: p
8228-
logical(LK),intent(in),optional :: val !! if the value is also to be set (if not present, then .false. is used).
8235+
logical(LK),intent(in),optional :: val !! if the value is also to be set
8236+
!! (if not present, then .false. is used).
82298237
character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed.
82308238

82318239
!set type and value:
@@ -8254,7 +8262,8 @@ subroutine to_integer(p,val,name)
82548262
implicit none
82558263

82568264
type(json_value),intent(inout) :: p
8257-
integer(IK),intent(in),optional :: val !! if the value is also to be set (if not present, then 0 is used).
8265+
integer(IK),intent(in),optional :: val !! if the value is also to be set
8266+
!! (if not present, then 0 is used).
82588267
character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed.
82598268

82608269
!set type and value:
@@ -8283,7 +8292,8 @@ subroutine to_double(p,val,name)
82838292
implicit none
82848293

82858294
type(json_value),intent(inout) :: p
8286-
real(RK),intent(in),optional :: val !! if the value is also to be set (if not present, then 0.0_rk is used).
8295+
real(RK),intent(in),optional :: val !! if the value is also to be set
8296+
!! (if not present, then 0.0_rk is used).
82878297
character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed.
82888298

82898299
!set type and value:
@@ -8577,14 +8587,16 @@ subroutine parse_string(json, unit, str, string)
85778587
class(json_core),intent(inout) :: json
85788588
integer(IK),intent(in) :: unit !! file unit number (if parsing from a file)
85798589
character(kind=CK,len=*),intent(in) :: str !! JSON string (if parsing from a string)
8580-
character(kind=CK,len=:),allocatable,intent(out) :: string
8590+
character(kind=CK,len=:),allocatable,intent(out) :: string !! the string (unescaped if necessary)
85818591

85828592
logical(LK) :: eof, is_hex, escape
85838593
character(kind=CK,len=1) :: c
85848594
character(kind=CK,len=4) :: hex
85858595
integer(IK) :: i
85868596
integer(IK) :: ip !! index to put next character,
85878597
!! to speed up by reducing the number of character string reallocations.
8598+
character(kind=CK,len=:),allocatable :: string_unescaped !! temp variable
8599+
character(kind=CK,len=:),allocatable :: error_message !! for string unescaping
85888600

85898601
!at least return a blank string if there is a problem:
85908602
string = repeat(space, chunk_size)
@@ -8665,6 +8677,18 @@ subroutine parse_string(json, unit, str, string)
86658677
end if
86668678
end if
86678679

8680+
!string is returned unescaped:
8681+
call unescape_string(string,string_unescaped,error_message)
8682+
if (allocated(error_message)) then
8683+
call json%throw_exception(error_message)
8684+
else
8685+
string = string_unescaped
8686+
end if
8687+
8688+
!cleanup:
8689+
if (allocated(error_message)) deallocate(error_message)
8690+
if (allocated(string_unescaped)) deallocate(string_unescaped)
8691+
86688692
end if
86698693

86708694
end subroutine parse_string

‎src/tests/jf_test_23.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -166,12 +166,12 @@ subroutine test_23(error_cnt)
166166
call check_i() ! 4
167167

168168
write(error_unit,'(A)') ''
169-
key = "/rfc6901 tests/i\\j"
169+
key = "/rfc6901 tests/i\j"
170170
call json%get(key, ival)
171171
call check_i() ! 5
172172

173173
write(error_unit,'(A)') ''
174-
key = "/rfc6901 tests/k\""l"
174+
key = "/rfc6901 tests/k""l"
175175
call json%get(key, ival)
176176
call check_i() ! 6
177177

0 commit comments

Comments
 (0)