Added error message if json_initialize is not called first. Fixes #142

Added support for changing the real printing format on subsequent calls to son_initialize.  Fixes #143
Added new units test and some formatting updates.

Author: jacobwilliams

src/json_module.F90

@@ -867,6 +867,10 @@ end subroutine array_callback_func
     !for indenting (Note: jsonlint.com uses 4 spaces)
     integer(IK),parameter :: spaces_per_tab = 2
 
+    !Variables for real string printing:
+    
+    logical(LK) :: compact_real = .true.   !! to use the "compact" form of real numbers for output
+    
     !find out the precision of the floating point number system
     !and set safety factors
     integer(IK),parameter :: rp_safety_factor = 1
@@ -881,25 +885,21 @@ end subroutine array_callback_func
                                   real(max(maxexp,abs(maxexp)),&
                                   kind=RK) ) )
 
-    !6 = sign + leading 0 + decimal + 'E' + exponent sign + 1 extra
-    integer(IK),parameter :: max_numeric_str_len = real_precision + real_exponent_digits + 6
-    ! real format set by library initialization
-    character(kind=CDK,len=*),parameter :: int_fmt  = '(ss,I0)' !minimum width format for integers
-    character(kind=CK, len=*),parameter :: star     = '*'       !for invalid numbers
-
-    !real string printing:
-    character(kind=CDK,len=:),allocatable :: real_fmt  !the format string to use for real numbers
-                                                       ! [set in json_initialize]
-    logical(LK) :: compact_real = .true.   !to use the "compact" form of real numbers for output
+    integer(IK),parameter :: max_numeric_str_len = real_precision + real_exponent_digits + 6  
+    !! 6 = sign + leading 0 + decimal + 'E' + exponent sign + 1 extra
+    character(kind=CDK,len=*),parameter :: int_fmt  = '(ss,I0)' !! minimum width format for integers
+    character(kind=CK, len=*),parameter :: star     = '*'       !! for invalid numbers
+    character(kind=CDK,len=:),allocatable :: real_fmt  !! the format string to use for real numbers
+                                                       !! it is set in [[json_initialize]]
 
     !
     ! Note: the following global variables make this module non thread safe.
     !
 
     !exception handling [private variables]
