Skip to content

Commit 9e9fb48

Browse files
jacobwilliamsjacobwilliams
committed
bug fix and new unit test for strict_type_checking=False modes.
1 parent 737010d commit 9e9fb48

File tree

4 files changed

+113
-1
lines changed

4 files changed

+113
-1
lines changed

‎src/json_value_module.F90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7755,7 +7755,7 @@ subroutine json_get_logical(json, me, value)
77557755
case (json_integer)
77567756
value = (me%int_value > 0_IK)
77577757
case (json_double)
7758-
value = (me%int_value > 0.0_RK)
7758+
value = (me%dbl_value > 0.0_RK)
77597759
case (json_string)
77607760
value = (me%str_value == true_str)
77617761
case default

‎src/tests/jf_test_31.F90

Lines changed: 109 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,109 @@
1+
!*****************************************************************************************
2+
!>
3+
! Module for the 31st unit test.
4+
5+
module jf_test_31_mod
6+
7+
use json_module, rk => json_rk, lk => json_lk, ik => json_ik, ck => json_ck, cdk => json_cdk
8+
use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
9+
10+
implicit none
11+
12+
contains
13+
14+
subroutine test_31(error_cnt)
15+
16+
!! Some tests of the `strict_type_checking` mode.
17+
18+
implicit none
19+
20+
integer,intent(out) :: error_cnt
21+
type(json_file) :: json
22+
integer(IK) :: ival
23+
real(RK) :: rval
24+
logical(LK) :: lval
25+
character(kind=CK,len=:),allocatable :: cval
26+
27+
character(kind=CK,len=*),parameter :: json_string = &
28+
'{ "int": 1, "double": 1.0, "int_false": 0, "double_false": 0.0, "logical": true, "logical_false": false, '//&
29+
'"string_int": "1", "string_double": "1.0", '//&
30+
'"int_str": "1", "double_str": "1.0", "logical_str": "true", "logical_str_false": "false" '//&
31+
'}'
32+
33+
error_cnt = 0
34+
35+
write(error_unit,'(A)') ''
36+
write(error_unit,'(A)') '================================='
37+
write(error_unit,'(A)') ' TEST 31'
38+
write(error_unit,'(A)') '================================='
39+
write(error_unit,'(A)') ''
40+
41+
call json%initialize(strict_type_checking = .false.)
42+
43+
call json%load_from_string(json_string)
44+
if (json%failed()) then
45+
call json%print_error_message(error_unit)
46+
error_cnt = error_cnt + 1
47+
else
48+
49+
! get stuff:
50+
call json%get('int', rval); if (.not. json%failed()) write(error_unit,*) rval
51+
call json%get('logical', rval); if (.not. json%failed()) write(error_unit,*) rval
52+
call json%get('logical_false', rval); if (.not. json%failed()) write(error_unit,*) rval
53+
call json%get('double', rval); if (.not. json%failed()) write(error_unit,*) rval
54+
call json%get('string_double', rval); if (.not. json%failed()) write(error_unit,*) rval
55+
56+
call json%get('int', ival); if (.not. json%failed()) write(error_unit,*) ival
57+
call json%get('logical', ival); if (.not. json%failed()) write(error_unit,*) ival
58+
call json%get('logical_false', ival); if (.not. json%failed()) write(error_unit,*) ival
59+
call json%get('double', ival); if (.not. json%failed()) write(error_unit,*) ival
60+
call json%get('string_int', ival); if (.not. json%failed()) write(error_unit,*) ival
61+
62+
call json%get('logical', lval); if (.not. json%failed()) write(error_unit,*) lval
63+
call json%get('int', lval); if (.not. json%failed()) write(error_unit,*) lval
64+
call json%get('double', lval); if (.not. json%failed()) write(error_unit,*) lval
65+
call json%get('logical_str', lval); if (.not. json%failed()) write(error_unit,*) lval
66+
call json%get('logical_false', lval); if (.not. json%failed()) write(error_unit,*) lval
67+
call json%get('int_false', lval); if (.not. json%failed()) write(error_unit,*) lval
68+
call json%get('double_false', lval); if (.not. json%failed()) write(error_unit,*) lval
69+
call json%get('logical_str_false', lval); if (.not. json%failed()) write(error_unit,*) lval
70+
71+
call json%get('int', cval); if (.not. json%failed()) write(error_unit,*) cval
72+
call json%get('logical', cval); if (.not. json%failed()) write(error_unit,*) cval
73+
call json%get('logical_false', cval); if (.not. json%failed()) write(error_unit,*) cval
74+
call json%get('double', cval); if (.not. json%failed()) write(error_unit,*) cval
75+
call json%get('string_int', cval); if (.not. json%failed()) write(error_unit,*) cval
76+
77+
if (json%failed()) then
78+
call json%print_error_message(error_unit)
79+
error_cnt = error_cnt + 1
80+
else
81+
write(error_unit,*) ''
82+
write(error_unit,*) 'Success!'
83+
end if
84+
85+
end if
86+
87+
call json%destroy() ! free memory
88+
89+
end subroutine test_31
90+
91+
end module jf_test_31_mod
92+
!*****************************************************************************************
93+
94+
#ifndef INTERGATED_TESTS
95+
!*****************************************************************************************
96+
program jf_test_31
97+
98+
!! 31st unit test.
99+
100+
use jf_test_31_mod , only: test_31
101+
implicit none
102+
integer :: n_errors
103+
n_errors = 0
104+
call test_31(n_errors)
105+
if (n_errors /= 0) stop 1
106+
107+
end program jf_test_31
108+
!*****************************************************************************************
109+
#endif

‎visual_studio/jsonfortrantest/jsonfortrantest.f90

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ program jsonfortrantest
3636
use jf_test_27_mod , only: test_27
3737
use jf_test_29_mod , only: test_29
3838
use jf_test_30_mod , only: test_30
39+
use jf_test_31_mod , only: test_31
3940

4041
implicit none
4142

@@ -72,6 +73,7 @@ program jsonfortrantest
7273
call test_27(n_errors); if (n_errors /= 0) stop 1
7374
call test_29(n_errors); if (n_errors /= 0) stop 1
7475
call test_30(n_errors); if (n_errors /= 0) stop 1
76+
call test_31(n_errors); if (n_errors /= 0) stop 1
7577

7678
end program jsonfortrantest
7779
!*****************************************************************************************

‎visual_studio/jsonfortrantest/jsonfortrantest.vfproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -75,5 +75,6 @@
7575
<File RelativePath="..\..\src\tests\jf_test_27.F90"/>
7676
<File RelativePath="..\..\src\tests\jf_test_29.F90"/>
7777
<File RelativePath="..\..\src\tests\jf_test_30.F90"/>
78+
<File RelativePath="..\..\src\tests\jf_test_31.F90"/>
7879
<File RelativePath=".\jsonfortrantest.f90"/></Filter></Files>
7980
<Globals/></VisualStudioProject>

0 commit comments

Comments
 (0)