Skip to content

Commit 309de97

Browse files
jacobwilliamsjacobwilliams
committed
fixed typos.
added unit test for RFC 6901 paths.
1 parent 82e2c03 commit 309de97

File tree

2 files changed

+234
-2
lines changed

2 files changed

+234
-2
lines changed

‎src/json_value_module.F90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4236,7 +4236,7 @@ subroutine json_get_by_path_rfc6901(json, me, path, p, found)
42364236
end if
42374237
end if
42384238
if (.not. status_ok) then
4239-
call json%throw_exception('Error in json_get_by_path_rfc6901: '&
4239+
call json%throw_exception('Error in json_get_by_path_rfc6901: '//&
42404240
'invalid path specification: '//trim(path))
42414241
exit
42424242
end if
@@ -4250,7 +4250,7 @@ subroutine json_get_by_path_rfc6901(json, me, path, p, found)
42504250
end do
42514251

42524252
else
4253-
call json%throw_exception('Error in json_get_by_path_rfc6901: '&
4253+
call json%throw_exception('Error in json_get_by_path_rfc6901: '//&
42544254
'invalid path specification: '//trim(path))
42554255
end if
42564256
end if

‎src/tests/jf_test_23.f90

Lines changed: 232 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,232 @@
1+
!*****************************************************************************************
2+
!>
3+
! Module for the 23rd unit test.
4+
5+
module jf_test_23_mod
6+
7+
use json_module
8+
use, intrinsic :: iso_fortran_env , only: error_unit, output_unit, wp => real64
9+
10+
implicit none
11+
12+
character(len=*),parameter :: dir = '../files/inputs/' !! working directory
13+
character(len=*),parameter :: filename1 = 'test1.json' !! file to read
14+
15+
contains
16+
17+
subroutine test_23(error_cnt)
18+
19+
!! Read a sample JSON file and retrieve some data from it
20+
!! using RFC 6901 paths.
21+
22+
implicit none
23+
24+
type(json_file) :: json !! the JSON structure read from the file
25+
type(json_value),pointer :: p
26+
type(json_core) :: core
27+
integer,intent(out) :: error_cnt
28+
character(kind=json_CK,len=:),allocatable :: cval
29+
character(kind=json_CK,len=:),allocatable :: key
30+
character(kind=json_CK,len=:),allocatable :: path
31+
integer :: ival
32+
real(wp) :: rval
33+
logical :: found
34+
35+
error_cnt = 0
36+
call json%initialize( trailing_spaces_significant=.true.,&
37+
case_sensitive_keys=.true.,&
38+
use_rfc6901_paths=.true.)
39+
if (json%failed()) then
40+
call json%print_error_message(error_unit)
41+
error_cnt = error_cnt + 1
42+
end if
43+
44+
write(error_unit,'(A)') ''
45+
write(error_unit,'(A)') '================================='
46+
write(error_unit,'(A)') ' TEST 23'
47+
write(error_unit,'(A)') '================================='
48+
write(error_unit,'(A)') ''
49+
50+
! parse the json file:
51+
write(error_unit,'(A)') ''
52+
write(error_unit,'(A)') 'parsing file '//dir//filename1
53+
54+
call json%load_file(filename = dir//filename1)
55+
56+
if (json%failed()) then !if there was an error reading the file
57+
58+
call json%print_error_message(error_unit)
59+
error_cnt = error_cnt + 1
60+
61+
else
62+
63+
! print the parsed data to the console
64+
write(error_unit,'(A)') ''
65+
write(error_unit,'(A)') 'printing the file...'
66+
call json%print_file()
67+
if (json%failed()) then
68+
call json%print_error_message(error_unit)
69+
error_cnt = error_cnt + 1
70+
end if
71+
72+
! extract data from the parsed value
73+
write(error_unit,'(A)') ''
74+
write(error_unit,'(A)') 'get some data from the file...'
75+
76+
write(error_unit,'(A)') ''
77+
key = '/version/svn'
78+
call json%get(key, ival)
79+
if (json%failed()) then
80+
call json%print_error_message(error_unit)
81+
error_cnt = error_cnt + 1
82+
else
83+
write(error_unit,'(A,I5)') key//' = ',ival
84+
end if
85+
86+
write(error_unit,'(A)') ''
87+
key = '/data/0/array/1'
88+
call json%get(key, cval)
89+
if (json%failed()) then
90+
call json%print_error_message(error_unit)
91+
error_cnt = error_cnt + 1
92+
else
93+
write(error_unit,'(A)') key//' = '//trim(cval)
94+
end if
95+
96+
write(error_unit,'(A)') ''
97+
key = '/files/0'
98+
call json%get(key, cval)
99+
if (json%failed()) then
100+
call json%print_error_message(error_unit)
101+
error_cnt = error_cnt + 1
102+
else
103+
write(error_unit,'(A)') key//' = '//trim(cval)
104+
end if
105+
106+
write(error_unit,'(A)') ''
107+
key = '/files/1'
108+
call json%get(key, cval)
109+
if (json%failed()) then
110+
call json%print_error_message(error_unit)
111+
error_cnt = error_cnt + 1
112+
else
113+
write(error_unit,'(A)') key//' = '//trim(cval)
114+
end if
115+
116+
write(error_unit,'(A)') ''
117+
key = '/files/2'
118+
call json%get(key, cval)
119+
if (json%failed()) then
120+
call json%print_error_message(error_unit)
121+
error_cnt = error_cnt + 1
122+
else
123+
write(error_unit,'(A)') key//' = '//trim(cval)
124+
end if
125+
126+
write(error_unit,'(A)') ''
127+
key = '/data/1/real'
128+
call json%get(key, rval)
129+
if (json%failed()) then
130+
call json%print_error_message(error_unit)
131+
error_cnt = error_cnt + 1
132+
else
133+
write(error_unit,'(A,E30.16)') key//' = ',rval
134+
end if
135+
136+
write(error_unit,'(A)') ''
137+
key = '/files/3'
138+
call json%get(key, cval) !has hex characters
139+
if (json%failed()) then
140+
call json%print_error_message(error_unit)
141+
error_cnt = error_cnt + 1
142+
else
143+
write(error_unit,'(A)') key//' = '//trim(cval)
144+
end if
145+
146+
write(error_unit,'(A)') ''
147+
key = '/files/4'
148+
call json%get(key, cval) !string with spaces and no escape characters
149+
if (json%failed()) then
150+
call json%print_error_message(error_unit)
151+
error_cnt = error_cnt + 1
152+
else
153+
write(error_unit,'(A)') key//' = '//trim(cval)
154+
end if
155+
156+
!
157+
! Test of values that aren't there:
158+
! Note: when using the "found" output, the exceptions are cleared automatically.
159+
!
160+
161+
write(error_unit,'(A)') ''
162+
key = '/files/9'
163+
call json%get(key, cval, found) !value that isn't there
164+
if (.not. found) then
165+
write(error_unit,'(A)') key//' not in file.'
166+
else
167+
write(error_unit,'(1x,A)') key//' = '//trim(cval)
168+
error_cnt = error_cnt + 1
169+
end if
170+
171+
write(error_unit,'(A)') ''
172+
key = '/version/blah'
173+
call json%get(key, ival, found) !value that isn't there
174+
if (.not. found) then
175+
write(error_unit,'(A)') key//' not in file.'
176+
else
177+
write(error_unit,'(A)') key//' = ',ival
178+
error_cnt = error_cnt + 1
179+
end if
180+
181+
end if
182+
183+
! get the path to one of the variables:
184+
185+
call core%initialize( trailing_spaces_significant=.true.,&
186+
case_sensitive_keys=.true.,&
187+
use_rfc6901_paths=.true.)
188+
189+
write(error_unit,'(A)') ''
190+
key = '/data/1/real'
191+
call json%get(key,p)
192+
call core%get_path(p, path, found)
193+
if (found) then
194+
if (key==path) then
195+
write(error_unit,'(A)') 'get_path test passed: '//path
196+
else
197+
write(error_unit,'(A)') 'Error: path does not match: '//path//' '//key
198+
error_cnt = error_cnt + 1
199+
end if
200+
else
201+
write(error_unit,'(A)') 'Error: could not find '//key
202+
error_cnt = error_cnt + 1
203+
end if
204+
205+
! clean up
206+
write(error_unit,'(A)') ''
207+
write(error_unit,'(A)') 'destroy...'
208+
call json%destroy()
209+
if (json%failed()) then
210+
call json%print_error_message(error_unit)
211+
error_cnt = error_cnt + 1
212+
end if
213+
214+
end subroutine test_23
215+
216+
end module jf_test_23_mod
217+
!*****************************************************************************************
218+
219+
!*****************************************************************************************
220+
program jf_test_23
221+
222+
!! 23rd unit test.
223+
224+
use jf_test_23_mod , only: test_23
225+
implicit none
226+
integer :: n_errors
227+
n_errors = 0
228+
call test_23(n_errors)
229+
if (n_errors /= 0) stop 1
230+
231+
end program jf_test_23
232+
!*****************************************************************************************

0 commit comments

Comments
 (0)