Merge pull request #289 from jacobwilliams/escape-fix

Escape fix

Author: jacobwilliams

src/json_file_module.F90

@@ -1190,7 +1190,7 @@ end subroutine wrap_json_file_get_string_vec
 !  date: 12/17/2016
 !
 !  Get an (allocatable length) string vector from a JSON file.
-!  This is just a wrapper for [[json_get_alloc_string_vec_with_path]].
+!  This is just a wrapper for [[json_get_alloc_string_vec_by_path]].
 
     subroutine json_file_get_alloc_string_vec(me, path, vec, ilen, found)
 
@@ -1212,7 +1212,7 @@ end subroutine json_file_get_alloc_string_vec
 !*****************************************************************************************
 !>
 !  Alternate version of [[json_file_get_alloc_string_vec]], where "path" is kind=CDK.
-!  This is just a wrapper for [[wrap_json_get_alloc_string_vec_with_path]].
+!  This is just a wrapper for [[wrap_json_get_alloc_string_vec_by_path]].
 
     subroutine wrap_json_file_get_alloc_string_vec(me, path, vec, ilen, found)
 

src/json_string_utilities.F90

@@ -335,7 +335,23 @@ subroutine escape_string(str_in, str_out)
             if (ipos+3>len(str_out)) str_out = str_out // repeat(space, chunk_size)
 
             select case(c)
-            case(quotation_mark,backslash,slash)
+            case(backslash)
+
+                !test for unicode sequence: '\uXXXX'
+                ![don't add an extra '\' for those]
+                if (i+5<=len(str_in)) then
+                    if (str_in(i+1:i+1)==CK_'u' .and. &
+                        valid_json_hex(str_in(i+2:i+5))) then
+                        str_out(ipos:ipos) = c
+                        ipos = ipos + 1
+                        cycle
+                    end if
+                end if
+
+                str_out(ipos:ipos+1) = backslash//c
+                ipos = ipos + 2
+
+            case(quotation_mark,slash)
                 str_out(ipos:ipos+1) = backslash//c
                 ipos = ipos + 2
             case(bspace)
@@ -387,18 +403,17 @@ end subroutine escape_string
 !>
 !  Remove the escape characters from a JSON string and return it.
 !
-!  The escaped characters are denoted by the '\' character:
-!````
-!    '\"'        quotation mark
-!    '\\'        reverse solidus
-!    '\/'        solidus
-!    '\b'        backspace
-!    '\f'        formfeed
-!    '\n'        newline (LF)
-!    '\r'        carriage return (CR)
-!    '\t'        horizontal tab
-!    '\uXXXX'    4 hexadecimal digits
-!````
+!  The escaped characters are denoted by the `\` character:
+!
+!  * `\"`        - quotation mark
+!  * `\\`        - reverse solidus
+!  * `\/`        - solidus
+!  * `\b`        - backspace
+!  * `\f`        - formfeed
+!  * `\n`        - newline (LF)
+!  * `\r`        - carriage return (CR)
+!  * `\t`        - horizontal tab
+!  * `\uXXXX`    - 4 hexadecimal digits
 
     subroutine unescape_string(str_in, str_out, error_message)
 

src/json_value_module.F90

@@ -115,11 +115,12 @@ module json_value_module
         type(json_value),pointer :: children => null()  !! first child item of this
         type(json_value),pointer :: tail     => null()  !! last child item of this
 
-        character(kind=CK,len=:),allocatable :: name  !! variable name
+        character(kind=CK,len=:),allocatable :: name  !! variable name (unescaped)
 
         real(RK),allocatable                 :: dbl_value  !! real data for this variable
         logical(LK),allocatable              :: log_value  !! logical data for this variable
         character(kind=CK,len=:),allocatable :: str_value  !! string data for this variable
+                                                           !! (unescaped)
         integer(IK),allocatable              :: int_value  !! integer data for this variable
 
         integer(IK) :: var_type = json_unknown  !! variable type
@@ -287,13 +288,13 @@ module json_value_module
         !  thrown if the existing variable is not a scalar).
         !
         !### See also
