Skip to content

Commit 9c38bbb

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #289 from jacobwilliams/escape-fix
Escape fix
2 parents b37fb99 + 520ebe0 commit 9c38bbb

5 files changed

+140
-58
lines changed

‎src/json_file_module.F90

+2-2
Original file line numberDiff line numberDiff line change
@@ -1190,7 +1190,7 @@ end subroutine wrap_json_file_get_string_vec
11901190
! date: 12/17/2016
11911191
!
11921192
! Get an (allocatable length) string vector from a JSON file.
1193-
! This is just a wrapper for [[json_get_alloc_string_vec_with_path]].
1193+
! This is just a wrapper for [[json_get_alloc_string_vec_by_path]].
11941194

11951195
subroutine json_file_get_alloc_string_vec(me, path, vec, ilen, found)
11961196

@@ -1212,7 +1212,7 @@ end subroutine json_file_get_alloc_string_vec
12121212
!*****************************************************************************************
12131213
!>
12141214
! Alternate version of [[json_file_get_alloc_string_vec]], where "path" is kind=CDK.
1215-
! This is just a wrapper for [[wrap_json_get_alloc_string_vec_with_path]].
1215+
! This is just a wrapper for [[wrap_json_get_alloc_string_vec_by_path]].
12161216

12171217
subroutine wrap_json_file_get_alloc_string_vec(me, path, vec, ilen, found)
12181218

‎src/json_string_utilities.F90

+28-13
Original file line numberDiff line numberDiff line change
@@ -335,7 +335,23 @@ subroutine escape_string(str_in, str_out)
335335
if (ipos+3>len(str_out)) str_out = str_out // repeat(space, chunk_size)
336336

337337
select case(c)
338-
case(quotation_mark,backslash,slash)
338+
case(backslash)
339+
340+
!test for unicode sequence: '\uXXXX'
341+
![don't add an extra '\' for those]
342+
if (i+5<=len(str_in)) then
343+
if (str_in(i+1:i+1)==CK_'u' .and. &
344+
valid_json_hex(str_in(i+2:i+5))) then
345+
str_out(ipos:ipos) = c
346+
ipos = ipos + 1
347+
cycle
348+
end if
349+
end if
350+
351+
str_out(ipos:ipos+1) = backslash//c
352+
ipos = ipos + 2
353+
354+
case(quotation_mark,slash)
339355
str_out(ipos:ipos+1) = backslash//c
340356
ipos = ipos + 2
341357
case(bspace)
@@ -387,18 +403,17 @@ end subroutine escape_string
387403
!>
388404
! Remove the escape characters from a JSON string and return it.
389405
!
390-
! The escaped characters are denoted by the '\' character:
391-
!````
392-
! '\"' quotation mark
393-
! '\\' reverse solidus
394-
! '\/' solidus
395-
! '\b' backspace
396-
! '\f' formfeed
397-
! '\n' newline (LF)
398-
! '\r' carriage return (CR)
399-
! '\t' horizontal tab
400-
! '\uXXXX' 4 hexadecimal digits
401-
!````
406+
! The escaped characters are denoted by the `\` character:
407+
!
408+
! * `\"` - quotation mark
409+
! * `\\` - reverse solidus
410+
! * `\/` - solidus
411+
! * `\b` - backspace
412+
! * `\f` - formfeed
413+
! * `\n` - newline (LF)
414+
! * `\r` - carriage return (CR)
415+
! * `\t` - horizontal tab
416+
! * `\uXXXX` - 4 hexadecimal digits
402417

403418
subroutine unescape_string(str_in, str_out, error_message)
404419

‎src/json_value_module.F90

+71-41
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
@@ -287,13 +288,13 @@ module json_value_module
287288
! thrown if the existing variable is not a scalar).
288289
!
289290
!### See also
290-
! * [[add_by_path]] - this one can be used to change
291+
! * [[json_core(type):add_by_path]] - this one can be used to change
291292
! arrays and objects to scalars if so desired.
292293
!
293294
!@note Unlike some routines, the `found` output is not optional,
294295
! so it doesn't present exceptions from being thrown.
295296
!
296-
!@note These have been mostly supplanted by the [[add_by_path]]
297+
!@note These have been mostly supplanted by the [[json_core(type):add_by_path]]
297298
! methods, which do a similar thing (and can be used for
298299
! scalars and vectors, etc.)
299300
generic,public :: update => MAYBEWRAP(json_update_logical),&
@@ -378,7 +379,7 @@ module json_value_module
378379
! (This will create a `null` variable)
379380
!
380381
!### See also
381-
! * [[add_by_path]]
382+
! * [[json_core(type):add_by_path]]
382383

383384
generic,public :: create => MAYBEWRAP(json_create_by_path)
384385
procedure :: MAYBEWRAP(json_create_by_path)
@@ -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 )
@@ -5144,7 +5154,12 @@ subroutine write_it(s,advance,comma,space_after_comma)
51445154
end if
51455155
end if
51465156
if (present(advance)) then
5147-
add_line_break = advance
5157+
if (json%no_whitespace) then
5158+
! overrides input value:
5159+
add_line_break = .false.
5160+
else
5161+
add_line_break = advance
5162+
end if
51485163
else
51495164
add_line_break = .not. json%no_whitespace ! default is to advance if
51505165
! we are printing whitespace
@@ -6823,23 +6838,18 @@ subroutine json_get_string(json, me, value)
68236838
type(json_value),pointer,intent(in) :: me
68246839
character(kind=CK,len=:),allocatable,intent(out) :: value
68256840

6826-
character(kind=CK,len=:),allocatable :: error_message !! for [[unescape_string]]
6827-
68286841
value = CK_''
68296842
if (.not. json%exception_thrown) then
68306843

