Merge pull request #446 from jacobwilliams/444-new-integer-parsing-option

added a new option for integer parsing.

Author: jacobwilliams

src/json_initialize_arguments.inc

@@ -96,7 +96,17 @@ integer(IK),intent(in),optional :: non_normal_mode
   !!   "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.
+  !! * 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.
+logical(LK),intent(in),optional :: strict_integer_type_checking
+  !! * If false, when parsing JSON, if an integer numeric value
+  !!   cannot be converted to an integer (`integer(IK)`),
+  !!   then an attempt is then make to convert it
+  !!   to a real (`real(RK)`).
+  !! * If true, an exception will be raised if the integer
+  !!   value cannot be read.
+  !!
+  !! (default is true)

src/json_initialize_dummy_arguments.inc

@@ -21,4 +21,5 @@ escape_solidus,&
 stop_on_error,&
 null_to_real_mode,&
 non_normal_mode,&
-use_quiet_nan &
+use_quiet_nan, &
+strict_integer_type_checking &

src/json_value_module.F90

@@ -278,6 +278,14 @@ module json_value_module
                                               !! `ieee_quiet_nan` for NaN values. If false,
                                               !! `ieee_signaling_nan` will be used.
 
+        logical(LK) :: strict_integer_type_checking = .true.
+                            !! * If false, when parsing JSON, if an integer numeric value
+                            !!   cannot be converted to an integer (`integer(IK)`),
+                            !!   then an attempt is then make to convert it
+                            !!   to a real (`real(RK)`).
+                            !! * If true [default], an exception will be raised if an integer
+                            !!   value cannot be read when parsing JSON.
+
         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`
@@ -1125,6 +1133,10 @@ subroutine json_initialize(me,&
         me%use_quiet_nan = use_quiet_nan
     end if
 
+    if (present(strict_integer_type_checking)) then
+        me%strict_integer_type_checking = strict_integer_type_checking
+    end if
+
     !Set the format for real numbers:
     ! [if not changing it, then it remains the same]
 
@@ -6772,6 +6784,7 @@ subroutine json_get_by_path_default(json,me,path,p,found,create_it,was_created)
     logical(LK)              :: created     !! if `create` is true, then this will be
                                             !! true if the leaf object had to be created
     integer(IK)              :: j           !! counter of children when creating object
+    logical(LK)              :: status_ok   !! integer to string conversion flag
 
     nullify(p)
 
@@ -6877,7 +6890,13 @@ subroutine json_get_by_path_default(json,me,path,p,found,create_it,was_created)
                     exit
                 end if
                 array = .false.
-                child_i = json%string_to_int(path(child_i:i-1))
+                call string_to_integer(path(child_i:i-1),child_i,status_ok)
+                if (.not. status_ok) then
+                    call json%throw_exception('Error in json_get_by_path_default:'//&
+                                              ' Could not convert array index to integer: '//&
+                                              trim(path(child_i:i-1)),found)
+                    exit
+                end if
 
                 nullify(tmp)
                 if (create) then
@@ -7991,8 +8010,8 @@ function string_to_int(json,str) result(ival)
         if (.not. status_ok) then
             ival = 0
             call json%throw_exception('Error in string_to_int: '//&
-                                      'string cannot be converted to an integer: '//&
-                                      trim(str))
+                                    'string cannot be converted to an integer: '//&
+                                    trim(str))
         end if
 
     else
@@ -11128,6 +11147,8 @@ subroutine parse_number(json, unit, str, value)
     type(json_value),pointer            :: value
 
     character(kind=CK,len=:),allocatable :: tmp !! temp string
+    character(kind=CK,len=:),allocatable :: saved_err_message !! temp error message for
+                                                              !! string to int conversion
     character(kind=CK,len=1) :: c           !! character returned by [[pop_char]]
     logical(LK)              :: eof         !! end of file flag
     real(RK)                 :: rval        !! real value
@@ -11187,9 +11208,31 @@ subroutine parse_number(json, unit, str, value)
 
                 !string to value:
                 if (is_integer) then
+                    ! it is an integer:
                     ival = json%string_to_int(tmp)
-                    call json%to_integer(value,ival)
+
+                    if (json%exception_thrown .and. .not. json%strict_integer_type_checking) then
+                        ! if it couldn't be converted to an integer,
+                        ! then try to convert it to a real value and see if that works
+
+                        saved_err_message = json%err_message  ! keep the original error message
+                        call json%clear_exceptions()          ! clear exceptions
+                        rval = json%string_to_dble(tmp)
+                        if (json%exception_thrown) then
+                            ! restore original error message and continue
+                            json%err_message = saved_err_message
+                            call json%to_integer(value,ival) ! just so we have something
+                        else
+                            ! in this case, we return a real
+                            call json%to_real(value,rval)
+                        end if
+
+                    else
+                        call json%to_integer(value,ival)
+                    end if
+
                 else
+                    ! it is a real:
                     rval = json%string_to_dble(tmp)
                     call json%to_real(value,rval)
                 end if

src/tests/jf_test_43.F90

@@ -0,0 +1,104 @@
+!*****************************************************************************************
+!>
+! Module for the 43nd unit test
+
+module jf_test_43_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_43
+
+contains
+
+    subroutine test_43(error_cnt)
+
+    !! integer too large for default integer kind
+
+    implicit none
+
+    integer,intent(out) :: error_cnt !! error counter
+
+    character(kind=CK,len=*),parameter :: str = CK_'{ "x": 2147483648 }'
+
+    type(json_file) :: json
+    logical :: found
+    real(RK) :: x
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') '   TEST 43'
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') ''
+
+    error_cnt = 0
+
+    ! enable the feature to try to parse an int
+    ! as a real if it fails to be parsed as an int
+    call json%initialize(strict_integer_type_checking=.false.)
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') 'JSON string to parse... '
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') str
+
+    ! 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))
+    write(error_unit,'(A)') ''
+
+    call json%get('x',x,found)
+    if (found) then
+        write(error_unit,'(A,1X,F32.17)') 'x = ', x
+    else
+        write(error_unit,'(A)') 'Error: x not found in string'
+        error_cnt = error_cnt + 1
+    end if
+
+    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_43
+
+end module jf_test_43_mod
+!*****************************************************************************************
+
+#ifndef INTEGRATED_TESTS
+!*****************************************************************************************
+program jf_test_43
+
+    !! 43nd unit test.
+
+    use jf_test_43_mod , only: test_43
+    implicit none
+    integer :: n_errors
+    n_errors = 0
+    call test_43(n_errors)
+    if (n_errors /= 0) stop 1
+
+end program jf_test_43
+!*****************************************************************************************
+#endif
+
+
+
+

visual_studio/jsonfortrantest/jsonfortrantest.f90

@@ -98,6 +98,7 @@ program jsonfortrantest
     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
+    call test_43(n_errors); if (n_errors /= 0) stop 1
 
     end program jsonfortrantest
 !*****************************************************************************************

visual_studio/jsonfortrantest/jsonfortrantest.vfproj

@@ -88,5 +88,6 @@
 		<File RelativePath="..\..\src\tests\jf_test_40.F90"/>
 		<File RelativePath="..\..\src\tests\jf_test_41.F90"/>
 		<File RelativePath="..\..\src\tests\jf_test_42.F90"/>
+		<File RelativePath="..\..\src\tests\jf_test_43.F90"/>
 		<File RelativePath=".\jsonfortrantest.f90"/></Filter></Files>
 	<Globals/></VisualStudioProject>