-        !  * [[add_by_path]] - this one can be used to change
+        !  * [[json_core(type):add_by_path]] - this one can be used to change
         !    arrays and objects to scalars if so desired.
         !
         !@note Unlike some routines, the `found` output is not optional,
         !      so it doesn't present exceptions from being thrown.
         !
-        !@note These have been mostly supplanted by the [[add_by_path]]
+        !@note These have been mostly supplanted by the [[json_core(type):add_by_path]]
         !      methods, which do a similar thing (and can be used for
         !      scalars and vectors, etc.)
         generic,public :: update => MAYBEWRAP(json_update_logical),&
@@ -378,7 +379,7 @@ module json_value_module
         !  (This will create a `null` variable)
         !
         !### See also
-        !  * [[add_by_path]]
+        !  * [[json_core(type):add_by_path]]
 
         generic,public :: create => MAYBEWRAP(json_create_by_path)
         procedure :: MAYBEWRAP(json_create_by_path)
@@ -641,9 +642,12 @@ module json_value_module
         generic,public :: get_path => MAYBEWRAP(json_get_path)
         procedure :: MAYBEWRAP(json_get_path)
 
-        procedure,public :: remove              => json_value_remove        !! Remove a [[json_value]] from a linked-list structure.
-        procedure,public :: replace             => json_value_replace       !! Replace a [[json_value]] in a linked-list structure.
-        procedure,public :: reverse             => json_value_reverse       !! Reverse the order of the children of an array of object.
+        procedure,public :: remove              => json_value_remove        !! Remove a [[json_value]] from a
+                                                                            !! linked-list structure.
+        procedure,public :: replace             => json_value_replace       !! Replace a [[json_value]] in a
+                                                                            !! linked-list structure.
+        procedure,public :: reverse             => json_value_reverse       !! Reverse the order of the children
+                                                                            !! of an array of object.
         procedure,public :: check_for_errors    => json_check_for_errors    !! check for error and get error message
         procedure,public :: clear_exceptions    => json_clear_exceptions    !! clear exceptions
         procedure,public :: count               => json_count               !! count the number of children
@@ -654,14 +658,19 @@ module json_value_module
         procedure,public :: get_previous        => json_get_previous        !! get pointer to json_value previous
         procedure,public :: get_tail            => json_get_tail            !! get pointer to json_value tail
         procedure,public :: initialize          => json_initialize          !! to initialize some parsing parameters
-        procedure,public :: traverse            => json_traverse            !! to traverse all elements of a JSON structure
-        procedure,public :: print_error_message => json_print_error_message !! simply routine to print error messages
+        procedure,public :: traverse            => json_traverse            !! to traverse all elements of a JSON
+                                                                            !! structure
+        procedure,public :: print_error_message => json_print_error_message !! simply routine to print error
+                                                                            !! messages
         procedure,public :: swap                => json_value_swap          !! Swap two [[json_value]] pointers
-                                                                            !! in a structure (or two different structures).
-        procedure,public :: is_child_of         => json_value_is_child_of   !! Check if a [[json_value]] is a descendant of another.
-        procedure,public :: validate            => json_value_validate      !! Check that a [[json_value]] linked list is valid
-                                                                            !! (i.e., is properly constructed). This may be
-                                                                            !! useful if it has been constructed externally.
+                                                                            !! in a structure (or two different
+                                                                            !! structures).
+        procedure,public :: is_child_of         => json_value_is_child_of   !! Check if a [[json_value]] is a
+                                                                            !! descendant of another.
+        procedure,public :: validate            => json_value_validate      !! Check that a [[json_value]] linked
+                                                                            !! list is valid (i.e., is properly
+                                                                            !! constructed). This may be useful
+                                                                            !! if it has been constructed externally.
 
         !other private routines:
         procedure :: name_equal
@@ -4223,13 +4232,9 @@ subroutine json_value_add_string(json, p, name, val)
     character(kind=CK,len=*),intent(in) :: val   !! value
 
     type(json_value),pointer :: var
-    character(kind=CK,len=:),allocatable :: str
-
-    !add escape characters if necessary:
-    call escape_string(val, str)
 
     !create the variable:
-    call json%create_string(var,str,name)
+    call json%create_string(var,val,name)
 
     !add it:
     call json%add(p, var)
