Skip to content

Commit 9e61123

Browse files
jacobwilliamsjacobwilliams
committed
added strict type checking option. Fixes #173
some other minor refactoring.
1 parent 7a42686 commit 9e61123

File tree

3 files changed

+270
-209
lines changed

3 files changed

+270
-209
lines changed

‎src/json_file_module.F90

Lines changed: 18 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -241,7 +241,9 @@ end subroutine json_file_print_error_message
241241
!
242242
!@note: This does not destroy the data in the file.
243243

244-
subroutine initialize_json_core_in_file(me,verbose,compact_reals,print_signs,real_format,spaces_per_tab)
244+
subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
245+
print_signs,real_format,spaces_per_tab,&
246+
strict_type_checking)
245247

246248
implicit none
247249

@@ -251,8 +253,13 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,print_signs,rea
251253
logical(LK),intent(in),optional :: print_signs !! always print numeric sign (default is false)
252254
character(len=*,kind=CDK),intent(in),optional :: real_format !! Real number format: 'E' [default], '*', 'G', 'EN', or 'ES'
253255
integer,intent(in),optional :: spaces_per_tab !! number of spaces per tab for indenting (default is 2)
256+
logical(LK),intent(in),optional :: strict_type_checking !! if true, no integer, double, or logical type
257+
!! conversions are done for the `get` routines
258+
!! (default is false)
254259

255-
call me%json%initialize(verbose,compact_reals,print_signs,real_format,spaces_per_tab)
260+
call me%json%initialize(verbose,compact_reals,&
261+
print_signs,real_format,spaces_per_tab,&
262+
strict_type_checking)
256263

257264
end subroutine initialize_json_core_in_file
258265
!*****************************************************************************************
@@ -264,7 +271,9 @@ end subroutine initialize_json_core_in_file
264271
! Cast a [[json_value]] object as a [[json_file(type)]] object.
265272
! It also calls the `initialize()` method.
266273

267-
function initialize_json_file(p,verbose,compact_reals,print_signs,real_format,spaces_per_tab) result(file_object)
274+
function initialize_json_file(p,verbose,compact_reals,&
275+
print_signs,real_format,spaces_per_tab,&
276+
strict_type_checking) result(file_object)
268277

269278
implicit none
270279

