Skip to content

Commit f9d4ba0

Browse files
jacobwilliamsjacobwilliams
committed
Added integer, double, logical, and null to string conversions for the get_string routines (when strict_type_checking is false).
Added option for get_string routines to return the escaped strings as is rather than unescaping it.
1 parent 1bf1923 commit f9d4ba0

File tree

2 files changed

+103
-21
lines changed

2 files changed

+103
-21
lines changed

‎src/json_file_module.F90‎

Lines changed: 16 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -272,7 +272,8 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
272272
strict_type_checking,&
273273
trailing_spaces_significant,&
274274
case_sensitive_keys,&
275-
no_whitespace)
275+
no_whitespace,&
276+
unescape_strings)
276277

277278
implicit none
278279

@@ -293,13 +294,18 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
293294
logical(LK),intent(in),optional :: no_whitespace !! if true, printing the JSON structure is
294295
!! done without adding any non-significant
295296
!! spaces or linebreaks (default is false)
297+
logical(LK),intent(in),optional :: unescape_strings !! If false, then the raw escaped
298+
!! string is returned from [[json_get_string]]
299+
!! and similar routines. If true [default],
300+
!! then the string is returned unescaped.
296301

297302
call me%core%initialize(verbose,compact_reals,&
298303
print_signs,real_format,spaces_per_tab,&
299304
strict_type_checking,&
300305
trailing_spaces_significant,&
301306
case_sensitive_keys,&
302-
no_whitespace)
307+
no_whitespace,&
308+
unescape_strings)
303309

304310
end subroutine initialize_json_core_in_file
305311
!*****************************************************************************************
@@ -358,7 +364,8 @@ function initialize_json_file(p,verbose,compact_reals,&
358364
strict_type_checking,&
359365
trailing_spaces_significant,&
360366
case_sensitive_keys,&
361-
no_whitespace) result(file_object)
367+
no_whitespace,&
368+
unescape_strings) result(file_object)
362369

363370
implicit none
364371

@@ -381,13 +388,18 @@ function initialize_json_file(p,verbose,compact_reals,&
381388
logical(LK),intent(in),optional :: no_whitespace !! if true, printing the JSON structure is
382389
!! done without adding any non-significant
383390
!! spaces or linebreaks (default is false)
391+
logical(LK),intent(in),optional :: unescape_strings !! If false, then the raw escaped
392+
!! string is returned from [[json_get_string]]
393+
!! and similar routines. If true [default],
394+
!! then the string is returned unescaped.
384395

385396
call file_object%initialize(verbose,compact_reals,&
386397
print_signs,real_format,spaces_per_tab,&
387398
strict_type_checking,&
388399
trailing_spaces_significant,&
389400
case_sensitive_keys,&
390-
no_whitespace)
401+
no_whitespace,&
402+
unescape_strings)
391403

392404
if (present(p)) file_object%p => p
393405

‎src/json_value_module.F90‎

Lines changed: 87 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -196,6 +196,11 @@ module json_value_module
196196
!! If true, the entire structure will be
197197
!! printed on one line.
198198

199+
logical(LK) :: unescaped_strings = .true. !! If false, then the raw escaped
200+
!! string is returned from [[json_get_string]]
201+
!! and similar routines. If true [default],
202+
!! then the string is returned unescaped.
203+
199204
contains
200205

201206
private
@@ -632,7 +637,8 @@ function initialize_json_core(verbose,compact_reals,&
632637
strict_type_checking,&
633638
trailing_spaces_significant,&
634639
case_sensitive_keys,&
635-
no_whitespace) result(json_core_object)
640+
no_whitespace,&
641+
unescape_strings) result(json_core_object)
636642

637643
implicit none
638644

@@ -654,13 +660,18 @@ function initialize_json_core(verbose,compact_reals,&
654660
logical(LK),intent(in),optional :: no_whitespace !! if true, printing the JSON structure is
655661
!! done without adding any non-significant
656662
!! spaces or linebreaks (default is false)
663+
logical(LK),intent(in),optional :: unescape_strings !! If false, then the raw escaped
664+
!! string is returned from [[json_get_string]]
665+
!! and similar routines. If true [default],
666+
!! then the string is returned unescaped.
657667

658668
call json_core_object%initialize(verbose,compact_reals,&
659669
print_signs,real_format,spaces_per_tab,&
660670
strict_type_checking,&
661671
trailing_spaces_significant,&
662672
case_sensitive_keys,&
663-
no_whitespace)
673+
no_whitespace,&
674+
unescape_strings)
664675