@@ -4855,6 +4860,8 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
     integer(IK) :: var_type,var_type_prev
     logical(LK) :: is_vector !! if all elements of a vector
                              !! are scalars of the same type
+    character(kind=CK,len=:),allocatable :: str_escaped !! escaped version of
+                                                        !! `name` or `str_value`
 
     if (.not. json%exception_thrown) then
 
@@ -4931,19 +4938,20 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
 
                     ! print the name
                     if (allocated(element%name)) then
+                        call escape_string(element%name,str_escaped)
                         if (json%no_whitespace) then
                             !compact printing - no extra space
                             call write_it(repeat(space, spaces)//quotation_mark//&
-                                          element%name//quotation_mark//colon_char,&
+                                          str_escaped//quotation_mark//colon_char,&
                                           advance=.false.)
                         else
                             call write_it(repeat(space, spaces)//quotation_mark//&
-                                          element%name//quotation_mark//colon_char//space,&
+                                          str_escaped//quotation_mark//colon_char//space,&
                                           advance=.false.)
                         end if
                     else
                         call json%throw_exception('Error in json_value_print:'//&
-                                             ' element%name not allocated')
+                                                  ' element%name not allocated')
                         nullify(element)
                         return
                     end if
@@ -5056,8 +5064,10 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
         case (json_string)
 
             if (allocated(p%str_value)) then
+                ! have to escape the string for printing:
+                call escape_string(p%str_value,str_escaped)
                 call write_it( s//quotation_mark// &
-                               p%str_value//quotation_mark, &
+                               str_escaped//quotation_mark, &
                                comma=print_comma, &
                                advance=(.not. is_vector),&
                                space_after_comma=is_vector )
@@ -5144,7 +5154,12 @@ subroutine write_it(s,advance,comma,space_after_comma)
             end if
         end if
         if (present(advance)) then
-            add_line_break = advance
+            if (json%no_whitespace) then
+                ! overrides input value:
+                add_line_break = .false.
+            else
+                add_line_break = advance
+            end if
         else
             add_line_break = .not. json%no_whitespace ! default is to advance if
                                                       ! we are printing whitespace
@@ -6823,23 +6838,18 @@ subroutine json_get_string(json, me, value)
     type(json_value),pointer,intent(in)              :: me
     character(kind=CK,len=:),allocatable,intent(out) :: value
 
-    character(kind=CK,len=:),allocatable :: error_message  !! for [[unescape_string]]
-
     value = CK_''
     if (.not. json%exception_thrown) then
 
         if (me%var_type == json_string) then
 
             if (allocated(me%str_value)) then
                 if (json%unescaped_strings) then
-                    call unescape_string(me%str_value, value, error_message)
-                    if (allocated(error_message)) then
-                        call json%throw_exception(error_message)
-                        deallocate(error_message)
-                        value = CK_''
-                    end if
-                else
+                    ! default: it is stored already unescaped:
                     value = me%str_value