@@ -276,8 +285,13 @@ function initialize_json_file(p,verbose,compact_reals,print_signs,real_format,sp
276285
logical(LK),intent(in),optional :: print_signs !! always print numeric sign (default is false)
277286
character(len=*,kind=CDK),intent(in),optional :: real_format !! Real number format: 'E' [default], '*', 'G', 'EN', or 'ES'
278287
integer,intent(in),optional :: spaces_per_tab !! number of spaces per tab for indenting (default is 2)
288+
logical(LK),intent(in),optional :: strict_type_checking !! if true, no integer, double, or logical type
289+
!! conversions are done for the `get` routines
290+
!! (default is false)
279291

280-
call file_object%initialize(verbose,compact_reals,print_signs,real_format,spaces_per_tab)
292+
call file_object%initialize(verbose,compact_reals,&
293+
print_signs,real_format,spaces_per_tab,&
294+
strict_type_checking)
281295

282296
if (present(p)) file_object%p => p
283297

‎src/json_string_utilities.F90

Lines changed: 132 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,7 @@ module json_string_utilities
6464
public :: valid_json_hex
6565
public :: to_unicode
6666
public :: escape_string
67+
public :: unescape_string
6768
public :: lowercase_character
6869

6970
contains
@@ -296,6 +297,137 @@ subroutine escape_string(str_in, str_out)
296297
end subroutine escape_string
297298
!*****************************************************************************************
298299

300+
!*****************************************************************************************
301+
!>
302+
! Remove the escape characters from a JSON string and return it.
303+
!
304+
! The escaped characters are denoted by the '\' character:
305+
!````
306+
! '\"' quotation mark
307+
! '\\' reverse solidus
308+
! '\/' solidus
309+
! '\b' backspace
310+
! '\f' formfeed
311+
! '\n' newline (LF)
312+
! '\r' carriage return (CR)
313+
! '\t' horizontal tab
314+
! '\uXXXX' 4 hexadecimal digits
315+
!````
316+
317+
subroutine unescape_string(str_in, str_out, error_message)
318+
319+
implicit none
320+
321+
character(kind=CK,len=*),intent(in) :: str_in !! string as stored in a [[json_value]]
322+
character(kind=CK,len=:),allocatable,intent(out) :: str_out !! decoded string
323+
character(kind=CK,len=:),allocatable,intent(out) :: error_message !! will be allocated if there was an error
324+
325+
integer :: i !! counter
326+
integer :: n !! length of str_in
327+
integer :: m !! length of str_out
328+
character(kind=CK,len=1) :: c !! for scanning each character in string
329+
330+
if (scan(str_in,backslash)>0) then
331+
332+
!there is at least one escape character, so process this string:
333+
334+
n = len(str_in)
335+
str_out = repeat(space,n) !size the output string (will be trimmed later)
336+
m = 0 !counter in str_out
337+
i = 0 !counter in str_in
338+
339+
do
340+
341+
i = i + 1
342+
if (i>n) exit ! finished
343+
c = str_in(i:i) ! get next character in the string
344+
345+
if (c == backslash) then
346+
347+
if (i<n) then
348+
349+
i = i + 1
350+
c = str_in(i:i) !character after the escape
351+
352+
if (any(c == [quotation_mark,backslash,slash, &
353+
to_unicode(['b','f','n','r','t'])])) then
354+
355+
select case(c)
356+
case (quotation_mark,backslash,slash)
357+
!use d as is
358+
case (CK_'b')
359+
c = bspace
360+
case (CK_'f')
361+
c = formfeed
362+
case (CK_'n')
363+
c = newline
364+
case (CK_'r')
365+
c = carriage_return
366+
case (CK_'t')
367+
c = horizontal_tab
368+
end select
369+
370+
m = m + 1
371+
str_out(m:m) = c
372+
373+
else if (c == 'u') then !expecting 4 hexadecimal digits after
374+
!the escape character [\uXXXX]
375+
376+
!for now, we are just returning them as is
377+
![not checking to see if it is a valid hex value]
378+
!
379+
! Example:
380+
! 123456
381+
! \uXXXX
382+
383+
if (i+4<=n) then
384+
m = m + 1
385+
str_out(m:m+5) = str_in(i-1:i+4)
386+
i = i + 4
387+
m = m + 5
388+
else
389+
error_message = 'Error in unescape_string:'//&
390+
' Invalid hexadecimal sequence'//&
391+
' in string: '//str_in(i-1:)
392+
if (allocated(str_out)) deallocate(str_out)
393+
return
394+
end if
395+
396+
else
397+
!unknown escape character
398+
error_message = 'Error in unescape_string:'//&
399+
' unknown escape sequence in string "'//&
400+
trim(str_in)//'" ['//backslash//c//']'
401+
if (allocated(str_out)) deallocate(str_out)
402+
return
403+
end if
404+
405+
else
406+
!an escape character is the last character in
407+
! the string [this may not be valid syntax,
408+
! but just keep it]
409+
m = m + 1
410+
str_out(m:m) = c
411+
end if
412+
413+
else
414+
m = m + 1
415+
str_out(m:m) = c
416+
end if
417+
418+
end do
419+
420+
!trim trailing space:
421+
str_out = str_out(1:m)
422+
423+
else
424+
!there are no escape characters, so return as is:
425+
str_out = str_in
426+
end if
427+
428+
end subroutine unescape_string
429+
!*****************************************************************************************
430+
299431
!*****************************************************************************************
300432
!> author: Jacob Williams
301433
! date:6/14/2014

0 commit comments

Comments
 (0)