665676
end function initialize_json_core
666677
!*****************************************************************************************
@@ -689,7 +700,8 @@ subroutine json_initialize(json,verbose,compact_reals,&
689700
strict_type_checking,&
690701
trailing_spaces_significant,&
691702
case_sensitive_keys,&
692-
no_whitespace)
703+
no_whitespace,&
704+
unescape_strings)
693705

694706
implicit none
695707

@@ -710,6 +722,10 @@ subroutine json_initialize(json,verbose,compact_reals,&
710722
logical(LK),intent(in),optional :: no_whitespace !! if true, printing the JSON structure is
711723
!! done without adding any non-significant
712724
!! spaces or linebreaks (default is false)
725+
logical(LK),intent(in),optional :: unescape_strings !! If false, then the raw escaped
726+
!! string is returned from [[json_get_string]]
727+
!! and similar routines. If true [default],
728+
!! then the string is returned unescaped.
713729

714730
character(kind=CDK,len=10) :: w,d,e
715731
character(kind=CDK,len=2) :: sgn, rl_edit_desc
@@ -745,6 +761,8 @@ subroutine json_initialize(json,verbose,compact_reals,&
745761
json%case_sensitive_keys = case_sensitive_keys
746762
if (present(no_whitespace)) &
747763
json%no_whitespace = no_whitespace
764+
if (present(unescape_strings)) &
765+
json%unescaped_strings = unescape_strings
748766

749767
!Set the format for real numbers:
750768
! [if not changing it, then it remains the same]
@@ -5001,31 +5019,83 @@ subroutine json_get_string(json, me, value)
50015019
value = ''
50025020
if (.not. json%exception_thrown) then
50035021

5004-
select case (me%var_type)
5005-
5006-
case (json_string)
5022+
if (me%var_type == json_string) then
50075023

50085024
if (allocated(me%str_value)) then
5009-
call unescape_string(me%str_value, value, error_message)
5010-
if (allocated(error_message)) then
5011-
call json%throw_exception(error_message)
5012-
deallocate(error_message)
5013-
value = ''
5025+
if (json%unescaped_strings) then
5026+
call unescape_string(me%str_value, value, error_message)
5027+
if (allocated(error_message)) then
5028+
call json%throw_exception(error_message)
5029+
deallocate(error_message)
5030+
value = ''
5031+
end if
5032+
else
5033+
value = me%str_value
50145034
end if
50155035
else
50165036
call json%throw_exception('Error in json_get_string: '//&
50175037
'me%str_value not allocated')
50185038
end if
50195039

5020-
case default
5040+
else
50215041

5022-
call json%throw_exception('Error in json_get_string: '//&
5023-
'Unable to resolve value to characters: '//&
5024-
me%name)
5042+
if (json%strict_type_checking) then
5043+
call json%throw_exception('Error in json_get_string:'//&
5044+
' Unable to resolve value to string: '//me%name)
5045+
else
50255046

5026-
! Note: for the other cases, we could do val to string conversions.
5047+
select case (me%var_type)
50275048

5028-
end select
5049+
case (json_integer)
5050+
5051+
if (allocated(me%int_value)) then
5052+
value = repeat(' ', max_integer_str_len)
5053+
call integer_to_string(me%int_value,int_fmt,value)
5054+
value = trim(value)
5055+
else
5056+
call json%throw_exception('Error in json_get_string: '//&
5057+
'me%int_value not allocated')
5058+
end if
5059+
5060+
case (json_double)
5061+
5062+
if (allocated(me%dbl_value)) then
5063+
value = repeat(' ', max_numeric_str_len)
5064+
call real_to_string(me%dbl_value,json%real_fmt,&
5065+
json%compact_real,value)
5066+
value = trim(value)
5067+
else
5068+
call json%throw_exception('Error in dbl_value: '//&
5069+
'me%int_value not allocated')
5070+
end if
5071+
5072+
case (json_logical)
5073+
5074+
if (allocated(me%log_value)) then
5075+
if (me%log_value) then
5076+
value = true_str
5077+
else
5078+
value = false_str
5079+
end if
5080+
else
5081+
call json%throw_exception('Error in json_get_string: '//&
5082+
'me%log_value not allocated')
5083+
end if
5084+
5085+
case (json_null)
5086+
5087+
value = null_str
5088+
5089+
case default
5090+
5091+
call json%throw_exception('Error in json_get_string: '//&
5092+
'Unable to resolve value to characters: '//&
5093+
me%name)
5094+
5095+
end select
5096+
5097+
end if
5098+
end if
50295099

50305100
end if
50315101

0 commit comments

Comments
 (0)