68316844
if (me%var_type == json_string) then
68326845

68336846
if (allocated(me%str_value)) then
68346847
if (json%unescaped_strings) then
6835-
call unescape_string(me%str_value, value, error_message)
6836-
if (allocated(error_message)) then
6837-
call json%throw_exception(error_message)
6838-
deallocate(error_message)
6839-
value = CK_''
6840-
end if
6841-
else
6848+
! default: it is stored already unescaped:
68426849
value = me%str_value
6850+
else
6851+
! return the escaped version:
6852+
call escape_string(me%str_value, value)
68436853
end if
68446854
else
68456855
call json%throw_exception('Error in json_get_string: '//&
@@ -7824,11 +7834,13 @@ recursive subroutine parse_value(json, unit, str, value)
78247834
select case (value%var_type)
78257835
case (json_string)
78267836
#if defined __GFORTRAN__
7827-
call json%parse_string(unit,str,tmp) ! write to a tmp variable because of
7828-
value%str_value = tmp ! a bug in 4.9 gfortran compiler.
7829-
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)
78307842
#else
7831-
call json%parse_string(unit, str, value%str_value)
7843+
call json%parse_string(unit,str,value%str_value)
78327844
#endif
78337845
end select
78347846

@@ -8220,7 +8232,8 @@ subroutine to_logical(p,val,name)
82208232
implicit none
82218233

82228234
type(json_value),intent(inout) :: p
8223-
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).
82248237
character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed.
82258238

82268239
!set type and value:
@@ -8249,7 +8262,8 @@ subroutine to_integer(p,val,name)
82498262
implicit none
82508263

82518264
type(json_value),intent(inout) :: p
8252-
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).
82538267
character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed.
82548268

82558269
!set type and value:
@@ -8278,7 +8292,8 @@ subroutine to_double(p,val,name)
82788292
implicit none
82798293

82808294
type(json_value),intent(inout) :: p
8281-
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).
82828297
character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed.
82838298

82848299
!set type and value:
@@ -8564,6 +8579,7 @@ end subroutine parse_array
85648579
!### History
85658580
! * Jacob Williams : 6/16/2014 : Added hex validation.
85668581
! * Jacob Williams : 12/3/2015 : Fixed some bugs.
8582+
! * Jacob Williams : 8/23/2015 : `string` is now returned unescaped.
85678583

85688584
subroutine parse_string(json, unit, str, string)
85698585

@@ -8572,14 +8588,16 @@ subroutine parse_string(json, unit, str, string)
85728588
class(json_core),intent(inout) :: json
85738589
integer(IK),intent(in) :: unit !! file unit number (if parsing from a file)
85748590
character(kind=CK,len=*),intent(in) :: str !! JSON string (if parsing from a string)
8575-
character(kind=CK,len=:),allocatable,intent(out) :: string
8591+
character(kind=CK,len=:),allocatable,intent(out) :: string !! the string (unescaped if necessary)
85768592

85778593
logical(LK) :: eof, is_hex, escape
85788594
character(kind=CK,len=1) :: c
85798595
character(kind=CK,len=4) :: hex
85808596
integer(IK) :: i
85818597
integer(IK) :: ip !! index to put next character,
85828598
!! to speed up by reducing the number of character string reallocations.
8599+
character(kind=CK,len=:),allocatable :: string_unescaped !! temp variable
8600+
character(kind=CK,len=:),allocatable :: error_message !! for string unescaping
85838601

85848602
!at least return a blank string if there is a problem:
85858603
string = repeat(space, chunk_size)
@@ -8660,6 +8678,18 @@ subroutine parse_string(json, unit, str, string)
86608678
end if
86618679
end if
86628680

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

86658695
end subroutine parse_string

‎src/tests/jf_test_2.f90

+37
Original file line numberDiff line numberDiff line change
@@ -138,6 +138,43 @@ subroutine test_2(error_cnt)
138138
call json%print_error_message(error_unit)
139139
error_cnt = error_cnt + 1
140140
end if
141+
call json%add(inp, 'special chars', '\ /')
142+
if (json%failed()) then
143+
call json%print_error_message(error_unit)
144+
error_cnt = error_cnt + 1
145+
end if
146+
call json%add(inp, 'special chars in key \ /', '\ /')
147+
if (json%failed()) then
148+
call json%print_error_message(error_unit)
149+
error_cnt = error_cnt + 1
150+
end if
151+
152+
call json%add(inp, 'bspace', achar(8,kind=json_CK))
153+
if (json%failed()) then
154+
call json%print_error_message(error_unit)
155+
error_cnt = error_cnt + 1
156+
end if
157+
call json%add(inp, 'horizontal_tab', achar(9,kind=json_CK))
158+
if (json%failed()) then
159+
call json%print_error_message(error_unit)
160+
error_cnt = error_cnt + 1
161+
end if
162+
call json%add(inp, 'newline', achar(10,kind=json_CK))
163+
if (json%failed()) then
164+
call json%print_error_message(error_unit)
165+
error_cnt = error_cnt + 1
166+
end if
167+
call json%add(inp, 'formfeed', achar(12,kind=json_CK))
168+
if (json%failed()) then
169+
call json%print_error_message(error_unit)
170+
error_cnt = error_cnt + 1
171+
end if
172+
call json%add(inp, 'carriage_return', achar(13,kind=json_CK))
173+
if (json%failed()) then
174+
call json%print_error_message(error_unit)
175+
error_cnt = error_cnt + 1
176+
end if
177+
141178
nullify(inp)
142179

143180
!trajectory variables:

0 commit comments

Comments
 (0)