-    logical(LK) :: is_verbose = .false.                 !if true, all exceptions are immediately printed to console
-    logical(LK) :: exception_thrown = .false.           !the error flag
-    character(kind=CK,len=:),allocatable :: err_message !the error message
+    logical(LK) :: is_verbose = .false.                 !! if true, all exceptions are immediately printed to console
+    logical(LK) :: exception_thrown = .true.            !! the error flag (by default, this is true to make sure that [[json_initialize]] is called.
+    character(kind=CK,len=:),allocatable :: err_message !! the error message
 
     !temp vars used when parsing lines in file [private variables]
     integer(IK) :: char_count = 0    !character position in the current line
@@ -1642,59 +1642,71 @@ subroutine json_initialize(verbose,compact_reals,print_signs,real_format)
 
     implicit none
 
-    logical(LK),intent(in),optional :: verbose       !! mainly useful for debugging (default is false)
-    logical(LK),intent(in),optional :: compact_reals !! to compact the real number strings for output
-    logical(LK),intent(in),optional :: print_signs   !! always print numeric sign (default is false)
-    character(len=*,kind=CDK),intent(in),optional :: real_format
-    !! exponential (default), scientific, engineering or general
+    logical(LK),intent(in),optional               :: verbose       !! mainly useful for debugging (default is false)
+    logical(LK),intent(in),optional               :: compact_reals !! to compact the real number strings for output (default is true)
+    logical(LK),intent(in),optional               :: print_signs   !! always print numeric sign (default is false)
+    character(len=*,kind=CDK),intent(in),optional :: real_format   !! exponential (default), scientific, engineering or general
 
     character(kind=CDK,len=10) :: w,d,e
     character(kind=CDK,len=2)  :: sgn, rl_edit_desc
     integer(IK) :: istat
     logical(LK) :: sgn_prnt
 
-
     !clear any errors from previous runs:
     call json_clear_exceptions()
 
-    !set defaults
-    sgn_prnt = .false.
-    if ( present( print_signs) ) sgn_prnt = print_signs
-    if ( sgn_prnt ) then
-       sgn = 'sp'
-    else
-       sgn = 'ss'
-    end if
+    !Ensure gfortran bug work around "parameters" are set properly
+    null_str  = 'null'
+    true_str  = 'true'
+    false_str = 'false'
 
-    rl_edit_desc = 'E'
-    if ( present( real_format ) ) then
-       select case ( real_format )
-       case ('g','G','e','E','en','EN','es','ES')
-          rl_edit_desc = real_format
-       case default
-          call throw_exception('Invalid real format, "' // trim(real_format) // '", passed to json_initialize.'// &
-               new_line('a') // 'Acceptable formats are: "G", "E", "EN", and "ES".' )
-       end select
-    end if
+    !Just in case, clear these global variables also:
+    pushed_index = 0
+    pushed_char  = ''
+    char_count   = 0
+    line_count   = 1
+    ipos         = 1
 
 # ifdef USE_UCS4
     ! reopen stdout and stderr with utf-8 encoding
     open(output_unit,encoding='utf-8')
     open(error_unit, encoding='utf-8')
 # endif
 
-    !Ensure gfortran bug work around "parameters" are set properly
-    null_str  = 'null'
-    true_str  = 'true'
-    false_str = 'false'
+    !verbose error printing:
+    if (present(verbose)) is_verbose = verbose
+
+    !Set the format for real numbers:
+    ! [if not changing it, then it remains the same]
+
+    if ( (.not. allocated(real_fmt)) .or. &  ! if this hasn't been done yet
+          present(compact_reals)     .or. &
+          present(print_signs)       .or. &
+          present(real_format) ) then
+
+        if (present(compact_reals)) compact_real = compact_reals  
+
+        !set defaults
+        sgn_prnt = .false.
+        if ( present( print_signs) ) sgn_prnt = print_signs
+        if ( sgn_prnt ) then
+           sgn = 'sp'
+        else
+           sgn = 'ss'
+        end if
 
-    !optional inputs (if not present, values remains unchanged):
-    if (present(verbose))       is_verbose   = verbose
-    if (present(compact_reals)) compact_real = compact_reals
+        rl_edit_desc = 'E'
+        if ( present( real_format ) ) then
+           select case ( real_format )
+           case ('g','G','e','E','en','EN','es','ES')
+              rl_edit_desc = real_format
+           case default
+              call throw_exception('Invalid real format, "' // trim(real_format) // '", passed to json_initialize.'// &
+                   new_line('a') // 'Acceptable formats are: "G", "E", "EN", and "ES".' )
+           end select
+        end if
 
-    ! set the default output/input format for reals:
-    !  [this only needs to be done once, since it can't change]
-    if (.not. allocated(real_fmt)) then
+        ! set the default output/input format for reals:
                       write(w,'(ss,I0)',iostat=istat) max_numeric_str_len
         if (istat==0) write(d,'(ss,I0)',iostat=istat) real_precision
         if (istat==0) write(e,'(ss,I0)',iostat=istat) real_exponent_digits
@@ -1703,14 +1715,8 @@ subroutine json_initialize(verbose,compact_reals,print_signs,real_format)
         else
             real_fmt = '(' // sgn // ',' // trim(rl_edit_desc) // '30.16E3)'  !just use this one (should never happen)
         end if
-    end if
 
-    !Just in case, clear these global variables also:
-    pushed_index = 0
-    pushed_char  = ''
-    char_count   = 0
-    line_count   = 1
-    ipos         = 1
+    end if
 
     end subroutine json_initialize
 !*****************************************************************************************
@@ -1815,7 +1821,7 @@ subroutine json_check_for_errors(status_ok, error_msg)
         if (allocated(err_message)) then
             error_msg = err_message
         else
-            error_msg = 'Unknown Error'
+            error_msg = 'Error: json_initialize() must be called first to initialize the module.'
         end if
     else
         error_msg = ''

src/tests/jf_test_12.f90

@@ -18,23 +18,26 @@ module jf_test_12_mod
 contains
 
     subroutine test_12(error_cnt)
+    
+    implicit none
 
     integer,intent(out) :: error_cnt !! report number of errors to caller
 
     integer,parameter :: imx = 5, jmx = 3, kmx = 4 !! dimensions for raw work array of primitive type
-    integer :: shape(3)                            !! shape of work array
-    integer, allocatable :: fetched_shape(:)       !! retrieved shape
-    type(json_value), pointer :: root, meta_array  !! json nodes to work with
-    type(json_value), pointer :: tmp_json_ptr
-    type(json_file) :: my_file
-    real(wp) :: raw_array(imx,jmx,kmx)             !! raw work array
-    real(wp) :: array_element
-    real(wp), allocatable :: fetched_array(:)
+    
+    integer,dimension(3)                  :: shape             !! shape of work array
+    integer, dimension(:), allocatable    :: fetched_shape     !! retrieved shape
+    type(json_value), pointer             :: root, meta_array  !! json nodes to work with
+    type(json_value), pointer             :: tmp_json_ptr
+    type(json_file)                       :: my_file
+    real(wp),dimension(imx,jmx,kmx)       :: raw_array         !! raw work array
+    real(wp)                              :: array_element
+    real(wp), dimension(:), allocatable   :: fetched_array
     character(kind=CK,len=:), allocatable :: description
-    integer :: i,j,k                               !! loop indices
-    integer :: array_length, lun
-    logical :: existed
-    logical, allocatable :: SOS(:)
+    integer                               :: i,j,k             !! loop indices
+    integer                               :: array_length, lun
+    logical                               :: existed
+    logical, dimension(:), allocatable    :: SOS
 
     error_cnt = 0
     call json_initialize(verbose=.true.,real_format='G')
@@ -178,7 +181,7 @@ subroutine check_errors(assertion)
         if (present (assertion)) then
            if (.not. assertion) error_cnt = error_cnt + 1
         end if
-      end subroutine
+      end subroutine check_errors
 
       subroutine get_3D_from_array(element, i, count)
         type(json_value), pointer , intent(in)   :: element
@@ -192,9 +195,9 @@ subroutine get_3D_from_array(element, i, count)
              mod((i-1)/imx,jmx) + 1, &      ! j index
              mod((i-1)/imx/jmx,kmx) + 1 ) ) ! k inded
         useless = count
-      end subroutine
+      end subroutine get_3D_from_array
 
-    end subroutine
+    end subroutine test_12
 
 end module jf_test_12_mod
 !*****************************************************************************************
@@ -210,5 +213,6 @@ program jf_test_12
     n_errors = 0
     call test_12(n_errors)
     if ( n_errors /= 0) stop 1
+    
 end program jf_test_12
 !*****************************************************************************************

src/tests/jf_test_13.f90

@@ -0,0 +1,76 @@
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 09/01/2015
+!
+! Module for the 13th unit test.
+
+module jf_test_13_mod
+
+    use json_module
+    use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
+
+    implicit none
+
+contains
+
+    subroutine test_13(error_cnt)
+    
+    !! Tests different real format strings using repeated calls to [[json_initialize]].
+    
+    implicit none
+
+    integer,intent(out) :: error_cnt !! report number of errors to caller
+    
+    type(json_file)  :: my_file
+    character(kind=CK,len=:),allocatable :: str
+    integer :: i
+    
+    character(len=2),dimension(4),parameter :: fmts=['g ','e ','en','es'] !! format statements to test
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') '   TEST 13'
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') ''
+
+    error_cnt = 0
+    
+    do i=1,size(fmts)
+    
+        call json_initialize(real_format=trim(fmts(i)))
+    
+        call my_file%load_from_string('{ "value": 1234.56789 }')
+        if (json_failed()) then
+            call json_print_error_message(error_unit)
+            error_cnt = error_cnt + 1
+        end if
+        call my_file%print_to_string(str)
+        if (json_failed()) then
+            call json_print_error_message(error_unit)
+            error_cnt = error_cnt + 1
+        else
+            write(output_unit,'(A)') str
+        end if
+    
+        call my_file%destroy()
+    
+    end do
+    
+    end subroutine test_13
+
+end module jf_test_13_mod
+!*****************************************************************************************
+
+!*****************************************************************************************
+program jf_test_13
+
+    !! 13th unit test.
+    
+    use jf_test_13_mod, only: test_13
+    implicit none
+    integer :: n_errors
+    call test_13(n_errors)
+    if ( n_errors /= 0) stop 1
+    
+end program jf_test_13
+!*****************************************************************************************