@@ -31,6 +31,7 @@ subroutine test_23(error_cnt)
3131 integer :: ival
3232 real (wp) :: rval
3333 logical :: found
34+ character (kind= json_CK,len= 10 ),dimension (:),allocatable :: cval_array
3435
3536 error_cnt = 0
3637 call json% initialize( trailing_spaces_significant= .true. ,&
@@ -76,83 +77,115 @@ subroutine test_23(error_cnt)
7677 write (error_unit,' (A)' ) ' '
7778 key = ' /version/svn'
7879 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
80+ call check_i()
8581
8682 write (error_unit,' (A)' ) ' '
8783 key = ' /data/0/array/1'
8884 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
85+ call check_c()
9586
9687 write (error_unit,' (A)' ) ' '
9788 key = ' /files/0'
9889 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
90+ call check_c()
10591
10692 write (error_unit,' (A)' ) ' '
10793 key = ' /files/1'
10894 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
95+ call check_c()
11596
11697 write (error_unit,' (A)' ) ' '
11798 key = ' /files/2'
11899 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
100+ call check_c()
125101
126102 write (error_unit,' (A)' ) ' '
127103 key = ' /data/1/real'
128104 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
105+ call check_i()
135106
136107 write (error_unit,' (A)' ) ' '
137108 key = ' /files/3'
138109 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
110+ call check_c()
145111
146112 write (error_unit,' (A)' ) ' '
147113 key = ' /files/4'
148114 call json% get(key, cval) ! string with spaces and no escape characters
115+ call check_c()
116+
117+ ! Test the examples in the RFC 6901 spec:
118+
119+ write (error_unit,' (A)' ) ' '
120+ key = " "
121+ call json% get(key, p) ! the whole document
149122 if (json% failed()) then
150- call json% print_error_message(error_unit)
151- error_cnt = error_cnt + 1
123+ write (error_unit,' (A)' ) ' Error: could not find ' // key
124+ error_cnt = error_cnt + 1
125+ end if
126+
127+ write (error_unit,' (A)' ) ' '
128+ key = " /rfc6901 tests/foo"
129+ call json% get(key, cval_array) ! ["bar", "baz"]
130+ if (json% failed()) then
131+ write (error_unit,' (A)' ) ' Error: could not find ' // key
132+ error_cnt = error_cnt + 1
152133 else
153- write (error_unit,' (A)' ) key// ' = ' // trim (cval)
134+ write (error_unit,' (A)' ) key// ' = ' ,cval_array
154135 end if
155136
137+ write (error_unit,' (A)' ) ' '
138+ key = " /rfc6901 tests/foo/0"
139+ call json% get(key, cval) ! "bar"
140+ call check_c() ! "bar"
141+
142+ write (error_unit,' (A)' ) ' '
143+ key = " /rfc6901 tests/ "
144+ call json% get(key, ival)
145+ call check_i() ! 0
146+
147+ write (error_unit,' (A)' ) ' '
148+ key = " /rfc6901 tests/a~1b"
149+ call json% get(key, ival)
150+ call check_i() ! 1
151+
152+ write (error_unit,' (A)' ) ' '
153+ key = " /rfc6901 tests/c%d"
154+ call json% get(key, ival)
155+ call check_i() ! 2
156+
157+ write (error_unit,' (A)' ) ' '
158+ key = " /rfc6901 tests/e^f"
159+ call json% get(key, ival)
160+ call check_i() ! 3
161+
162+ write (error_unit,' (A)' ) ' '
163+ key = " /rfc6901 tests/g|h"
164+ call json% get(key, ival)
165+ call check_i() ! 4
166+
167+ write (error_unit,' (A)' ) ' '
168+ key = " /rfc6901 tests/i\\j"
169+ call json% get(key, ival)
170+ call check_i() ! 5
171+
172+ write (error_unit,' (A)' ) ' '
173+ key = " /rfc6901 tests/k\"" l"
174+ call json% get(key, ival)
175+ call check_i() ! 6
176+
177+ write (error_unit,' (A)' ) ' '
178+ key = " /rfc6901 tests/ "
179+ call json% get(key, ival)
180+ call check_i() ! 7
181+
182+ write (error_unit,' (A)' ) ' '
183+ key = " /rfc6901 tests/m~0n"
184+ call json% get(key, ival)
185+ call check_i() ! 8
186+
187+
188+
156189 !
157190 ! Test of values that aren't there:
158191 ! Note: when using the "found" output, the exceptions are cleared automatically.
@@ -211,6 +244,38 @@ subroutine test_23(error_cnt)
211244 error_cnt = error_cnt + 1
212245 end if
213246
247+ contains
248+
249+ subroutine check_c ()
250+
251+ ! ! check results of a character test
252+
253+ implicit none
254+
255+ if (json% failed()) then
256+ call json% print_error_message(error_unit)
257+ error_cnt = error_cnt + 1
258+ else
259+ write (error_unit,' (A)' ) key// ' = ' // cval
260+ end if
261+
262+ end subroutine check_c
263+
264+ subroutine check_i ()
265+
266+ ! ! check results of an integer test
267+
268+ implicit none
269+
270+ if (json% failed()) then
271+ call json% print_error_message(error_unit)
272+ error_cnt = error_cnt + 1
273+ else
274+ write (error_unit,' (A,I5)' ) key// ' = ' ,ival
275+ end if
276+
277+ end subroutine check_i
278+
214279 end subroutine test_23
215280
216281end module jf_test_23_mod
0 commit comments