Merge pull request #306 from jacobwilliams/devel

Devel

Author: jacobwilliams

.gitignore

@@ -11,8 +11,15 @@ doc/
 .sconsign.*
 files/*.json
 .cflags.*
-visual_studio/*.suo
-visual_studio/*.u2d
+*.suo
+*.u2d
+*.user
+
 visual_studio/Debug/
 visual_studio/Release/
 visual_studio/x64/
+visual_studio/.vs/
+visual_studio/jsonfortranlib/
+visual_studio/jsonfortrantest/Debug/
+visual_studio/jsonfortrantest/Release/
+visual_studio/jsonfortrantest/x64

src/json_file_module.F90

@@ -339,7 +339,8 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
                                             path_mode,&
                                             path_separator,&
                                             compress_vectors,&
-                                            allow_duplicate_keys)
+                                            allow_duplicate_keys,&
+                                            escape_solidus)
 
     implicit none
 
@@ -357,7 +358,8 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
                             path_mode,&
                             path_separator,&
                             compress_vectors,&
-                            allow_duplicate_keys)
+                            allow_duplicate_keys,&
+                            escape_solidus)
 
     end subroutine initialize_json_core_in_file
 !*****************************************************************************************
@@ -422,7 +424,8 @@ function initialize_json_file(p,verbose,compact_reals,&
                                   path_mode,&
                                   path_separator,&
                                   compress_vectors,&
-                                  allow_duplicate_keys) result(file_object)
+                                  allow_duplicate_keys,&
+                                  escape_solidus) result(file_object)
 
     implicit none
 
@@ -442,7 +445,8 @@ function initialize_json_file(p,verbose,compact_reals,&
                                 path_mode,&
                                 path_separator,&
                                 compress_vectors,&
-                                allow_duplicate_keys)
+                                allow_duplicate_keys,&
+                                escape_solidus)
 
     if (present(p)) file_object%p => p
 

src/json_initialize_arguments.inc

@@ -66,3 +66,11 @@ logical(LK),intent(in),optional :: allow_duplicate_keys
   !!   keys are found, an error is thrown. A call to
   !!   [[json_value_validate]] will also check for
   !!   duplicates.
+logical(LK),intent(in),optional :: escape_solidus
+  !! * If True then the solidus "`/`" is always escaped
+  !!   "`\/`" when serializing JSON
+  !! * If False [default], then it is not escaped.
+  !! Note that this option does not affect parsing
+  !! (both escaped and unescaped are still valid in
+  !! all cases).
+

src/json_string_utilities.F90

@@ -293,12 +293,14 @@ end subroutine compact_real_string
 !
 !  Add the escape characters to a string for adding to JSON.
 
-    subroutine escape_string(str_in, str_out)
+    subroutine escape_string(str_in, str_out, escape_solidus)
 
     implicit none
 
     character(kind=CK,len=*),intent(in)              :: str_in
     character(kind=CK,len=:),allocatable,intent(out) :: str_out
+    logical(LK),intent(in) :: escape_solidus  !! if the solidus (forward slash)
+                                              !! is also to be escaped
 
     integer(IK) :: i    !! counter
     integer(IK) :: ipos !! accumulated string size
@@ -308,20 +310,29 @@ subroutine escape_string(str_in, str_out)
 #if defined __GFORTRAN__
     character(kind=CK,len=:),allocatable :: tmp !! workaround for bug in gfortran 6.1
 #endif
+    logical :: to_be_escaped !! if there are characters to be escaped
 
-    character(kind=CK,len=*),parameter :: specials = quotation_mark//&
+    character(kind=CK,len=*),parameter :: specials_no_slash = quotation_mark//&
                                                      backslash//&
-                                                     slash//&
                                                      bspace//&
                                                      formfeed//&
                                                      newline//&
                                                      carriage_return//&
                                                      horizontal_tab
 
+    character(kind=CK,len=*),parameter :: specials = specials_no_slash//slash
+
+
     !Do a quick scan for the special characters,
     ! if any are present, then process the string,
     ! otherwise, return the string as is.
-    if (scan(str_in,specials)>0) then
+    if (escape_solidus) then
+        to_be_escaped = scan(str_in,specials)>0
+    else
+        to_be_escaped = scan(str_in,specials_no_slash)>0
+    end if
+
+    if (to_be_escaped) then
 
         str_out = repeat(space,chunk_size)
         ipos = 1
@@ -351,9 +362,14 @@ subroutine escape_string(str_in, str_out)
                 str_out(ipos:ipos+1) = backslash//c
                 ipos = ipos + 2
 
-            case(quotation_mark,slash)
+            case(quotation_mark)
                 str_out(ipos:ipos+1) = backslash//c
                 ipos = ipos + 2
+            case(slash)
+                if (escape_solidus) then
+                    str_out(ipos:ipos+1) = backslash//c
+                    ipos = ipos + 2
+                end if
             case(bspace)
                 str_out(ipos:ipos+1) = '\b'
                 ipos = ipos + 2

src/json_value_module.F90

@@ -237,6 +237,13 @@ module json_value_module
                                                      !! will also check for duplicates. If True
                                                      !! [default] then no special checks are done
 
+        logical(LK) :: escape_solidus = .false.   !! If True then the solidus "`/`" is always escaped
+                                                  !! ("`\/`") when serializing JSON.
+                                                  !! If False [default], then it is not escaped.
+                                                  !! Note that this option does not affect parsing
+                                                  !! (both escaped and unescaped versions are still
+                                                  !! valid in all cases).
+
         contains
 
         private
@@ -792,7 +799,8 @@ function initialize_json_core(verbose,compact_reals,&
                                   path_mode,&
                                   path_separator,&
                                   compress_vectors,&
-                                  allow_duplicate_keys) result(json_core_object)
+                                  allow_duplicate_keys,&
+                                  escape_solidus) result(json_core_object)
 
     implicit none
 
@@ -810,7 +818,8 @@ function initialize_json_core(verbose,compact_reals,&
                                 path_mode,&
                                 path_separator,&
                                 compress_vectors,&
-                                allow_duplicate_keys)
+                                allow_duplicate_keys,&
+                                escape_solidus)
 
     end function initialize_json_core
 !*****************************************************************************************
@@ -845,7 +854,8 @@ subroutine json_initialize(me,verbose,compact_reals,&
                                path_mode,&
                                path_separator,&
                                compress_vectors,&
-                               allow_duplicate_keys)
+                               allow_duplicate_keys,&
+                               escape_solidus)
 
     implicit none
 
@@ -923,6 +933,11 @@ subroutine json_initialize(me,verbose,compact_reals,&
         me%allow_duplicate_keys = allow_duplicate_keys
     end if
 
+    ! if escaping the forward slash:
+    if (present(escape_solidus)) then
+        me%escape_solidus = escape_solidus
+    end if
+
     !Set the format for real numbers:
     ! [if not changing it, then it remains the same]
 
@@ -1975,7 +1990,7 @@ recursive subroutine json_value_destroy(json,p,destroy_next)
                 if (associated(child)) then
                     p%children => p%children%next
                     p%n_children = p%n_children - 1
-                    call json_value_destroy(json,child,.false.)
+                    call json%destroy(child,.false.)
                 else
                     call json%throw_exception('Error in json_value_destroy: '//&
                                               'Malformed JSON linked list')
@@ -1986,7 +2001,7 @@ recursive subroutine json_value_destroy(json,p,destroy_next)
             nullify(child)
         end if
 
-        if (associated(p%next) .and. des_next) call json_value_destroy(json,p%next)
+        if (associated(p%next) .and. des_next) call json%destroy(p%next)
 
         if (associated(p%previous)) nullify(p%previous)
         if (associated(p%parent))   nullify(p%parent)
@@ -2418,7 +2433,6 @@ subroutine json_value_validate(json,p,is_valid,error_msg)
     logical(LK) :: has_duplicate !! to check for duplicate keys
     character(kind=CK,len=:),allocatable :: path  !! path to duplicate key
     logical(LK) :: status_ok !! to check for existing exception
-    logical(LK) :: status_ok2 !! to check for a new exception
     character(kind=CK,len=:),allocatable :: exception_msg  !! error message for an existing exception
     character(kind=CK,len=:),allocatable :: exception_msg2  !! error message for a new exception
 
@@ -5257,7 +5271,7 @@ 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)
+                        call escape_string(element%name,str_escaped,json%escape_solidus)
                         if (json%no_whitespace) then
                             !compact printing - no extra space
                             call write_it(repeat(space, spaces)//quotation_mark//&
@@ -5384,7 +5398,7 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
 
             if (allocated(p%str_value)) then
                 ! have to escape the string for printing:
-                call escape_string(p%str_value,str_escaped)
+                call escape_string(p%str_value,str_escaped,json%escape_solidus)
                 call write_it( s//quotation_mark// &
                                str_escaped//quotation_mark, &
                                comma=print_comma, &
@@ -6863,7 +6877,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=1),intent(in),optional :: path_sep
+        character(kind=CK,len=*),intent(in),optional :: path_sep
             !! path separator (default is '.').
             !! (ignored if `json%path_mode/=1`)
 
@@ -7678,7 +7692,7 @@ subroutine json_get_string(json, me, value)
                     value = me%str_value
                 else
                     ! return the escaped version:
-                    call escape_string(me%str_value, value)
+                    call escape_string(me%str_value, value, json%escape_solidus)
                 end if
             else
                call json%throw_exception('Error in json_get_string: '//&

src/tests/jf_test_1.f90

@@ -488,6 +488,7 @@ end subroutine print_json_variable
 end module jf_test_1_mod
 !*****************************************************************************************
 
+#ifndef INTERGATED_TESTS
 !*****************************************************************************************
 program jf_test_1
 
@@ -502,3 +503,4 @@ program jf_test_1
 
 end program jf_test_1
 !*****************************************************************************************
+#endif

src/tests/jf_test_10.f90

@@ -334,6 +334,7 @@ end subroutine test_10
 end module jf_test_10_mod
 !*****************************************************************************************
 
+#ifndef INTERGATED_TESTS
 !*****************************************************************************************
 program jf_test_10
 
@@ -348,3 +349,4 @@ program jf_test_10
 
 end program jf_test_10
 !*****************************************************************************************
+#endif

src/tests/jf_test_11.F90

@@ -274,6 +274,7 @@ end subroutine test_11
 end module jf_test_11_mod
 !*****************************************************************************************
 
+#ifndef INTERGATED_TESTS
 !*****************************************************************************************
 program jf_test_11
 
@@ -288,3 +289,4 @@ program jf_test_11
 
 end program jf_test_11
 !*****************************************************************************************
+#endif

src/tests/jf_test_12.f90

@@ -232,6 +232,7 @@ end subroutine test_12
 end module jf_test_12_mod
 !*****************************************************************************************
 
+#ifndef INTERGATED_TESTS
 !*****************************************************************************************
 program jf_test_12
 
@@ -246,3 +247,4 @@ program jf_test_12
 
 end program jf_test_12
 !*****************************************************************************************
+#endif

src/tests/jf_test_13.f90

@@ -62,6 +62,7 @@ end subroutine test_13
 end module jf_test_13_mod
 !*****************************************************************************************
 
+#ifndef INTERGATED_TESTS
 !*****************************************************************************************
 program jf_test_13
 
@@ -75,3 +76,4 @@ program jf_test_13
 
 end program jf_test_13
 !*****************************************************************************************
+#endif