+                else
+                    ! return the escaped version:
+                    call escape_string(me%str_value, value)
                 end if
             else
                call json%throw_exception('Error in json_get_string: '//&
@@ -7824,11 +7834,13 @@ recursive subroutine parse_value(json, unit, str, value)
                 select case (value%var_type)
                 case (json_string)
 #if defined __GFORTRAN__
-                    call json%parse_string(unit,str,tmp)  ! write to a tmp variable because of
-                    value%str_value = tmp                 ! a bug in 4.9 gfortran compiler.
-                    deallocate(tmp)                       !
+                    ! write to a tmp variable because of
+                    ! a bug in 4.9 gfortran compiler.
+                    call json%parse_string(unit,str,tmp)
+                    value%str_value = tmp
+                    if (allocated(tmp))  deallocate(tmp)
 #else
-                    call json%parse_string(unit, str, value%str_value)
+                    call json%parse_string(unit,str,value%str_value)
 #endif
                 end select
 
@@ -8220,7 +8232,8 @@ subroutine to_logical(p,val,name)
     implicit none
 
     type(json_value),intent(inout)               :: p
-    logical(LK),intent(in),optional              :: val   !! if the value is also to be set (if not present, then .false. is used).
+    logical(LK),intent(in),optional              :: val   !! if the value is also to be set
+                                                          !! (if not present, then .false. is used).
     character(kind=CK,len=*),intent(in),optional :: name  !! if the name is also to be changed.
 
     !set type and value:
@@ -8249,7 +8262,8 @@ subroutine to_integer(p,val,name)
     implicit none
 
     type(json_value),intent(inout)               :: p
-    integer(IK),intent(in),optional              :: val   !! if the value is also to be set (if not present, then 0 is used).
+    integer(IK),intent(in),optional              :: val   !! if the value is also to be set
+                                                          !! (if not present, then 0 is used).
     character(kind=CK,len=*),intent(in),optional :: name  !! if the name is also to be changed.
 
     !set type and value:
@@ -8278,7 +8292,8 @@ subroutine to_double(p,val,name)
     implicit none
 
     type(json_value),intent(inout)               :: p
-    real(RK),intent(in),optional                 :: val   !! if the value is also to be set (if not present, then 0.0_rk is used).
+    real(RK),intent(in),optional                 :: val   !! if the value is also to be set
+                                                          !! (if not present, then 0.0_rk is used).
     character(kind=CK,len=*),intent(in),optional :: name  !! if the name is also to be changed.
 
     !set type and value:
@@ -8564,6 +8579,7 @@ end subroutine parse_array
 !### History
 !  * Jacob Williams : 6/16/2014 : Added hex validation.
 !  * Jacob Williams : 12/3/2015 : Fixed some bugs.
+!  * Jacob Williams : 8/23/2015 : `string` is now returned unescaped.
 
     subroutine parse_string(json, unit, str, string)
 
@@ -8572,14 +8588,16 @@ subroutine parse_string(json, unit, str, string)
     class(json_core),intent(inout)                   :: json
     integer(IK),intent(in)                           :: unit  !! file unit number (if parsing from a file)
     character(kind=CK,len=*),intent(in)              :: str   !! JSON string (if parsing from a string)
-    character(kind=CK,len=:),allocatable,intent(out) :: string
+    character(kind=CK,len=:),allocatable,intent(out) :: string !! the string (unescaped if necessary)
 
     logical(LK) :: eof, is_hex, escape
     character(kind=CK,len=1) :: c
     character(kind=CK,len=4) :: hex
     integer(IK) :: i
     integer(IK) :: ip !! index to put next character,
                       !! to speed up by reducing the number of character string reallocations.
+    character(kind=CK,len=:),allocatable :: string_unescaped !! temp variable
+    character(kind=CK,len=:),allocatable :: error_message !! for string unescaping
 
     !at least return a blank string if there is a problem:
     string = repeat(space, chunk_size)
@@ -8660,6 +8678,18 @@ subroutine parse_string(json, unit, str, string)
             end if
         end if
 
+        !string is returned unescaped:
+        call unescape_string(string,string_unescaped,error_message)
+        if (allocated(error_message)) then
+            call json%throw_exception(error_message)
+        else
+            string = string_unescaped
+        end if
+
+        !cleanup:
+        if (allocated(error_message))    deallocate(error_message)
+        if (allocated(string_unescaped)) deallocate(string_unescaped)
+
     end if
 
     end subroutine parse_string

src/tests/jf_test_2.f90

@@ -138,6 +138,43 @@ subroutine test_2(error_cnt)
         call json%print_error_message(error_unit)
         error_cnt = error_cnt + 1
     end if
+    call json%add(inp, 'special chars', '\ /')
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+    call json%add(inp, 'special chars in key \ /', '\ /')
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+
+    call json%add(inp, 'bspace', achar(8,kind=json_CK))
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+    call json%add(inp, 'horizontal_tab', achar(9,kind=json_CK))
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+    call json%add(inp, 'newline', achar(10,kind=json_CK))
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+    call json%add(inp, 'formfeed', achar(12,kind=json_CK))
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+    call json%add(inp, 'carriage_return', achar(13,kind=json_CK))
+    if (json%failed()) then
+        call json%print_error_message(error_unit)
+        error_cnt = error_cnt + 1
+    end if
+
     nullify(inp)
 
     !trajectory variables: