diff --git a/src/json_file_module.F90 b/src/json_file_module.F90 index 2e85a5f7f7..f288afacb2 100644 --- a/src/json_file_module.F90 +++ b/src/json_file_module.F90 @@ -48,8 +48,8 @@ module json_file_module ! character(len=:),allocatable :: cval ! logical :: found ! call json%initialize(compact_reals=.true.) - ! call json%load_file(filename='myfile.json') - ! call json%print_file() !print to the console + ! call json%load(filename='myfile.json') + ! call json%print() !print to the console ! call json%get('var.i',ival,found) ! call json%get('var.r(3)',rval,found) ! call json%get('var.c',cval,found) @@ -57,8 +57,9 @@ module json_file_module ! end program test !``` ! - !@warning The `destroy()` method must be called before the variable - ! goes out of scope or a memory leak will occur. + !@note The `destroy()` method may be called to free the memory if necessary. + ! [[json_file(type)]] includes a finalizer that also calls + ! `destroy()` when the variable goes out of scope. type,public :: json_file @@ -75,11 +76,32 @@ module json_file_module procedure,public :: get_core => get_json_core_in_file + !> + ! Load JSON from a file. + procedure,public :: load => json_file_load + + !> + ! The same as `load`, but only here for backward compatibility procedure,public :: load_file => json_file_load + !> + ! Load JSON from a string. + generic,public :: deserialize => MAYBEWRAP(json_file_load_from_string) + + !> + ! The same as `deserialize`, but only here for backward compatibility generic,public :: load_from_string => MAYBEWRAP(json_file_load_from_string) + !> + ! Print the [[json_value]] structure to an allocatable string + procedure,public :: serialize => json_file_print_to_string + + !> + ! The same as `serialize`, but only here for backward compatibility + procedure,public :: print_to_string => json_file_print_to_string + procedure,public :: destroy => json_file_destroy + procedure,public :: nullify => json_file_nullify procedure,public :: move => json_file_move_pointer generic,public :: info => MAYBEWRAP(json_file_variable_info) generic,public :: matrix_info => MAYBEWRAP(json_file_variable_matrix_info) @@ -90,11 +112,15 @@ module json_file_module procedure,public :: check_for_errors => json_file_check_for_errors procedure,public :: clear_exceptions => json_file_clear_exceptions - procedure,public :: print_to_string => json_file_print_to_string + generic,public :: print => json_file_print_to_console, & + json_file_print_to_unit, & + json_file_print_to_filename + !> + ! The same as `print`, but only here for backward compatibility generic,public :: print_file => json_file_print_to_console, & - json_file_print_1, & - json_file_print_2 + json_file_print_to_unit, & + json_file_print_to_filename !> ! Rename a variable, specifying it by path @@ -149,10 +175,11 @@ module json_file_module ! call f%add('inputs.t', 0.0_rk) ! call f%add('inputs.x', [1.0_rk,2.0_rk,3.0_rk]) ! call f%add('inputs.flag', .true.) - ! call f%print_file() + ! call f%print() ! print to the console ! end program test !``` - generic,public :: add => MAYBEWRAP(json_file_add_object), & + generic,public :: add => json_file_add, & + MAYBEWRAP(json_file_add_object), & MAYBEWRAP(json_file_add_integer), & #ifndef REAL32 MAYBEWRAP(json_file_add_real32), & @@ -217,6 +244,9 @@ module json_file_module generic,public :: operator(.in.) => MAYBEWRAP(json_file_valid_path_op) procedure,pass(me) :: MAYBEWRAP(json_file_valid_path_op) + generic,public :: assignment(=) => assign_json_file + procedure :: assign_json_file + ! *************************************************** ! private routines ! *************************************************** @@ -268,6 +298,7 @@ module json_file_module procedure :: json_file_get_root !add: + procedure :: json_file_add procedure :: MAYBEWRAP(json_file_add_object) procedure :: MAYBEWRAP(json_file_add_integer) #ifndef REAL32 @@ -315,10 +346,12 @@ module json_file_module !remove: procedure :: MAYBEWRAP(json_file_remove) - !print_file: + !print: procedure :: json_file_print_to_console - procedure :: json_file_print_1 - procedure :: json_file_print_2 + procedure :: json_file_print_to_unit + procedure :: json_file_print_to_filename + + final :: finalize_json_file end type json_file !********************************************************* @@ -363,6 +396,23 @@ module json_file_module contains !***************************************************************************************** +!***************************************************************************************** +!> +! Finalizer for [[json_file]] class. +! +! Just a wrapper for [[json_file_destroy]]. + + subroutine finalize_json_file(me) + + implicit none + + type(json_file),intent(inout) :: me + + call me%destroy(destroy_core=.true.) + + end subroutine finalize_json_file +!***************************************************************************************** + !***************************************************************************************** !> ! Check error status in the file. @@ -447,41 +497,18 @@ end subroutine json_file_print_error_message ! and [[initialize_json_file_from_string_v2]] ! all have a similar interface. - subroutine initialize_json_core_in_file(me,verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) + subroutine initialize_json_core_in_file(me,& +#include "json_initialize_dummy_arguments.inc" + ) implicit none class(json_file),intent(inout) :: me #include "json_initialize_arguments.inc" - call me%core%initialize(verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) - + call me%core%initialize(& +#include "json_initialize_dummy_arguments.inc" + ) end subroutine initialize_json_core_in_file !***************************************************************************************** @@ -536,44 +563,29 @@ end subroutine get_json_core_in_file ! and [[initialize_json_file_from_string_v2]] ! all have a similar interface. - function initialize_json_file(p,verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) result(file_object) + function initialize_json_file(p,& +#include "json_initialize_dummy_arguments.inc" + ) result(file_object) implicit none type(json_file) :: file_object - type(json_value),pointer,optional,intent(in) :: p !! `json_value` object to cast - !! as a `json_file` object + type(json_value),pointer,optional :: p !! `json_value` object to cast + !! as a `json_file` object. This + !! will be nullified. #include "json_initialize_arguments.inc" - call file_object%initialize(verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) - - if (present(p)) file_object%p => p + call file_object%initialize(& +#include "json_initialize_dummy_arguments.inc" + ) + + if (present(p)) then + file_object%p => p + ! we have to nullify it to avoid + ! a dangling pointer when the file + ! goes out of scope + nullify(p) + end if end function initialize_json_file !***************************************************************************************** @@ -585,7 +597,7 @@ end function initialize_json_file ! Cast a [[json_value]] pointer and a [[json_core(type)]] object ! as a [[json_file(type)]] object. - function initialize_json_file_v2(json_value_object, json_core_object) & + function initialize_json_file_v2(json_value_object,json_core_object) & result(file_object) implicit none @@ -620,20 +632,9 @@ end function initialize_json_file_v2 ! and [[initialize_json_file_from_string_v2]] ! all have a similar interface. - function initialize_json_file_from_string(str,verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) result(file_object) + function initialize_json_file_from_string(str,& +#include "json_initialize_dummy_arguments.inc" + ) result(file_object) implicit none @@ -641,22 +642,10 @@ function initialize_json_file_from_string(str,verbose,compact_reals,& character(kind=CK,len=*),intent(in) :: str !! string to load JSON data from #include "json_initialize_arguments.inc" - call file_object%initialize(verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) - - call file_object%load_from_string(str) + call file_object%initialize(& +#include "json_initialize_dummy_arguments.inc" + ) + call file_object%deserialize(str) end function initialize_json_file_from_string !***************************************************************************************** @@ -665,20 +654,9 @@ end function initialize_json_file_from_string !> ! Alternate version of [[initialize_json_file_from_string]], where "str" is kind=CDK. - function wrap_initialize_json_file_from_string(str,verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) result(file_object) + function wrap_initialize_json_file_from_string(str,& +#include "json_initialize_dummy_arguments.inc" + ) result(file_object) implicit none @@ -687,20 +665,9 @@ function wrap_initialize_json_file_from_string(str,verbose,compact_reals,& #include "json_initialize_arguments.inc" file_object = initialize_json_file_from_string(& - to_unicode(str),verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) + to_unicode(str),& +#include "json_initialize_dummy_arguments.inc" + ) end function wrap_initialize_json_file_from_string !***************************************************************************************** @@ -722,7 +689,7 @@ function initialize_json_file_from_string_v2(str, json_core_object) & type(json_core),intent(in) :: json_core_object file_object%core = json_core_object - call file_object%load_from_string(str) + call file_object%deserialize(str) end function initialize_json_file_from_string_v2 !***************************************************************************************** @@ -745,11 +712,39 @@ function wrap_initialize_json_file_from_string_v2(str,json_core_object) & end function wrap_initialize_json_file_from_string_v2 !***************************************************************************************** +!***************************************************************************************** +!> author: Jacob Williams +! +! Nullify the [[json_value]] pointer in a [[json_file(type)]], +! but do not destroy it. +! +! This should normally only be done if the pointer is the target of +! another pointer outside the class that is still intended to be in +! scope after the [[json_file(type)]] has gone out of scope. +! Otherwise, this would result in a memory leak. +! +!### See also +! * [[json_file_destroy]] +! +!### History +! * 6/30/2019 : Created + + subroutine json_file_nullify(me) + + implicit none + + class(json_file),intent(inout) :: me + + nullify(me%p) + + end subroutine json_file_nullify +!***************************************************************************************** + !***************************************************************************************** !> author: Jacob Williams ! ! Destroy the [[json_value]] data in a [[json_file(type)]]. -! This must be done when the variable is no longer needed, +! This may be done when the variable is no longer needed, ! or will be reused to open a different file. ! Otherwise a memory leak will occur. ! @@ -757,9 +752,15 @@ end function wrap_initialize_json_file_from_string_v2 ! is not necessary to prevent memory leaks, since a [[json_core(type)]] ! does not use pointers). ! +!### See also +! * [[json_file_nullify]] +! !### History ! * 12/9/2013 : Created ! * 4/26/2016 : Added optional `destroy_core` argument +! +!@note This routine will be called automatically when the variable +! goes out of scope. subroutine json_file_destroy(me,destroy_core) @@ -828,7 +829,7 @@ end subroutine json_file_move_pointer ! use json_module ! implicit none ! type(json_file) :: f -! call f%load_file('my_file.json') +! call f%load('my_file.json') ! !... ! call f%destroy() ! end program main @@ -844,7 +845,7 @@ subroutine json_file_load(me, filename, unit) !! (if not present, a newunit !! is used) - call me%core%parse(file=filename, p=me%p, unit=unit) + call me%core%load(file=filename, p=me%p, unit=unit) end subroutine json_file_load !***************************************************************************************** @@ -860,7 +861,7 @@ end subroutine json_file_load ! Load JSON from a string: !```fortran ! type(json_file) :: f -! call f%load_from_string('{ "name": "Leonidas" }') +! call f%deserialize('{ "name": "Leonidas" }') !``` subroutine json_file_load_from_string(me, str) @@ -870,7 +871,7 @@ subroutine json_file_load_from_string(me, str) class(json_file),intent(inout) :: me character(kind=CK,len=*),intent(in) :: str !! string to load JSON data from - call me%core%parse(str=str, p=me%p) + call me%core%deserialize(me%p, str) end subroutine json_file_load_from_string !***************************************************************************************** @@ -886,7 +887,7 @@ subroutine wrap_json_file_load_from_string(me, str) class(json_file),intent(inout) :: me character(kind=CDK,len=*),intent(in) :: str - call me%load_from_string(to_unicode(str)) + call me%deserialize(to_unicode(str)) end subroutine wrap_json_file_load_from_string !***************************************************************************************** @@ -914,7 +915,7 @@ end subroutine json_file_print_to_console ! ! Prints the JSON file to the specified file unit number. - subroutine json_file_print_1(me, iunit) + subroutine json_file_print_to_unit(me, iunit) implicit none @@ -924,10 +925,10 @@ subroutine json_file_print_1(me, iunit) if (iunit/=unit2str) then call me%core%print(me%p,iunit=iunit) else - call me%core%throw_exception('Error in json_file_print_1: iunit must not be -1.') + call me%core%throw_exception('Error in json_file_print_to_unit: iunit must not be -1.') end if - end subroutine json_file_print_1 + end subroutine json_file_print_to_unit !***************************************************************************************** !***************************************************************************************** @@ -943,12 +944,12 @@ end subroutine json_file_print_1 !```fortran ! type(json_file) :: f ! logical :: found -! call f%load_file('my_file.json') !open the original file -! call f%update('version',4,found) !change the value of a variable -! call f%print_file('my_file_2.json') !save file as new name +! call f%load('my_file.json') !open the original file +! call f%update('version',4,found) !change the value of a variable +! call f%print('my_file_2.json') !save file as new name !``` - subroutine json_file_print_2(me,filename) + subroutine json_file_print_to_filename(me,filename) implicit none @@ -957,7 +958,7 @@ subroutine json_file_print_2(me,filename) call me%core%print(me%p,filename) - end subroutine json_file_print_2 + end subroutine json_file_print_to_filename !***************************************************************************************** !***************************************************************************************** @@ -972,8 +973,8 @@ end subroutine json_file_print_2 !```fortran ! type(json_file) :: f ! character(kind=CK,len=:),allocatable :: str -! call f%load_file('my_file.json') -! call f%print_file(str) +! call f%load('my_file.json') +! call f%serialize(str) !``` subroutine json_file_print_to_string(me,str) @@ -983,7 +984,7 @@ subroutine json_file_print_to_string(me,str) class(json_file),intent(inout) :: me character(kind=CK,len=:),allocatable,intent(out) :: str !! string to print JSON data to - call me%core%print_to_string(me%p,str) + call me%core%serialize(me%p,str) end subroutine json_file_print_to_string !***************************************************************************************** @@ -1122,6 +1123,26 @@ subroutine json_file_get_root(me,p) end subroutine json_file_get_root !***************************************************************************************** +!***************************************************************************************** +!> author: Jacob Williams +! +! Assignment operator for [[json_core(type)]]. +! This will duplicate the [[json_core(type)]] and also +! perform a deep copy of the [[json_value(type)]] data structure. + + subroutine assign_json_file(me,f) + + implicit none + + class(json_file),intent(out) :: me + type(json_file),intent(in) :: f + + me%core = f%core ! no pointers here so OK to copy + call me%core%clone(f%p,me%p) + + end subroutine assign_json_file +!***************************************************************************************** + !***************************************************************************************** !> author: Jacob Williams ! @@ -1829,6 +1850,50 @@ subroutine wrap_json_file_get_alloc_string_vec(me, path, vec, ilen, found) end subroutine wrap_json_file_get_alloc_string_vec !***************************************************************************************** +!***************************************************************************************** +!> author: Jacob Williams +! +! Add a [[json_value]] pointer as the root object to a JSON file. +! +!### Note +! +! This is mostly equivalent to: +!```fortran +! f = [[json_file]](p) +!``` +! But without the finalization calls. +! +! And: +!```fortran +! if (destroy_original) call [[json_file]]%destroy() +! call [[json_file]]%add('$',p) +!``` + + subroutine json_file_add(me,p,destroy_original) + + implicit none + + class(json_file),intent(inout) :: me + type(json_value),pointer,intent(in) :: p !! pointer to the variable to add + logical(LK),intent(in),optional :: destroy_original !! if the file currently contains + !! an associated pointer, it is + !! destroyed. [Default is True] + + logical(LK) :: destroy !! if `me%p` is to be destroyed + + if (present(destroy_original)) then + destroy = destroy_original + else + destroy = .true. ! default + end if + + if (destroy) call me%core%destroy(me%p) + + me%p => p + + end subroutine json_file_add +!***************************************************************************************** + !***************************************************************************************** !> author: Jacob Williams ! diff --git a/src/json_initialize_arguments.inc b/src/json_initialize_arguments.inc index a4f67bc487..d1dfd14477 100644 --- a/src/json_initialize_arguments.inc +++ b/src/json_initialize_arguments.inc @@ -1,4 +1,6 @@ ! The argument list for the various `initialize` subroutines. +! +! See also: json_initialize_dummy_arguments.inc logical(LK),intent(in),optional :: verbose !! mainly useful for debugging (default is false) @@ -13,7 +15,7 @@ integer(IK),intent(in),optional :: spaces_per_tab logical(LK),intent(in),optional :: strict_type_checking !! if true, no integer, double, or logical type !! conversions are done for the `get` routines - !! (default is false) + !! (default is false). logical(LK),intent(in),optional :: trailing_spaces_significant !! for name and path comparisons, is trailing !! space to be considered significant. @@ -77,4 +79,24 @@ logical(LK),intent(in),optional :: escape_solidus logical(LK),intent(in),optional :: stop_on_error !! If an exception is raised, then immediately quit. !! (Default is False). - +integer(IK),intent(in),optional :: null_to_real_mode + !! if `strict_type_checking=false`: + !! + !! * 1 : an exception will be raised if + !! try to retrieve a `null` as a real. + !! * 2 : a `null` retrieved as a real + !! will return a NaN. [default] + !! * 3 : a `null` retrieved as a real + !! will return 0.0. +integer(IK),intent(in),optional :: non_normal_mode + !! How to serialize NaN, Infinity, and + !! -Infinity real values: + !! + !! * 1 : as strings (e.g., "NaN", + !! "Infinity", "-Infinity") [default] + !! * 2 : as JSON `null` values +logical(LK),intent(in),optional :: use_quiet_nan + !! if true [default], `null_to_real_mode=2` + !! and [[string_to_real]] will use + !! `ieee_quiet_nan` for NaN values. If false, + !! `ieee_signaling_nan` will be used. \ No newline at end of file diff --git a/src/json_initialize_dummy_arguments.inc b/src/json_initialize_dummy_arguments.inc new file mode 100644 index 0000000000..b575462514 --- /dev/null +++ b/src/json_initialize_dummy_arguments.inc @@ -0,0 +1,24 @@ +! The dummy argument list for the various `initialize` subroutines. +! +! See also: json_initialize_argument.inc + +verbose,& +compact_reals,& +print_signs,& +real_format,& +spaces_per_tab,& +strict_type_checking,& +trailing_spaces_significant,& +case_sensitive_keys,& +no_whitespace,& +unescape_strings,& +comment_char,& +path_mode,& +path_separator,& +compress_vectors,& +allow_duplicate_keys,& +escape_solidus,& +stop_on_error,& +null_to_real_mode,& +non_normal_mode,& +use_quiet_nan & \ No newline at end of file diff --git a/src/json_parameters.F90 b/src/json_parameters.F90 index d13d08b670..fdc2ad0ad8 100644 --- a/src/json_parameters.F90 +++ b/src/json_parameters.F90 @@ -56,16 +56,15 @@ module json_parameters character(kind=CK,len=*),parameter :: this = CK_'@' !! 'this' for [[json_get_by_path_default]] character(kind=CK,len=*),parameter :: dot = CK_'.' !! path separator for [[json_get_by_path_default]] character(kind=CK,len=*),parameter :: tilde = CK_'~' !! RFC 6901 escape character - character(kind=CK,len=*),parameter :: percent = CK_'%' !! Fortran path separator character(kind=CK,len=*),parameter :: single_quote = CK_"'" !! for JSONPath bracket-notation + character(kind=CK,len=*),parameter :: slash = CK_'/' !! JSON special character + character(kind=CK,len=*),parameter :: backslash = CK_'\' !! JSON special character + character(kind=CK,len=*),parameter :: quotation_mark = CK_'"' !! JSON special character character(kind=CK,len=*),parameter :: bspace = achar(8, kind=CK) !! JSON special character character(kind=CK,len=*),parameter :: horizontal_tab = achar(9, kind=CK) !! JSON special character character(kind=CK,len=*),parameter :: newline = achar(10, kind=CK) !! JSON special character character(kind=CK,len=*),parameter :: formfeed = achar(12, kind=CK) !! JSON special character character(kind=CK,len=*),parameter :: carriage_return = achar(13, kind=CK) !! JSON special character - character(kind=CK,len=*),parameter :: quotation_mark = achar(34, kind=CK) !! JSON special character - character(kind=CK,len=*),parameter :: slash = achar(47, kind=CK) !! JSON special character - character(kind=CK,len=*),parameter :: backslash = achar(92, kind=CK) !! JSON special character !> default real number format statement (for writing real values to strings and files). ! Note that this can be overridden by calling [[json_initialize]]. diff --git a/src/json_string_utilities.F90 b/src/json_string_utilities.F90 index e0021fa15a..9c6b6d3dfd 100644 --- a/src/json_string_utilities.F90 +++ b/src/json_string_utilities.F90 @@ -11,6 +11,7 @@ module json_string_utilities + use,intrinsic :: ieee_arithmetic use json_kinds use json_parameters @@ -148,10 +149,11 @@ end subroutine string_to_integer ! Convert a real value to a string. ! !### Modified -! * Izaak Beekman : 02/24/2015 : added the compact option. +! * Izaak Beekman : 02/24/2015 : added the compact option. ! * Jacob Williams : 10/27/2015 : added the star option. +! * Jacob Williams : 07/07/2019 : added null and ieee options. - subroutine real_to_string(rval,real_fmt,compact_real,str) + subroutine real_to_string(rval,real_fmt,compact_real,non_normals_to_null,str) implicit none @@ -159,22 +161,49 @@ subroutine real_to_string(rval,real_fmt,compact_real,str) character(kind=CDK,len=*),intent(in) :: real_fmt !! format for real numbers logical(LK),intent(in) :: compact_real !! compact the string so that it is !! displayed with fewer characters + logical(LK),intent(in) :: non_normals_to_null !! If True, NaN, Infinity, or -Infinity are returned as `null`. + !! If False, the string value will be returned in quotes + !! (e.g., "NaN", "Infinity", or "-Infinity" ) character(kind=CK,len=*),intent(out) :: str !! `rval` converted to a string. - integer(IK) :: istat + integer(IK) :: istat !! write `iostat` flag - if (real_fmt==star) then - write(str,fmt=*,iostat=istat) rval - else - write(str,fmt=real_fmt,iostat=istat) rval - end if + if (ieee_is_finite(rval) .and. .not. ieee_is_nan(rval)) then + + ! normal real numbers + + if (real_fmt==star) then + write(str,fmt=*,iostat=istat) rval + else + write(str,fmt=real_fmt,iostat=istat) rval + end if + + if (istat==0) then + !in this case, the default string will be compacted, + ! so that the same value is displayed with fewer characters. + if (compact_real) call compact_real_string(str) + else + str = repeat(star,len(str)) ! error + end if - if (istat==0) then - !in this case, the default string will be compacted, - ! so that the same value is displayed with fewer characters. - if (compact_real) call compact_real_string(str) else - str = repeat(star,len(str)) + ! special cases for NaN, Infinity, and -Infinity + + if (non_normals_to_null) then + ! return it as a JSON null value + str = null_str + else + ! Let the compiler do the real to string conversion + ! like before, but put the result in quotes so it + ! gets printed as a string + write(str,fmt=*,iostat=istat) rval + if (istat==0) then + str = quotation_mark//trim(adjustl(str))//quotation_mark + else + str = repeat(star,len(str)) ! error + end if + end if + end if end subroutine real_to_string @@ -192,19 +221,34 @@ end subroutine real_to_string ! (e.g., when `str='1E-5'`). ! * Jacob Williams : 2/6/2017 : moved core logic to this routine. - subroutine string_to_real(str,rval,status_ok) + subroutine string_to_real(str,use_quiet_nan,rval,status_ok) implicit none - character(kind=CK,len=*),intent(in) :: str !! the string to convert to a real - real(RK),intent(out) :: rval !! `str` converted to a real value - logical(LK),intent(out) :: status_ok !! true if there were no errors + character(kind=CK,len=*),intent(in) :: str !! the string to convert to a real + logical(LK),intent(in) :: use_quiet_nan !! if true, return NaN's as `ieee_quiet_nan`. + !! otherwise, use `ieee_signaling_nan`. + real(RK),intent(out) :: rval !! `str` converted to a real value + logical(LK),intent(out) :: status_ok !! true if there were no errors integer(IK) :: ierr !! read iostat error code read(str,fmt=*,iostat=ierr) rval status_ok = (ierr==0) - if (.not. status_ok) rval = 0.0_RK + if (.not. status_ok) then + rval = 0.0_RK + else + if (ieee_support_nan(rval)) then + if (ieee_is_nan(rval)) then + ! make sure to return the correct NaN + if (use_quiet_nan) then + rval = ieee_value(rval,ieee_quiet_nan) + else + rval = ieee_value(rval,ieee_signaling_nan) + end if + end if + end if + end if end subroutine string_to_real !***************************************************************************************** diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index 858ef15b83..9c87818fbe 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -15,6 +15,7 @@ module json_value_module use,intrinsic :: iso_fortran_env, only: iostat_end,error_unit,output_unit + use,intrinsic :: ieee_arithmetic use json_kinds use json_parameters use json_string_utilities @@ -256,6 +257,27 @@ module json_value_module !! (both escaped and unescaped versions are still !! valid in all cases). + integer(IK) :: null_to_real_mode = 2_IK !! if `strict_type_checking=false`: + !! + !! * 1 : an exception will be raised if + !! try to retrieve a `null` as a real. + !! * 2 : a `null` retrieved as a real + !! will return NaN. [default] + !! * 3 : a `null` retrieved as a real + !! will return 0.0. + + logical(LK) :: non_normals_to_null = .false. !! How to serialize NaN, Infinity, + !! and -Infinity real values: + !! + !! * If true : as JSON `null` values + !! * If false : as strings (e.g., "NaN", + !! "Infinity", "-Infinity") [default] + + logical(LK) :: use_quiet_nan = .true. !! if true [default], `null_to_real_mode=2` + !! and [[string_to_real]] will use + !! `ieee_quiet_nan` for NaN values. If false, + !! `ieee_signaling_nan` will be used. + integer :: ichunk = 0 !! index in `chunk` for [[pop_char]] !! when `use_unformatted_stream=True` integer :: filesize = 0 !! the file size when when `use_unformatted_stream=True` @@ -392,7 +414,7 @@ module json_value_module ! call json%add_by_path(p,'inputs.t', 0.0_wp ) ! call json%add_by_path(p,'inputs.x(1)', 100.0_wp) ! call json%add_by_path(p,'inputs.x(2)', 200.0_wp) - ! call json%print(p,output_unit) ! now print to console + ! call json%print(p) ! now print to console !```` ! !### Notes @@ -479,25 +501,25 @@ module json_value_module ! path. The path version is split up into unicode and non-unicode versions. generic,public :: get => & - MAYBEWRAP(json_get_by_path), & - json_get_integer, MAYBEWRAP(json_get_integer_by_path), & - json_get_integer_vec, MAYBEWRAP(json_get_integer_vec_by_path), & + MAYBEWRAP(json_get_by_path), & + json_get_integer, MAYBEWRAP(json_get_integer_by_path), & + json_get_integer_vec, MAYBEWRAP(json_get_integer_vec_by_path), & #ifndef REAL32 - json_get_real32, MAYBEWRAP(json_get_real32_by_path), & - json_get_real32_vec, MAYBEWRAP(json_get_real32_vec_by_path), & + json_get_real32, MAYBEWRAP(json_get_real32_by_path), & + json_get_real32_vec, MAYBEWRAP(json_get_real32_vec_by_path), & #endif - json_get_real, MAYBEWRAP(json_get_real_by_path), & - json_get_real_vec, MAYBEWRAP(json_get_real_vec_by_path), & + json_get_real, MAYBEWRAP(json_get_real_by_path), & + json_get_real_vec, MAYBEWRAP(json_get_real_vec_by_path), & #ifdef REAL128 - json_get_real64, MAYBEWRAP(json_get_real64_by_path), & - json_get_real64_vec, MAYBEWRAP(json_get_real64_vec_by_path), & + json_get_real64, MAYBEWRAP(json_get_real64_by_path), & + json_get_real64_vec, MAYBEWRAP(json_get_real64_vec_by_path), & #endif - json_get_logical, MAYBEWRAP(json_get_logical_by_path), & - json_get_logical_vec, MAYBEWRAP(json_get_logical_vec_by_path), & - json_get_string, MAYBEWRAP(json_get_string_by_path), & - json_get_string_vec, MAYBEWRAP(json_get_string_vec_by_path), & - json_get_alloc_string_vec,MAYBEWRAP(json_get_alloc_string_vec_by_path),& - json_get_array, MAYBEWRAP(json_get_array_by_path) + json_get_logical, MAYBEWRAP(json_get_logical_by_path), & + json_get_logical_vec, MAYBEWRAP(json_get_logical_vec_by_path), & + json_get_string, MAYBEWRAP(json_get_string_by_path), & + json_get_string_vec, MAYBEWRAP(json_get_string_vec_by_path), & + json_get_alloc_string_vec, MAYBEWRAP(json_get_alloc_string_vec_by_path),& + json_get_array, MAYBEWRAP(json_get_array_by_path) procedure,private :: json_get_integer procedure,private :: json_get_integer_vec @@ -540,12 +562,8 @@ module json_value_module procedure,private :: json_get_by_path_rfc6901 procedure,private :: json_get_by_path_jsonpath_bracket - procedure,public :: print_to_string => json_value_to_string !! Print the [[json_value]] - !! structure to an allocatable - !! string - !> - ! Print the [[json_value]] to a file. + ! Print the [[json_value]] to an output unit or file. ! !### Example ! @@ -555,7 +573,10 @@ module json_value_module ! !... ! call json%print(p,'test.json') !this is [[json_print_to_filename]] !```` - generic,public :: print => json_print_to_unit,json_print_to_filename + generic,public :: print => json_print_to_console,& + json_print_to_unit,& + json_print_to_filename + procedure :: json_print_to_console procedure :: json_print_to_unit procedure :: json_print_to_filename @@ -732,10 +753,27 @@ module json_value_module !> ! Parse the JSON file and populate the [[json_value]] tree. - generic,public :: parse => json_parse_file, MAYBEWRAP(json_parse_string) + generic,public :: load => json_parse_file procedure :: json_parse_file + + !> + ! Print the [[json_value]] structure to an allocatable string + procedure,public :: serialize => json_value_to_string + + !> + ! The same as `serialize`, but only here for backward compatibility + procedure,public :: print_to_string => json_value_to_string + + !> + ! Parse the JSON string and populate the [[json_value]] tree. + generic,public :: deserialize => MAYBEWRAP(json_parse_string) procedure :: MAYBEWRAP(json_parse_string) + !> + ! Same as `load` and `deserialize` but only here for backward compatibility. + generic,public :: parse => json_parse_file, & + MAYBEWRAP(json_parse_string) + !> ! Throw an exception. generic,public :: throw_exception => MAYBEWRAP(json_throw_exception) @@ -929,40 +967,18 @@ end subroutine destroy_json_core ! [[initialize_json_core_in_file]], and [[initialize_json_file]] ! all have a similar interface. - function initialize_json_core(verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) result(json_core_object) + function initialize_json_core(& +#include "json_initialize_dummy_arguments.inc" + ) result(json_core_object) implicit none type(json_core) :: json_core_object #include "json_initialize_arguments.inc" - call json_core_object%initialize(verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) + call json_core_object%initialize(& +#include "json_initialize_dummy_arguments.inc" + ) end function initialize_json_core !***************************************************************************************** @@ -986,20 +1002,9 @@ end function initialize_json_core ! [[initialize_json_core_in_file]], and [[initialize_json_file]] ! all have a similar interface. - subroutine json_initialize(me,verbose,compact_reals,& - print_signs,real_format,spaces_per_tab,& - strict_type_checking,& - trailing_spaces_significant,& - case_sensitive_keys,& - no_whitespace,& - unescape_strings,& - comment_char,& - path_mode,& - path_separator,& - compress_vectors,& - allow_duplicate_keys,& - escape_solidus,& - stop_on_error) + subroutine json_initialize(me,& +#include "json_initialize_dummy_arguments.inc" + ) implicit none @@ -1014,6 +1019,8 @@ subroutine json_initialize(me,verbose,compact_reals,& integer(IK) :: istat !! `iostat` flag for !! write statements logical(LK) :: sgn_prnt !! print sign flag + character(kind=CK,len=max_integer_str_len) :: istr !! for integer to + !! string conversion !reset exception to false: call me%clear_exceptions() @@ -1089,6 +1096,35 @@ subroutine json_initialize(me,verbose,compact_reals,& me%escape_solidus = escape_solidus end if + ! how to handle null to read conversions: + if (present(null_to_real_mode)) then + select case (null_to_real_mode) + case(1_IK:3_IK) + me%null_to_real_mode = null_to_real_mode + case default + me%null_to_real_mode = 2_IK ! just to have a valid value + call integer_to_string(null_to_real_mode,int_fmt,istr) + call me%throw_exception('Invalid null_to_real_mode: '//istr) + end select + end if + + ! how to handle NaN and Infinities: + if (present(non_normal_mode)) then + select case (non_normal_mode) + case(1_IK) ! use strings + me%non_normals_to_null = .false. + case(2_IK) ! use null + me%non_normals_to_null = .true. + case default + call integer_to_string(non_normal_mode,int_fmt,istr) + call me%throw_exception('Invalid non_normal_mode: '//istr) + end select + end if + + if (present(use_quiet_nan)) then + me%use_quiet_nan = use_quiet_nan + end if + !Set the format for real numbers: ! [if not changing it, then it remains the same] @@ -1238,7 +1274,7 @@ end function name_strings_equal ! implicit none ! type(json_core) :: json ! type(json_value),pointer :: j1, j2 -! call json%parse('../files/inputs/test1.json',j1) +! call json%load('../files/inputs/test1.json',j1) ! call json%clone(j1,j2) !now have two independent copies ! call json%destroy(j1) !destroys j1, but j2 remains ! call json%print(j2,'j2.json') @@ -1340,7 +1376,7 @@ end subroutine json_value_clone_func ! ! Destroy the data within a [[json_value]], and reset type to `json_unknown`. - subroutine destroy_json_data(d) + pure subroutine destroy_json_data(d) implicit none @@ -2028,7 +2064,7 @@ end subroutine wrap_json_throw_exception ! type(json_file) :: json ! logical :: status_ok ! character(kind=CK,len=:),allocatable :: error_msg -! call json%load_file(filename='myfile.json') +! call json%load(filename='myfile.json') ! call json%check_for_errors(status_ok, error_msg) ! if (.not. status_ok) then ! write(*,*) 'Error: '//error_msg @@ -2087,7 +2123,7 @@ end subroutine json_check_for_errors ! type(json_value),pointer :: p ! logical :: status_ok ! character(len=:),allocatable :: error_msg -! call json%parse(filename='myfile.json',p) +! call json%load(filename='myfile.json',p) ! if (json%failed()) then ! call json%check_for_errors(status_ok, error_msg) ! write(*,*) 'Error: '//error_msg @@ -2101,7 +2137,7 @@ end subroutine json_check_for_errors ! type(json_file) :: f ! logical :: status_ok ! character(len=:),allocatable :: error_msg -! call f%load_file(filename='myfile.json') +! call f%load(filename='myfile.json') ! if (f%failed()) then ! call f%check_for_errors(status_ok, error_msg) ! write(*,*) 'Error: '//error_msg @@ -2176,7 +2212,7 @@ end subroutine json_value_create ! method to validate a JSON structure that was manually ! created using [[json_value]] pointers. - recursive subroutine json_value_destroy(json,p,destroy_next) + pure recursive subroutine json_value_destroy(json,p,destroy_next) implicit none @@ -3394,7 +3430,7 @@ end subroutine json_value_add_member ! logical(json_LK) :: found ! type(json_core) :: json ! type(json_value),pointer :: p,new,element -! call json%parse(file='myfile.json', p=p) +! call json%load(file='myfile.json', p=p) ! call json%get(p,'x(3)',element,found) ! get pointer to an array element in the file ! call json%create_integer(new,1,'') ! create a new element ! call json%insert_after(element,new) ! insert new element after x(3) @@ -5846,6 +5882,25 @@ subroutine json_value_to_string(json,p,str) end subroutine json_value_to_string !***************************************************************************************** +!***************************************************************************************** +!> +! Print the [[json_value]] structure to the console (`output_unit`). +! +!### Note +! * Just a wrapper for [[json_print_to_unit]]. + + subroutine json_print_to_console(json,p) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + + call json%print(p,int(output_unit,IK)) + + end subroutine json_print_to_console +!***************************************************************************************** + !***************************************************************************************** !> author: Jacob Williams ! date: 6/20/2014 @@ -6224,10 +6279,10 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,& case (json_real) if (allocated(json%real_fmt)) then - call real_to_string(p%dbl_value,json%real_fmt,json%compact_real,tmp) + call real_to_string(p%dbl_value,json%real_fmt,json%compact_real,json%non_normals_to_null,tmp) else !use the default format (user has not called initialize() or specified one): - call real_to_string(p%dbl_value,default_real_fmt,json%compact_real,tmp) + call real_to_string(p%dbl_value,default_real_fmt,json%compact_real,json%non_normals_to_null,tmp) end if s = s_indent//trim(tmp) @@ -6237,7 +6292,9 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,& case default - call json%throw_exception('Error in json_value_print: unknown data type') + call integer_to_string(p%var_type,int_fmt,tmp) + call json%throw_exception('Error in json_value_print: '//& + 'unknown data type: '//trim(tmp)) end select @@ -7947,7 +8004,7 @@ function string_to_dble(json,str) result(rval) if (.not. json%exception_thrown) then - call string_to_real(str,rval,status_ok) + call string_to_real(str,json%use_quiet_nan,rval,status_ok) if (.not. status_ok) then !if there was an error rval = 0.0_RK @@ -8224,14 +8281,31 @@ subroutine json_get_real(json, me, value) value = 0.0_RK end if case (json_string) - call string_to_real(me%str_value,value,status_ok) + call string_to_real(me%str_value,json%use_quiet_nan,value,status_ok) if (.not. status_ok) then value = 0.0_RK call json%throw_exception('Error in json_get_real:'//& ' Unable to convert string value to real: me.'//& me%name//' = '//trim(me%str_value)) end if + case (json_null) + if (ieee_support_nan(value) .and. json%null_to_real_mode/=1_IK) then + select case (json%null_to_real_mode) + case(2_IK) + if (json%use_quiet_nan) then + value = ieee_value(value,ieee_quiet_nan) + else + value = ieee_value(value,ieee_signaling_nan) + end if + case(3_IK) + value = 0.0_RK + end select + else + call json%throw_exception('Error in json_get_real:'//& + ' Cannot convert null to NaN: '//me%name) + end if case default + call json%throw_exception('Error in json_get_real:'//& ' Unable to resolve value to real: '//me%name) end select @@ -8951,6 +9025,7 @@ subroutine json_get_string(json, me, value) if (allocated(me%dbl_value)) then value = repeat(space, max_numeric_str_len) call real_to_string(me%dbl_value,json%real_fmt,& + json%non_normals_to_null,& json%compact_real,value) value = trim(value) else @@ -9534,7 +9609,7 @@ end subroutine wrap_json_get_array_by_path !````fortran ! type(json_core) :: json ! type(json_value),pointer :: p -! call json%parse(file='myfile.json', p=p) +! call json%load(file='myfile.json', p=p) !```` ! !### History @@ -9748,7 +9823,7 @@ subroutine wrap_json_parse_string(json, p, str) type(json_value),pointer :: p !! output structure character(kind=CDK,len=*),intent(in) :: str !! string with JSON data - call json%parse(p,to_unicode(str)) + call json%deserialize(p,to_unicode(str)) end subroutine wrap_json_parse_string !***************************************************************************************** diff --git a/src/tests/jf_test_01.F90 b/src/tests/jf_test_01.F90 index 183f408531..2b72a32069 100644 --- a/src/tests/jf_test_01.F90 +++ b/src/tests/jf_test_01.F90 @@ -60,7 +60,7 @@ subroutine test_1(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'parsing file '//dir//filename1 - call json%load_file(filename = dir//filename1) + call json%load(filename = dir//filename1) if (json%failed()) then !if there was an error reading the file @@ -72,7 +72,7 @@ subroutine test_1(error_cnt) ! print the parsed data to the console write(error_unit,'(A)') '' write(error_unit,'(A)') 'printing the file...' - call json%print_file(int(error_unit,IK)) + call json%print(int(error_unit,IK)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -336,7 +336,7 @@ subroutine test_1(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'printing the modified structure...' - call json%print_file(int(error_unit,IK)) + call json%print(int(error_unit,IK)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -370,7 +370,7 @@ subroutine test_1(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'printing the modified structure...' - call json%print_file(int(error_unit,IK)) + call json%print(int(error_unit,IK)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -379,7 +379,7 @@ subroutine test_1(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'printing the modified structure (compact mode)...' call json%initialize(no_whitespace=.true.) - call json%print_file(int(error_unit,IK)) + call json%print(int(error_unit,IK)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_03.F90 b/src/tests/jf_test_03.F90 index 1d69b2a2d7..05dfa858e4 100644 --- a/src/tests/jf_test_03.F90 +++ b/src/tests/jf_test_03.F90 @@ -53,7 +53,7 @@ subroutine test_3(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'parsing file: '//dir//filename2 - call json%load_file(filename = dir//filename2) + call json%load(filename = dir//filename2) if (json%failed()) then !if there was an error reading the file diff --git a/src/tests/jf_test_04.F90 b/src/tests/jf_test_04.F90 index 2cad001ace..44ba10f6fa 100644 --- a/src/tests/jf_test_04.F90 +++ b/src/tests/jf_test_04.F90 @@ -101,7 +101,7 @@ subroutine test_4(error_cnt) write(error_unit,'(A)') 'write to string' write(error_unit,'(A)') '' !write it to a string, and print to console: - call core%print_to_string(p, string) + call core%serialize(p, string) if (core%failed()) then call core%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -144,7 +144,7 @@ subroutine test_4(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'read file' - call json%load_file(filename = dir//filename4) + call json%load(filename = dir//filename4) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_05.F90 b/src/tests/jf_test_05.F90 index bbb3a14148..5a5c24f825 100644 --- a/src/tests/jf_test_05.F90 +++ b/src/tests/jf_test_05.F90 @@ -50,7 +50,7 @@ subroutine test_5(error_cnt) ! parse the json file: write(error_unit,'(A)') 'load file...' - call json%load_file(filename = dir//filename5) + call json%load(filename = dir//filename5) if (json%failed()) then call json%print_error_message(error_unit) @@ -60,7 +60,7 @@ subroutine test_5(error_cnt) ! print the parsed data to the console: write(error_unit,'(A)') 'print file...' - call json%print_file(int(error_unit,IK)) + call json%print(int(error_unit,IK)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_06.F90 b/src/tests/jf_test_06.F90 index 25f80f47e7..d9de7024b2 100644 --- a/src/tests/jf_test_06.F90 +++ b/src/tests/jf_test_06.F90 @@ -62,11 +62,11 @@ subroutine test_6(error_cnt) if (files(i)=='') then write(error_unit,'(A)') 'load string: '//invalid_str write(error_unit,'(A)') '' - call json%load_from_string(str = invalid_str) + call json%deserialize(str = invalid_str) else write(error_unit,'(A)') 'load file: '//trim(files(i)) write(error_unit,'(A)') '' - call json%load_file(filename = dir//trim(files(i))) + call json%load(filename = dir//trim(files(i))) end if if (json%failed()) then diff --git a/src/tests/jf_test_07.F90 b/src/tests/jf_test_07.F90 index 0b756996a0..ea3048f304 100644 --- a/src/tests/jf_test_07.F90 +++ b/src/tests/jf_test_07.F90 @@ -226,7 +226,7 @@ subroutine test_7(error_cnt) nullify(e2) nullify(escaped_string) - call json%print(root,int(output_unit,IK)) !print to the console + call json%print(root) !print to the console if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_08.F90 b/src/tests/jf_test_08.F90 index f6be422a95..8d35b00dd4 100644 --- a/src/tests/jf_test_08.F90 +++ b/src/tests/jf_test_08.F90 @@ -57,7 +57,7 @@ subroutine test_8(error_cnt) write(error_unit,'(A)') ' Valid test 1:' write(error_unit,'(A)') '**************' write(error_unit,'(A)') '' - call json%parse(str=str, p=p) ! read it from str + call json%deserialize(str=str, p=p) ! read it from str if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -80,7 +80,7 @@ subroutine test_8(error_cnt) write(error_unit,'(A)') ' Valid test 2:' write(error_unit,'(A)') '**************' write(error_unit,'(A)') '' - call json%parse(str=str2, p=p) ! read it from str + call json%deserialize(str=str2, p=p) ! read it from str if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -103,7 +103,7 @@ subroutine test_8(error_cnt) write(error_unit,'(A)') ' Invalid test:' write(error_unit,'(A)') '**************' write(error_unit,'(A)') '' - call json%parse(str=str_invalid, p=p) ! read it from str + call json%deserialize(str=str_invalid, p=p) ! read it from str if (json%failed()) then call json%print_error_message(error_unit) else diff --git a/src/tests/jf_test_09.F90 b/src/tests/jf_test_09.F90 index e5d6d7d4f5..8b05d1be30 100644 --- a/src/tests/jf_test_09.F90 +++ b/src/tests/jf_test_09.F90 @@ -54,12 +54,12 @@ subroutine test_9(error_cnt) write(error_unit,'(A)') '=================================' write(error_unit,'(A)') '' - write(error_unit,'(A)') ' Load a file using json_file%load_file' + write(error_unit,'(A)') ' Load a file using json_file%load' write(error_unit,'(A)') '' write(error_unit,'(A)') 'Loading file: '//trim(filename) call cpu_time(tstart) - call f%load_file(dir//filename) ! will automatically call initialize() with defaults + call f%load(dir//filename) ! will automatically call initialize() with defaults call cpu_time(tend) write(error_unit,'(A,1X,F10.3,1X,A)') 'Elapsed time: ',tend-tstart,' sec' @@ -80,7 +80,7 @@ subroutine test_9(error_cnt) write(error_unit,'(A)') '=================================' write(error_unit,'(A)') '' - write(error_unit,'(A)') ' Load a file using json_file%load_from_string' + write(error_unit,'(A)') ' Load a file using json_file%deserialize' write(error_unit,'(A)') '' write(error_unit,'(A)') 'Loading file: '//trim(filename) @@ -88,7 +88,7 @@ subroutine test_9(error_cnt) call read_file(dir//filename, str) if (allocated(str)) then - call f%load_from_string(str) + call f%deserialize(str) call cpu_time(tend) write(error_unit,'(A,1X,F10.3,1X,A)') 'Elapsed time to parse: ',tend-tstart,' sec' if (f%failed()) then diff --git a/src/tests/jf_test_10.F90 b/src/tests/jf_test_10.F90 index 24f8ccee30..a82b219846 100644 --- a/src/tests/jf_test_10.F90 +++ b/src/tests/jf_test_10.F90 @@ -53,7 +53,7 @@ subroutine test_10(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'Loading file: '//trim(filename)//'...' - call f%load_file(dir//filename) ! will call initialize() + call f%load(dir//filename) ! will call initialize() if (f%failed()) then call f%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -65,6 +65,7 @@ subroutine test_10(error_cnt) write(error_unit,'(A)') 'json_file_move_pointer...' call f2%initialize() call f2%move(f) + call f%nullify() ! not strictly necessary since it's already done by move. if (f2%failed()) then call f2%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -73,7 +74,7 @@ subroutine test_10(error_cnt) end if write(error_unit,'(A)') 'json_file_load_from_string...' - call f%load_from_string(json_str) + call f%deserialize(json_str) if (f%failed()) then call f%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -82,7 +83,7 @@ subroutine test_10(error_cnt) end if write(error_unit,'(A)') 'json_file_print_to_string...' - call f%print_to_string(str) + call f%serialize(str) if (f%failed()) then call f%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_11.F90 b/src/tests/jf_test_11.F90 index 6cbbf0044f..aec9f60922 100644 --- a/src/tests/jf_test_11.F90 +++ b/src/tests/jf_test_11.F90 @@ -48,7 +48,7 @@ subroutine test_11(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'parsing file: '//dir//unicode_file - call json%load_file(filename = dir//unicode_file) + call json%load(filename = dir//unicode_file) if (json%failed()) then !if there was an error reading the file @@ -115,7 +115,7 @@ subroutine test_11(error_cnt) end if write(error_unit,'(A)') '' - call json%print_to_string(cval) + call json%serialize(cval) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -125,7 +125,7 @@ subroutine test_11(error_cnt) end if write(error_unit,'(A)') '' - call clone%load_from_string(cval) + call clone%deserialize(cval) if ( clone%failed()) then call clone%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -133,7 +133,7 @@ subroutine test_11(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'Printing same file, but now to stdout:' - call clone%print_file(int(output_unit,IK)) + call clone%print(int(output_unit,IK)) if (clone%failed()) then call clone%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -141,7 +141,7 @@ subroutine test_11(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'Writing json file object to "../files/'//unicode_file//'"' - call clone%print_file('../files/'//unicode_file) + call clone%print('../files/'//unicode_file) if ( clone%failed() ) then call clone%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -169,7 +169,7 @@ subroutine test_11(error_cnt) write(error_unit,'(A)') 'parsing file: '//dir//ascii_equivalent write(error_unit,'(A)') 'This is the ascii equivalent of "../files/inputs/hello-world-ucs4.json"' - call json%load_file(filename = dir//ascii_equivalent) + call json%load(filename = dir//ascii_equivalent) if (json%failed()) then !if there was an error reading the file @@ -236,7 +236,7 @@ subroutine test_11(error_cnt) end if write(error_unit,'(A)') '' - call json%print_to_string(cval) + call json%serialize(cval) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -247,7 +247,7 @@ subroutine test_11(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'Printing same file, but now to stdout:' - call json%print_file(int(output_unit,IK)) + call json%print(int(output_unit,IK)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -255,7 +255,7 @@ subroutine test_11(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'Writing json file object to "../files/'//ascii_equivalent//'"' - call json%print_file('../files/'//ascii_equivalent) + call json%print('../files/'//ascii_equivalent) if ( json%failed() ) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_12.F90 b/src/tests/jf_test_12.F90 index 3913d7a4dc..7797ccde5d 100644 --- a/src/tests/jf_test_12.F90 +++ b/src/tests/jf_test_12.F90 @@ -166,11 +166,14 @@ subroutine test_12(error_cnt) call my_file%get('$array data.data',fetched_array) call check_file_errors(all(abs(fetched_array - reshape(raw_array,[size(raw_array)])) <= TOL)) - call my_file%get(tmp_json_ptr) - call check_file_errors(associated(tmp_json_ptr,root)) + ! Note: this test is no longer valid since json_file + ! function constructor was updated because + ! root is no longer associated. + ! call my_file%get(tmp_json_ptr) + ! call check_file_errors(associated(tmp_json_ptr,root)) open(file=dir//file,newunit=lun,form='formatted',action='write') - call my_file%print_file(lun) + call my_file%print(lun) call check_file_errors() close(lun) diff --git a/src/tests/jf_test_13.F90 b/src/tests/jf_test_13.F90 index 4663b9c473..cc8499b8a8 100644 --- a/src/tests/jf_test_13.F90 +++ b/src/tests/jf_test_13.F90 @@ -43,12 +43,12 @@ subroutine test_13(error_cnt) call my_file%initialize(real_format=trim(fmts(i))) - call my_file%load_from_string('{ "value": 1234.56789 }') + call my_file%deserialize('{ "value": 1234.56789 }') if (my_file%failed()) then call my_file%print_error_message(error_unit) error_cnt = error_cnt + 1 end if - call my_file%print_to_string(str) + call my_file%serialize(str) if (my_file%failed()) then call my_file%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_14.F90 b/src/tests/jf_test_14.F90 index 0b5f283381..a1ab019bbe 100644 --- a/src/tests/jf_test_14.F90 +++ b/src/tests/jf_test_14.F90 @@ -48,7 +48,7 @@ subroutine test_14(error_cnt) call json%initialize() !initialize the module - call json%parse(dir//filename1,p) !read the file + call json%load(dir//filename1,p) !read the file if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -83,7 +83,7 @@ subroutine test_14(error_cnt) new_name = 'Bob' icount = 0 call f%initialize() - call f%load_file(dir//filename1) !read the file + call f%load(dir//filename1) !read the file if (f%failed()) then call f%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -103,7 +103,7 @@ subroutine test_14(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') ' All names changed to '//new_name//':' write(error_unit,'(A)') '' - call f%print_file(int(output_unit,IK)) + call f%print(int(output_unit,IK)) write(error_unit,'(A)') '' end if diff --git a/src/tests/jf_test_15.F90 b/src/tests/jf_test_15.F90 index 3f901d83a0..8aef3cfb97 100644 --- a/src/tests/jf_test_15.F90 +++ b/src/tests/jf_test_15.F90 @@ -45,7 +45,7 @@ subroutine test_15(error_cnt) nullify(p2) nullify(p) - call json%parse(p2, '{"int": 1, "real": 2.0, "logical": true}') + call json%deserialize(p2, '{"int": 1, "real": 2.0, "logical": true}') call json%get(p2,'real', i) call json%get(p2,'logical',i) call json%get(p2,'integer',d) @@ -63,13 +63,13 @@ subroutine test_15(error_cnt) call json%check_for_errors(status_ok) !error condition false call json%check_for_errors(error_msg=error_msg) !error condition false - not allocated - call file1%move(file2) !should throw an exception since points are not associated + call file1%move(file2) !should throw an exception since pointers are not associated call file1%initialize() - call file1%print_file(-1_IK) !invalid input + call file1%print(-1_IK) !invalid input call file1%initialize() - call file1%print_file(filename='') !invalid filename + call file1%print(filename='') !invalid filename call file1%initialize() call file1%info('this path does not exist',found,var_type,n_children) diff --git a/src/tests/jf_test_16.F90 b/src/tests/jf_test_16.F90 index 7488f75724..ebfae3d68e 100644 --- a/src/tests/jf_test_16.F90 +++ b/src/tests/jf_test_16.F90 @@ -38,7 +38,7 @@ subroutine test_16(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'Original:' - call json%parse(p, '{"cities": ["New York","Los Angeles","Chicago"], '//& + call json%deserialize(p, '{"cities": ["New York","Los Angeles","Chicago"], '//& '"value": 1, "iflag": true, "struct":{"vec":[1,2,3]}}') if (json%failed()) then call json%print_error_message(error_unit) @@ -94,10 +94,10 @@ subroutine test_16(error_cnt) write(error_unit,'(A)') '.....................................' write(error_unit,'(A)') '' write(error_unit,'(A)') 'Original:' - call json%parse(p, '{ "stats": { "iflag": 0, "str": "ok" },'//& - '"vars": [{ "label": "r", "value": 0.0 }, '//& - '{ "label": "v", "value": 0.0 }],'//& - '"empty": { } }') + call json%deserialize(p, '{ "stats": { "iflag": 0, "str": "ok" },'//& + '"vars": [{ "label": "r", "value": 0.0 }, '//& + '{ "label": "v", "value": 0.0 }],'//& + '"empty": { } }') if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -144,7 +144,7 @@ subroutine test_16(error_cnt) write(error_unit,'(A)') '.....................................' write(error_unit,'(A)') '' write(error_unit,'(A)') 'Original:' - call json%parse(p, '{ "color": "red", "width": 10, "height": 2 }') + call json%deserialize(p, '{ "color": "red", "width": 10, "height": 2 }') if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -169,7 +169,7 @@ subroutine test_16(error_cnt) write(error_unit,'(A)') '.....................................' write(error_unit,'(A)') '' write(error_unit,'(A)') 'Original:' - call json%parse(p, '{ "color": "red", "width": 10, "height": 2 }') + call json%deserialize(p, '{ "color": "red", "width": 10, "height": 2 }') if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -194,7 +194,7 @@ subroutine test_16(error_cnt) write(error_unit,'(A)') '.....................................' write(error_unit,'(A)') '' write(error_unit,'(A)') 'Original:' - call json%parse(p, '{ "color": "red", "width": 10, "height": 2 }') + call json%deserialize(p, '{ "color": "red", "width": 10, "height": 2 }') if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_17.F90 b/src/tests/jf_test_17.F90 index 1bb67781aa..e3dde8acca 100644 --- a/src/tests/jf_test_17.F90 +++ b/src/tests/jf_test_17.F90 @@ -43,7 +43,7 @@ subroutine test_17(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'Original:' - call json%parse(p, json_string) + call json%deserialize(p, json_string) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -107,7 +107,7 @@ subroutine test_17(error_cnt) call json%destroy(p) ! test the corresponding json_file version: - call f%load_from_string(json_string) + call f%deserialize(json_string) call f%rename(CK_'iflag', CK_'flag') call f%rename(CK_'flag', CDK_'iflag') call f%rename(CDK_'iflag', CK_'flag') diff --git a/src/tests/jf_test_18.F90 b/src/tests/jf_test_18.F90 index 8cfbebf412..e355931e0e 100644 --- a/src/tests/jf_test_18.F90 +++ b/src/tests/jf_test_18.F90 @@ -40,10 +40,10 @@ subroutine test_18(error_cnt) error_cnt = 0 - call json%parse(p, '{ "a" :{"val" : 1},'//& - ' "A" :{"Val" : 2},'//& - ' "a ":{"val ": 3},'//& - ' "A ":{"Val ": 4} }' ) + call json%deserialize(p,'{ "a" :{"val" : 1},'//& + ' "A" :{"Val" : 2},'//& + ' "a ":{"val ": 3},'//& + ' "A ":{"Val ": 4} }' ) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_19.F90 b/src/tests/jf_test_19.F90 index df06bd7e6e..bfa45ea2ff 100644 --- a/src/tests/jf_test_19.F90 +++ b/src/tests/jf_test_19.F90 @@ -53,7 +53,7 @@ subroutine test_19(error_cnt) write(error_unit,'(A)') 'JSON data:' write(error_unit,'(A)') '-------------' write(error_unit,'(A)') '' - call json%parse(p,json_example) + call json%deserialize(p,json_example) call json%print(p,int(error_unit,IK)) !get some info: diff --git a/src/tests/jf_test_20.F90 b/src/tests/jf_test_20.F90 index 0deafc4451..a70b0550eb 100644 --- a/src/tests/jf_test_20.F90 +++ b/src/tests/jf_test_20.F90 @@ -39,7 +39,7 @@ subroutine test_20(error_cnt) error_cnt = 0 - call json%parse(p,json_example) + call json%deserialize(p,json_example) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_21.F90 b/src/tests/jf_test_21.F90 index 09a25e9b12..62606914d0 100644 --- a/src/tests/jf_test_21.F90 +++ b/src/tests/jf_test_21.F90 @@ -55,7 +55,7 @@ subroutine test_21(error_cnt) ! read array2 from file call jfile % initialize(real_format='E') - call jfile % load_file(dir//'test21.json') + call jfile % load(dir//'test21.json') call jfile % get('value',array2,found) call jfile % destroy() diff --git a/src/tests/jf_test_22.F90 b/src/tests/jf_test_22.F90 index 1e0476d47e..f7f069877a 100644 --- a/src/tests/jf_test_22.F90 +++ b/src/tests/jf_test_22.F90 @@ -45,7 +45,7 @@ subroutine test_22(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'parsing file '//dir//filename - call json%load_file(filename = dir//filename) + call json%load(filename = dir//filename) if (json%failed()) then !if there was an error reading the file @@ -57,7 +57,7 @@ subroutine test_22(error_cnt) ! print the parsed data to the console write(error_unit,'(A)') '' write(error_unit,'(A)') 'printing the file...' - call json%print_file(int(error_unit,IK)) + call json%print(int(error_unit,IK)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_23.F90 b/src/tests/jf_test_23.F90 index 099fd3616c..23e43ede1d 100644 --- a/src/tests/jf_test_23.F90 +++ b/src/tests/jf_test_23.F90 @@ -56,7 +56,7 @@ subroutine test_23(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'parsing file '//dir//filename1 - call json%load_file(filename = dir//filename1) + call json%load(filename = dir//filename1) if (json%failed()) then !if there was an error reading the file @@ -68,7 +68,7 @@ subroutine test_23(error_cnt) ! print the parsed data to the console write(error_unit,'(A)') '' write(error_unit,'(A)') 'printing the file...' - call json%print_file(int(error_unit,IK)) + call json%print(int(error_unit,IK)) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_25.F90 b/src/tests/jf_test_25.F90 index ce152fe13a..f12d235b87 100644 --- a/src/tests/jf_test_25.F90 +++ b/src/tests/jf_test_25.F90 @@ -35,8 +35,8 @@ subroutine test_25(error_cnt) error_cnt = 0 call json%initialize( verbose=.false. ) if (json%failed()) then - call json%print_error_message(error_unit) - error_cnt = error_cnt + 1 + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 end if write(error_unit,'(A)') '' @@ -47,10 +47,10 @@ subroutine test_25(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'parsing...' - call json%parse(p,json_str) + call json%deserialize(p,json_str) if (json%failed()) then - call json%print_error_message(error_unit) - error_cnt = error_cnt + 1 + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 end if write(error_unit,'(A)') '' @@ -63,13 +63,13 @@ subroutine test_25(error_cnt) ! get child, then array: call json%get_child(p,'str_array',tmp) if (json%failed()) then - call json%print_error_message(error_unit) - error_cnt = error_cnt + 1 + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 end if call json%get(tmp, vec, ilen) if (json%failed()) then - call json%print_error_message(error_unit) - error_cnt = error_cnt + 1 + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 end if if (allocated(vec) .and. allocated(ilen)) then if (all(ilen==[1,2,3,5])) then @@ -85,15 +85,16 @@ subroutine test_25(error_cnt) ! try get by path: call json%get(p, 'str_array', vec, ilen, found) - if (json%failed()) then - call json%print_error_message(error_unit) - error_cnt = error_cnt + 1 - end if - if (all(ilen==[1,2,3,5])) then - write(error_unit,'(A)') 'success!' - else - write(error_unit,'(A,1X,*(I5,1X))') 'failed: ', ilen + if (.not. found) then + call json%print_error_message(error_unit) error_cnt = error_cnt + 1 + else + if (all(ilen==[1,2,3,5])) then + write(error_unit,'(A)') 'success!' + else + write(error_unit,'(A,1X,*(I5,1X))') 'failed: ', ilen + error_cnt = error_cnt + 1 + end if end if #ifdef USE_UCS4 @@ -101,44 +102,42 @@ subroutine test_25(error_cnt) call json%get(p, CDK_'str_array', vec, ilen, found) call json%get(p, CK_'str_array', vec, ilen) if (json%failed()) then - call json%print_error_message(error_unit) - error_cnt = error_cnt + 1 + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 end if #endif ! test json_file interface f = json_file(p) + nullify(p) ! data is now in f call f%get('str_array', vec, ilen, found) - if (f%failed()) then - call f%print_error_message(error_unit) - error_cnt = error_cnt + 1 - end if - if (all(ilen==[1,2,3,5])) then - write(error_unit,'(A)') 'json_file success!' - else - write(error_unit,'(A,1X,*(I5,1X))') 'json_file failed: ', ilen + if (.not. found) then + call f%print_error_message(error_unit) error_cnt = error_cnt + 1 + else + if (all(ilen==[1,2,3,5])) then + write(error_unit,'(A)') 'json_file success!' + else + write(error_unit,'(A,1X,*(I5,1X))') 'json_file failed: ', ilen + error_cnt = error_cnt + 1 + end if end if #ifdef USE_UCS4 ! unicode test - f = json_file(p) call f%get(CDK_'str_array', vec, ilen, found) - if (f%failed()) then - call f%print_error_message(error_unit) - error_cnt = error_cnt + 1 - end if - if (all(ilen==[1,2,3,5])) then - write(error_unit,'(A)') 'json_file success!' - else - write(error_unit,'(A,1X,*(I5,1X))') 'json_file failed: ', ilen + if (.not. found) then + call f%print_error_message(error_unit) error_cnt = error_cnt + 1 + else + if (all(ilen==[1,2,3,5])) then + write(error_unit,'(A)') 'json_file success!' + else + write(error_unit,'(A,1X,*(I5,1X))') 'json_file failed: ', ilen + error_cnt = error_cnt + 1 + end if end if #endif - ! clean up - write(error_unit,'(A)') '' - write(error_unit,'(A)') 'destroy...' - call json%destroy(p) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_26.F90 b/src/tests/jf_test_26.F90 index 80fa3169ab..68b00f67a4 100644 --- a/src/tests/jf_test_26.F90 +++ b/src/tests/jf_test_26.F90 @@ -62,7 +62,7 @@ subroutine test_26(error_cnt) end if write(error_unit,'(A)') 'printing...' - call f%print_file() + call f%print() end subroutine test_26 diff --git a/src/tests/jf_test_27.F90 b/src/tests/jf_test_27.F90 index a820ed3371..3bd33d4bbf 100644 --- a/src/tests/jf_test_27.F90 +++ b/src/tests/jf_test_27.F90 @@ -48,7 +48,7 @@ subroutine test_27(error_cnt) write(error_unit,'(A)') '' write(error_unit,'(A)') 'parsing...' - call json%parse(p,json_str) + call json%deserialize(p,json_str) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -60,23 +60,15 @@ subroutine test_27(error_cnt) ! test json_file interface f = json_file(p) + nullify(p) ! data is now in f call f%initialize(compress_vectors=.true.) - call f%print_file() + call f%print() if (f%failed()) then call f%print_error_message(error_unit) error_cnt = error_cnt + 1 end if - ! clean up - write(error_unit,'(A)') '' - write(error_unit,'(A)') 'destroy...' - call json%destroy(p) - if (json%failed()) then - call json%print_error_message(error_unit) - error_cnt = error_cnt + 1 - end if - end subroutine test_27 end module jf_test_27_mod diff --git a/src/tests/jf_test_28.F90 b/src/tests/jf_test_28.F90 index 9d6e2477a8..775f6d23f7 100644 --- a/src/tests/jf_test_28.F90 +++ b/src/tests/jf_test_28.F90 @@ -63,7 +63,7 @@ subroutine test_28(error_cnt) !ivec_value_reversed = [] end select - call json%parse(p,str) + call json%deserialize(p,str) call json%get(p,'vec',vec) write(output_unit,'(A)') '' diff --git a/src/tests/jf_test_29.F90 b/src/tests/jf_test_29.F90 index e6a6ba4a04..989e2d574d 100644 --- a/src/tests/jf_test_29.F90 +++ b/src/tests/jf_test_29.F90 @@ -63,7 +63,7 @@ subroutine test(json_str,correct_has_duplicate,correct_name,correct_path) write(error_unit,'(A)') '' write(error_unit,'(A)') 'JSON string: '//json_str - call json%parse(p,json_str) + call json%deserialize(p,json_str) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -109,7 +109,7 @@ subroutine test(json_str,correct_has_duplicate,correct_name,correct_path) ! check when the string is parsed: call json%initialize(allow_duplicate_keys=.false.) - call json%parse(p,json_str) + call json%deserialize(p,json_str) if (json%failed() .eqv. correct_has_duplicate) then write(output_unit,'(A)') ' Test passed: parse' else @@ -121,7 +121,7 @@ subroutine test(json_str,correct_has_duplicate,correct_name,correct_path) ! check by explicit call to validate: call json%initialize() ! don't throw an exception when parsing - call json%parse(p,json_str) + call json%deserialize(p,json_str) call json%initialize(allow_duplicate_keys=.false.) call json%validate(p,is_valid,error_msg) if (is_valid .eqv. (.not. correct_has_duplicate)) then diff --git a/src/tests/jf_test_30.F90 b/src/tests/jf_test_30.F90 index 7134603495..cfb8098ddc 100644 --- a/src/tests/jf_test_30.F90 +++ b/src/tests/jf_test_30.F90 @@ -43,8 +43,8 @@ subroutine test_30(error_cnt) write(error_unit,'(A)') '' call json%initialize(escape_solidus=(i==1), stop_on_error=.true.) - call json%load_from_string(str) - call json%print_file(int(error_unit,IK)) + call json%deserialize(str) + call json%print(int(error_unit,IK)) if (json%failed()) then call json%print_error_message(error_unit) diff --git a/src/tests/jf_test_31.F90 b/src/tests/jf_test_31.F90 index cde02f67e8..f6e3fd4f34 100644 --- a/src/tests/jf_test_31.F90 +++ b/src/tests/jf_test_31.F90 @@ -43,7 +43,7 @@ subroutine test_31(error_cnt) call json%initialize(strict_type_checking = .false.) - call json%load_from_string(json_string) + call json%deserialize(json_string) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_32.F90 b/src/tests/jf_test_32.F90 index b023f39033..cd69fa2121 100644 --- a/src/tests/jf_test_32.F90 +++ b/src/tests/jf_test_32.F90 @@ -44,7 +44,7 @@ subroutine test_32(error_cnt) call json%initialize() - call json%parse(p,json_string) + call json%deserialize(p,json_string) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_33.F90 b/src/tests/jf_test_33.F90 index fe7d8e44db..8701e7cb04 100644 --- a/src/tests/jf_test_33.F90 +++ b/src/tests/jf_test_33.F90 @@ -47,7 +47,7 @@ subroutine test_33(error_cnt) call json%initialize() - call json%parse(p,json_string) + call json%deserialize(p,json_string) if (json%failed()) then call json%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_34.F90 b/src/tests/jf_test_34.F90 index 3e0d9199e9..39bcfc6634 100644 --- a/src/tests/jf_test_34.F90 +++ b/src/tests/jf_test_34.F90 @@ -103,7 +103,7 @@ subroutine test_34(error_cnt) end select call json%initialize() - call json%parse(p,str) + call json%deserialize(p,str) call json%matrix_info(p,is_matrix,var_type,& n_sets,set_size,name) diff --git a/src/tests/jf_test_36.F90 b/src/tests/jf_test_36.F90 index 430a73972b..008a87e57f 100644 --- a/src/tests/jf_test_36.F90 +++ b/src/tests/jf_test_36.F90 @@ -66,14 +66,14 @@ subroutine test_36(error_cnt) call my_file%initialize(no_whitespace=.true.) ! load from the original string: - call my_file%load_from_string(str_in) + call my_file%deserialize(str_in) if (my_file%failed()) then call my_file%print_error_message(error_unit) error_cnt = error_cnt + 1 end if ! now, write it to a new string: - call my_file%print_to_string(str_out) + call my_file%serialize(str_out) if (my_file%failed()) then call my_file%print_error_message(error_unit) error_cnt = error_cnt + 1 @@ -99,7 +99,7 @@ subroutine test_36(error_cnt) ! now load the string again to verify that it ! printed correctly without errors: - call my_file%load_from_string(str_out) + call my_file%deserialize(str_out) if (my_file%failed()) then call my_file%print_error_message(error_unit) error_cnt = error_cnt + 1 diff --git a/src/tests/jf_test_37.F90 b/src/tests/jf_test_37.F90 index 16aecb7008..eaa1ffd1d5 100644 --- a/src/tests/jf_test_37.F90 +++ b/src/tests/jf_test_37.F90 @@ -38,28 +38,28 @@ subroutine test_37(error_cnt) call json%initialize(no_whitespace=.true.) - call json%parse(p, CK_'{"a": ["1", "2", "3"]}') + call json%deserialize(p, CK_'{"a": ["1", "2", "3"]}') f = json_file(p,no_whitespace=.true.) - call f%print_file(int(error_unit,IK)) + call f%print(int(error_unit,IK)) write(error_unit,'(A)') '' call check_for_error() call f%destroy() - call json%parse(p, CK_'{"b": ["4", "5", "6"]}') + call json%deserialize(p, CK_'{"b": ["4", "5", "6"]}') f = json_file(p,json) - call f%print_file(int(error_unit,IK)) + call f%print(int(error_unit,IK)) write(error_unit,'(A)') '' call check_for_error() call f%destroy() f = json_file(CK_'{"x": [1,2,3]}',no_whitespace=.true.) - call f%print_file(int(error_unit,IK)) + call f%print(int(error_unit,IK)) write(error_unit,'(A)') '' call check_for_error() call f%destroy() f = json_file(CK_'{"y": [4,5,6]}',json) - call f%print_file(int(error_unit,IK)) + call f%print(int(error_unit,IK)) write(error_unit,'(A)') '' call check_for_error() call f%destroy() @@ -68,28 +68,28 @@ subroutine test_37(error_cnt) ! also test default character kind when unicode is enabled: - call json%parse(p, CDK_'{"a": ["1", "2", "3"]}') + call json%deserialize(p, CDK_'{"a": ["1", "2", "3"]}') f = json_file(p,no_whitespace=.true.) - call f%print_file(int(error_unit,IK)) + call f%print(int(error_unit,IK)) write(error_unit,'(A)') '' call check_for_error() call f%destroy() - call json%parse(p, CDK_'{"b": ["4", "5", "6"]}') + call json%deserialize(p, CDK_'{"b": ["4", "5", "6"]}') f = json_file(p,json) - call f%print_file(int(error_unit,IK)) + call f%print(int(error_unit,IK)) write(error_unit,'(A)') '' call check_for_error() call f%destroy() f = json_file(CDK_'{"x": [1,2,3]}',no_whitespace=.true.) - call f%print_file(int(error_unit,IK)) + call f%print(int(error_unit,IK)) write(error_unit,'(A)') '' call check_for_error() call f%destroy() f = json_file(CDK_'{"y": [4,5,6]}',json) - call f%print_file(int(error_unit,IK)) + call f%print(int(error_unit,IK)) write(error_unit,'(A)') '' call check_for_error() call f%destroy() diff --git a/src/tests/jf_test_38.F90 b/src/tests/jf_test_38.F90 index 3476f36143..65150442b9 100644 --- a/src/tests/jf_test_38.F90 +++ b/src/tests/jf_test_38.F90 @@ -46,7 +46,7 @@ subroutine test_38(error_cnt) call json%initialize(no_whitespace=.true.) - call json%parse(p, '{"a": 1.0}') + call json%deserialize(p, '{"a": 1.0}') call json%update(p,'a',2.0_wp,found) call json%update(p,CK_'a',2.0_wp,found) @@ -95,7 +95,7 @@ subroutine test_38(error_cnt) call f%initialize(no_whitespace=.true.) - call f%load_from_string('{"a": 1.0}') + call f%deserialize('{"a": 1.0}') call f%update('a',2.0_wp,found) call f%add('b',3.0_wp) diff --git a/src/tests/jf_test_39.F90 b/src/tests/jf_test_39.F90 index 0485ef4913..a22cfaea9c 100644 --- a/src/tests/jf_test_39.F90 +++ b/src/tests/jf_test_39.F90 @@ -45,7 +45,7 @@ subroutine test_39(error_cnt) do i = 1, size(tests) json = json_file(trim(tests(i)),verbose=.true.,stop_on_error=.true.) - call json%print_file(int(error_unit,IK)) + call json%print(int(error_unit,IK)) write(error_unit,'(A)') '' if (json%failed()) then call json%print_error_message(error_unit) diff --git a/src/tests/jf_test_40.F90 b/src/tests/jf_test_40.F90 index 860acf7676..9120bd95d6 100644 --- a/src/tests/jf_test_40.F90 +++ b/src/tests/jf_test_40.F90 @@ -38,7 +38,7 @@ subroutine test_40(error_cnt) error_cnt = error_cnt + 1 end if - call json%print_file() + call json%print() call json%destroy() if (.not. json%failed() .and. error_cnt==0) then diff --git a/src/tests/jf_test_41.F90 b/src/tests/jf_test_41.F90 new file mode 100644 index 0000000000..d3fb6665d5 --- /dev/null +++ b/src/tests/jf_test_41.F90 @@ -0,0 +1,103 @@ +!***************************************************************************************** +!> +! Module for the 41st unit test. + +module jf_test_41_mod + + use json_module, rk => json_rk, lk => json_lk, ik => json_ik, ck => json_ck, cdk => json_cdk + use, intrinsic :: iso_fortran_env , only: error_unit, output_unit + + implicit none + + private + public :: test_41 + +contains + + subroutine test_41(error_cnt) + + !! Test finalizer + + implicit none + + integer,intent(out) :: error_cnt + + type(json_value),pointer :: p, p2 + type(json_core) :: json + type(json_file) :: f, f2 + + character(kind=CK,len=*),parameter :: json_str = & + '{"str_array": ["1","22","333","55555"]}' + + error_cnt = 0 + + write(error_unit,'(A)') '' + write(error_unit,'(A)') '=================================' + write(error_unit,'(A)') ' TEST 41' + write(error_unit,'(A)') '=================================' + write(error_unit,'(A)') '' + + write(error_unit,'(A)') 'parsing...' + call json%deserialize(p,json_str) + call json%deserialize(p2,json_str) + + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + else + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'printing...' + call json%print(p,int(output_unit,IK)) + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'copying to json_file...' + + f = json_file(p) + + call f2%add(p2) + nullify(p2) ! data is now in f + + if (f%failed()) then + call f%print_error_message(error_unit) + error_cnt = error_cnt + 1 + else + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'printing...' + call f%print() ! print to console + if (f%failed()) then + call f%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + end if + + end if + + write(error_unit,'(A)') '' + if (error_cnt==0) then + write(error_unit,'(A)') 'finished: Success' + else + write(error_unit,'(A)') 'finished: Failed!' + end if + + end subroutine test_41 + +end module jf_test_41_mod +!***************************************************************************************** + +#ifndef INTEGRATED_TESTS +!***************************************************************************************** +program jf_test_41 + + !! 41st unit test. + + use jf_test_41_mod , only: test_41 + implicit none + integer :: n_errors + n_errors = 0 + call test_41(n_errors) + if (n_errors /= 0) stop 1 + +end program jf_test_41 +!***************************************************************************************** +#endif diff --git a/src/tests/jf_test_42.F90 b/src/tests/jf_test_42.F90 new file mode 100644 index 0000000000..cca7301d4a --- /dev/null +++ b/src/tests/jf_test_42.F90 @@ -0,0 +1,135 @@ +!***************************************************************************************** +!> +! Module for the 42nd unit test + +module jf_test_42_mod + + use json_module, CK => json_CK, IK => json_IK, RK => json_RK, LK => json_LK + use, intrinsic :: iso_fortran_env , only: error_unit, output_unit + + implicit none + + private + public :: test_42 + +contains + + subroutine test_42(error_cnt) + + !! Test of NaN and Infinity + + implicit none + + type(json_file) :: json !! the JSON structure read from the file + integer,intent(out) :: error_cnt !! error counter + + character(kind=CK,len=*),parameter :: str = CK_'{"bad_reals": [1.0, null, "NaN", "+Infinity", "-Infinity", 4.0]}' + + real(rk),dimension(:),allocatable :: bad_reals + logical(lk) :: found + + write(error_unit,'(A)') '' + write(error_unit,'(A)') '=================================' + write(error_unit,'(A)') ' TEST 42' + write(error_unit,'(A)') '=================================' + write(error_unit,'(A)') '' + + error_cnt = 0 + + ! parse the json string: + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'parsing string... ' + call json%deserialize(str) + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'printing...' + call json%print(int(error_unit,IK)) + + call json%initialize(use_quiet_nan=.false., null_to_real_mode=2_IK) ! signaling nan + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'get values as real [signaling nan]...' + call json%get('bad_reals',bad_reals,found) + + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + else + write(error_unit,'(A)') 'printing...' + write(error_unit,*) bad_reals + write(error_unit,'(A)') '' + + call json%initialize(null_to_real_mode=3_IK) ! 0.0 nan + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'get values as real [nan as 0.0]...' + call json%get('bad_reals',bad_reals,found) + + write(error_unit,'(A)') 'printing...' + write(error_unit,*) bad_reals + write(error_unit,'(A)') '' + + call json%initialize(use_quiet_nan=.true., null_to_real_mode=2_IK) ! quiet nan + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'get values as real [quiet nan]...' + call json%get('bad_reals',bad_reals,found) + + write(error_unit,'(A)') 'printing...' + write(error_unit,*) bad_reals + write(error_unit,'(A)') '' + + end if + + call json%destroy() + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'now add back as a real...' + call json%add('bad_reals', bad_reals) + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'serialize as strings:' + call json%initialize(non_normal_mode=1_IK) + call json%print(int(error_unit,IK)) + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'serialize as null:' + call json%initialize(non_normal_mode=2_IK) + call json%print(int(error_unit,IK)) + write(error_unit,'(A)') '' + + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + + if (error_cnt==0) then + write(error_unit,'(A)') 'Success!' + else + write(error_unit,'(A)') 'Failed!' + end if + + end subroutine test_42 + +end module jf_test_42_mod +!***************************************************************************************** + +#ifndef INTEGRATED_TESTS +!***************************************************************************************** +program jf_test_42 + + !! 42nd unit test. + + use jf_test_42_mod , only: test_42 + implicit none + integer :: n_errors + n_errors = 0 + call test_42(n_errors) + if (n_errors /= 0) stop 1 + +end program jf_test_42 +!***************************************************************************************** +#endif diff --git a/visual_studio/jsonfortranlib/jsonfortranlib.vfproj b/visual_studio/jsonfortranlib/jsonfortranlib.vfproj index cec7bf38ec..14bf2ae338 100644 --- a/visual_studio/jsonfortranlib/jsonfortranlib.vfproj +++ b/visual_studio/jsonfortranlib/jsonfortranlib.vfproj @@ -43,7 +43,8 @@ - + + diff --git a/visual_studio/jsonfortrantest/jsonfortrantest.f90 b/visual_studio/jsonfortrantest/jsonfortrantest.f90 index 91dfd85522..2b1cf1c8af 100644 --- a/visual_studio/jsonfortrantest/jsonfortrantest.f90 +++ b/visual_studio/jsonfortrantest/jsonfortrantest.f90 @@ -47,6 +47,8 @@ program jsonfortrantest use jf_test_38_mod , only: test_38 use jf_test_39_mod , only: test_39 use jf_test_40_mod , only: test_40 + use jf_test_41_mod , only: test_41 + use jf_test_42_mod , only: test_42 implicit none @@ -94,6 +96,8 @@ program jsonfortrantest call test_38(n_errors); if (n_errors /= 0) stop 1 call test_39(n_errors); if (n_errors /= 0) stop 1 call test_40(n_errors); if (n_errors /= 0) stop 1 + call test_41(n_errors); if (n_errors /= 0) stop 1 + call test_42(n_errors); if (n_errors /= 0) stop 1 end program jsonfortrantest !***************************************************************************************** diff --git a/visual_studio/jsonfortrantest/jsonfortrantest.vfproj b/visual_studio/jsonfortrantest/jsonfortrantest.vfproj index d0b636bba4..610b1678d1 100644 --- a/visual_studio/jsonfortrantest/jsonfortrantest.vfproj +++ b/visual_studio/jsonfortrantest/jsonfortrantest.vfproj @@ -86,5 +86,7 @@ + +