Prevent the production of invalid JSON files due to NaN, Infinity, or -Infinity real values. If these value are encountered, they are serialized as strings (in quotes). See #395

Author: jacobwilliams

src/json_string_utilities.F90

@@ -147,12 +147,20 @@ end subroutine string_to_integer
 !
 !  Convert a real value to a string.
 !
+!### Note
+!  If the value is NaN, Infinity, or -Infinity, the string
+!  will be returned in quotes. This is so it will be printed
+!  in JSON as 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 ieee cases.
 
     subroutine real_to_string(rval,real_fmt,compact_real,str)
 
+    use,intrinsic :: ieee_arithmetic
+
     implicit none
 
     real(RK),intent(in)                  :: rval         !! real value.
@@ -161,20 +169,39 @@ subroutine real_to_string(rval,real_fmt,compact_real,str)
                                                          !! displayed with fewer characters
     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 case for NaN, Infinity, and -Infinity
+
+        ! 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 subroutine real_to_string

src/tests/jf_test_42.F90

@@ -0,0 +1,107 @@
+!*****************************************************************************************
+!>
+! 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, "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%load_from_string(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_file(int(error_unit,IK))
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') 'get values as real...'
+    call json%get('bad_reals',bad_reals,found)
+
+    if (json%failed()) then    !if there was an error reading the file
+
+        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)') ''
+
+    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)
+    call json%print_file(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