Merge pull request #232 from jacobwilliams/real-format

Real format fix

Author: jacobwilliams

src/json_parameters.F90

@@ -93,7 +93,7 @@ module json_parameters
     !find out the precision of the floating point number system
     !and set safety factors
     integer(IK),parameter :: rp_safety_factor = 1_IK
-    integer(IK),parameter :: rp_addl_safety = 1_IK
+    integer(IK),parameter :: rp_addl_safety = 2_IK
     integer(IK),parameter :: real_precision = rp_safety_factor*precision(1.0_RK) + &
                                               rp_addl_safety
 

src/tests/jf_test_21.f90

@@ -0,0 +1,89 @@
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 10/20/2016
+!
+! Module for the 21st unit test.
+! This one is testing the real format options.
+
+module jf_test_21_mod
+
+    use json_module, RK => json_RK
+    use, intrinsic :: iso_fortran_env , only: error_unit,output_unit
+
+    implicit none
+
+    character(len=*),parameter :: dir = '../files/'    !! working directory
+
+contains
+
+    subroutine test_21(error_cnt)
+
+    !! Test some of the edge cases, and incorrect usages.
+
+    implicit none
+
+    integer,intent(out) :: error_cnt !! report number of errors to caller
+
+    type(json_core) :: json
+    type(json_file) :: jfile
+    type(json_value),pointer :: ptr
+
+    logical :: found
+    real(kind=RK),dimension(:),allocatable :: array1,array2
+
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') '   TEST 21'
+    write(error_unit,'(A)') '================================='
+    write(error_unit,'(A)') ''
+
+    error_cnt = 0
+
+    array1 = [sqrt(2.0_RK),sqrt(3.0_RK),sqrt(7.0_RK),&
+              sqrt(2.0e4_RK),sqrt(3.0e5_RK),sqrt(7.0e6_RK),&
+              huge(1.0_RK),tiny(1.0_RK),epsilon(1.0_RK)]
+
+    ! write array1 into file
+    call json % initialize(real_format='E')
+    call json % create_object(ptr,'')
+    call json % add(ptr,'value',array1)
+    call json % print(ptr,dir//'test21.json')
+    call json % destroy(ptr)
+
+    ! read array2 from file
+    call jfile % initialize(real_format='E')
+    call jfile % load_file(dir//'test21.json')
+    call jfile % get('value',array2,found)
+    call jfile % destroy()
+
+    ! Compare
+    write(*,*) ''
+    if (any(array1 /= array2)) then
+        error_cnt = error_cnt + 1
+        write(*,*) 'Test failed'
+        write(*,*) array1 == array2
+    else
+        write(*,*) 'Test passed'
+    end if
+    write(*,'(A,1X,*(E30.18E3))') 'original array :',array1
+    write(*,'(A,1X,*(E30.18E3))') 'read from file :',array2
+    write(*,*) ''
+
+    end subroutine test_21
+
+end module jf_test_21_mod
+!*****************************************************************************************
+
+!*****************************************************************************************
+program jf_test_21
+
+    !! 21st unit test.
+
+    use jf_test_21_mod, only: test_21
+    implicit none
+    integer :: n_errors
+    call test_21(n_errors)
+    if ( n_errors /= 0) stop 1
+
+end program jf_test_21
+!*****************************************************************************************