Merge pull request #407 from jacobwilliams/develop

Develop

Author: jacobwilliams

src/json_file_module.F90

@@ -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.

src/json_initialize_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 &

src/json_initialize_dummy_arguments.inc

@@ -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]].

src/json_parameters.F90

@@ -11,6 +11,7 @@
 
     module json_string_utilities
 
+    use,intrinsic :: ieee_arithmetic
     use json_kinds
     use json_parameters
 
@@ -148,33 +149,61 @@ 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
 
     real(RK),intent(in)                  :: rval         !! real value.
     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
 !*****************************************************************************************