Skip to content

Commit fe121d4

Browse files
jacobwilliamsjacobwilliams
committed
Merge pull request #83 from jacobwilliams/unit-tests
added new unit tests with some of the uncovered routines
2 parents f49af5a + 350394a commit fe121d4

File tree

1 file changed

+356
-0
lines changed

1 file changed

+356
-0
lines changed

‎src/tests/jf_test_10.f90

Lines changed: 356 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,356 @@
1+
!*******************************************************************************************************
2+
!****u* JSON/jf_test_10
3+
!
4+
! NAME
5+
! jf_test_10
6+
!
7+
! DESCRIPTION
8+
! Tenth unit test.
9+
!
10+
! AUTHOR
11+
! Jacob Williams : 3/10/3015
12+
!
13+
! LICENSE
14+
!
15+
! JSON-FORTRAN: A Fortran 2008 JSON API
16+
!
17+
! https://github.com/jacobwilliams/json-fortran
18+
!
19+
! Copyright (c) 2014, Jacob Williams
20+
!
21+
! All rights reserved.
22+
!
23+
! Redistribution and use in source and binary forms, with or without modification,
24+
! are permitted provided that the following conditions are met:
25+
! * Redistributions of source code must retain the above copyright notice, this
26+
! list of conditions and the following disclaimer.
27+
! * Redistributions in binary form must reproduce the above copyright notice, this
28+
! list of conditions and the following disclaimer in the documentation and/or
29+
! other materials provided with the distribution.
30+
! * The names of its contributors may not be used to endorse or promote products
31+
! derived from this software without specific prior written permission.
32+
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
33+
! ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
34+
! WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
35+
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
36+
! ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
37+
! (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
38+
! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
39+
! ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
40+
! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
41+
! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
42+
!
43+
! SOURCE
44+
45+
module jf_test_10_mod
46+
47+
use json_module
48+
use, intrinsic :: iso_fortran_env , only: error_unit, output_unit, wp => real64
49+
50+
implicit none
51+
52+
character(len=*),parameter :: filename = 'test1.json'
53+
character(len=*),parameter :: dir = '../files/' !working directory
54+
55+
contains
56+
57+
subroutine test_10(error_cnt)
58+
59+
! Test some of the lesser-used features of the library
60+
61+
implicit none
62+
63+
integer,intent(out) :: error_cnt
64+
65+
character(len=256),dimension(:),allocatable :: str_vec
66+
type(json_file) :: f,f2
67+
type(json_value),pointer :: p
68+
character(len=:),allocatable :: str
69+
logical :: found,lval
70+
integer :: var_type,n_children
71+
72+
character(len=*),parameter :: json_str = '{ "blah": 123 }'
73+
74+
error_cnt = 0
75+
call json_initialize()
76+
if (json_failed()) then
77+
call json_print_error_message(error_unit)
78+
error_cnt = error_cnt + 1
79+
end if
80+
81+
write(error_unit,'(A)') ''
82+
write(error_unit,'(A)') '================================='
83+
write(error_unit,'(A)') ' EXAMPLE 10 '
84+
write(error_unit,'(A)') '================================='
85+
86+
write(error_unit,'(A)') ''
87+
write(error_unit,'(A)') 'Loading file: '//trim(filename)//'...'
88+
89+
call f%load_file(dir//filename)
90+
if (json_failed()) then
91+
call json_print_error_message(error_unit)
92+
error_cnt = error_cnt + 1
93+
else
94+
write(error_unit,'(A)') '...success'
95+
end if
96+
write(error_unit,'(A)') ''
97+
98+
write(error_unit,'(A)') 'json_file_move_pointer...'
99+
call f2%move(f)
100+
if (json_failed()) then
101+
call json_print_error_message(error_unit)
102+
error_cnt = error_cnt + 1
103+
else
104+
write(error_unit,'(A)') '...success'
105+
end if
106+
107+
write(error_unit,'(A)') 'json_file_load_from_string...'
108+
call f%load_from_string(json_str)
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)') '...success'
114+
end if
115+
116+
write(error_unit,'(A)') 'json_file_print_to_string...'
117+
call f%print_to_string(str)
118+
if (json_failed()) then
119+
call json_print_error_message(error_unit)
120+
error_cnt = error_cnt + 1
121+
else
122+
write(error_unit,'(A)') '...success'
123+
end if
124+
125+
write(error_unit,'(A)') 'json_file_variable_info...'
126+
call f%info('blah',found,var_type,n_children)
127+
if (json_failed()) then
128+
call json_print_error_message(error_unit)
129+
error_cnt = error_cnt + 1
130+
else
131+
!also make sure the values are correct:
132+
if (var_type==json_integer .and. n_children==0) then
133+
write(error_unit,'(A)') '...success'
134+
else
135+
write(error_unit,'(A)') 'Error invalid values:',var_type,n_children
136+
error_cnt = error_cnt + 1
137+
end if
138+
end if
139+
140+
write(error_unit,'(A)') 'json_file_get_logical...'
141+
call f2%get('data(1).tf1',lval,found)
142+
if (json_failed()) then
143+
call json_print_error_message(error_unit)
144+
error_cnt = error_cnt + 1
145+
else
146+
!also make sure the values are correct:
147+
if (found .and. lval) then
148+
write(error_unit,'(A)') '...success'
149+
else
150+
write(error_unit,'(A)') 'Error: incorrect result.'
151+
error_cnt = error_cnt + 1
152+
end if
153+
end if
154+
155+
! json_file_get_logical_vec .... [add this]
156+
157+
write(error_unit,'(A)') 'json_file_get_string_vec...'
158+
call f2%get('files',str_vec,found)
159+
if (json_failed()) then
160+
call json_print_error_message(error_unit)
161+
error_cnt = error_cnt + 1
162+
else
163+
!also make sure the values are correct:
164+
if (found .and. size(str_vec)==5 .and. &
165+
str_vec(1)=='..\path\to\files\file1.txt') then
166+
write(error_unit,'(A)') '...success'
167+
else
168+
write(error_unit,'(A)') 'Error: incorrect result: '//trim(str_vec(1))
169+
error_cnt = error_cnt + 1
170+
end if
171+
end if
172+
173+
write(error_unit,'(A)') 'json_file_update_logical [variable present]...'
174+
call f2%update('data(1).tf1',.false.,found)
175+
if (json_failed()) then
176+
call json_print_error_message(error_unit)
177+
error_cnt = error_cnt + 1
178+
else
179+
if (found) then
180+
write(error_unit,'(A)') '...success'
181+
else
182+
write(error_unit,'(A)') 'Error: variable was not there.'
183+
error_cnt = error_cnt + 1
184+
end if
185+
end if
186+
write(error_unit,'(A)') 'json_file_update_logical [variable not present]...'
187+
call f2%update('new_logical',.true.,found)
188+
if (json_failed()) then
189+
call json_print_error_message(error_unit)
190+
error_cnt = error_cnt + 1
191+
else
192+
write(error_unit,'(A)') '...success'
193+
end if
194+
195+
write(error_unit,'(A)') 'json_file_update_real [variable present]...'
196+
call f2%update('data[2].real',100.0d0,found)
197+
if (json_failed()) then
198+
call json_print_error_message(error_unit)
199+
error_cnt = error_cnt + 1
200+
else
201+
if (found) then
202+
write(error_unit,'(A)') '...success'
203+
else
204+
write(error_unit,'(A)') 'Error: variable was not there.'
205+
error_cnt = error_cnt + 1
206+
end if
207+
end if
208+
write(error_unit,'(A)') 'json_file_update_real [variable not present]...'
209+
call f2%update('new_real',1776.0d0,found)
210+
if (json_failed()) then
211+
call json_print_error_message(error_unit)
212+
error_cnt = error_cnt + 1
213+
else
214+
write(error_unit,'(A)') '...success'
215+
end if
216+
217+
write(error_unit,'(A)') 'json_file_update_string [variable present]...'
218+
call f2%update('version.string','10.0.0',found)
219+
if (json_failed()) then
220+
call json_print_error_message(error_unit)
221+
error_cnt = error_cnt + 1
222+
else
223+
if (found) then
224+
write(error_unit,'(A)') '...success'
225+
else
226+
write(error_unit,'(A)') 'Error: variable was not there.'
227+
error_cnt = error_cnt + 1
228+
end if
229+
end if
230+
write(error_unit,'(A)') 'json_file_update_string [variable not present]...'
231+
call f2%update('new_string','foo',found)
232+
if (json_failed()) then
233+
call json_print_error_message(error_unit)
234+
error_cnt = error_cnt + 1
235+
else
236+
write(error_unit,'(A)') '...success'
237+
end if
238+
239+
!--------------------------------
240+
241+
write(error_unit,'(A)') ''
242+
write(error_unit,'(A)') 'json_file_get_integer...'
243+
call f2%get('$',p,found) !get root
244+
if (json_failed()) then
245+
call json_print_error_message(error_unit)
246+
error_cnt = error_cnt + 1
247+
else
248+
if (found) then
249+
write(error_unit,'(A)') '...success'
250+
write(error_unit,'(A)') 'json_remove_if_present...'
251+
call json_remove_if_present(p,'version.patch')
252+
if (json_failed()) then
253+
call json_print_error_message(error_unit)
254+
error_cnt = error_cnt + 1
255+
else
256+
write(error_unit,'(A)') '...success'
257+
end if
258+
else
259+
write(error_unit,'(A)') 'Error: variable was not there.'
260+
error_cnt = error_cnt + 1
261+
end if
262+
end if
263+
264+
write(error_unit,'(A)') 'json_update_logical...'
265+
call json_update(p,'data(1).tf1',.true.,found)
266+
if (json_failed()) then
267+
call json_print_error_message(error_unit)
268+
error_cnt = error_cnt + 1
269+
else
270+
if (found) then
271+
write(error_unit,'(A)') '...success'
272+
else
273+
write(error_unit,'(A)') 'Error: variable was not there.'
274+
error_cnt = error_cnt + 1
275+
end if
276+
end if
277+
278+
write(error_unit,'(A)') 'json_update_double...'
279+
call json_update(p,'data(2).real',-1.0d0,found)
280+
if (json_failed()) then
281+
call json_print_error_message(error_unit)
282+
error_cnt = error_cnt + 1
283+
else
284+
if (found) then
285+
write(error_unit,'(A)') '...success'
286+
else
287+
write(error_unit,'(A)') 'Error: variable was not there.'
288+
error_cnt = error_cnt + 1
289+
end if
290+
end if
291+
292+
write(error_unit,'(A)') 'json_get_logical...'
293+
call json_get(p,'data(1).tf1',lval,found)
294+
if (json_failed()) then
295+
call json_print_error_message(error_unit)
296+
error_cnt = error_cnt + 1
297+
else
298+
if (found) then
299+
write(error_unit,'(A)') '...success'
300+
else
301+
write(error_unit,'(A)') 'Error: variable was not there.'
302+
error_cnt = error_cnt + 1
303+
end if
304+
end if
305+
306+
write(error_unit,'(A)') 'json_get_string_vec...'
307+
call json_get(p,'files',str_vec,found)
308+
if (json_failed()) then
309+
call json_print_error_message(error_unit)
310+
error_cnt = error_cnt + 1
311+
else
312+
!also make sure the values are correct:
313+
if (found .and. size(str_vec)==5 .and. &
314+
str_vec(1)=='..\path\to\files\file1.txt') then
315+
write(error_unit,'(A)') '...success'
316+
else
317+
write(error_unit,'(A)') 'Error: incorrect result: '//trim(str_vec(1))
318+
error_cnt = error_cnt + 1
319+
end if
320+
end if
321+
322+
write(error_unit,'(A)') 'json_create...'
323+
write(error_unit,'(A)') 'json_create_logical...'; call json_destroy(p); call json_create_logical(p,.true.,'foo')
324+
write(error_unit,'(A)') 'json_create_integer...'; call json_destroy(p); call json_create_integer(p,1000,'foo')
325+
write(error_unit,'(A)') 'json_create_double ...'; call json_destroy(p); call json_create_double (p,9.0d0,'foo')
326+
write(error_unit,'(A)') 'json_create_string ...'; call json_destroy(p); call json_create_string (p,'foo','bar')
327+
write(error_unit,'(A)') 'json_create_null ...'; call json_destroy(p); call json_create_null (p,'foo')
328+
write(error_unit,'(A)') 'json_create_object ...'; call json_destroy(p); call json_create_object (p,'foo')
329+
if (json_failed()) then
330+
call json_print_error_message(error_unit)
331+
error_cnt = error_cnt + 1
332+
else
333+
write(error_unit,'(A)') '...success'
334+
end if
335+
336+
337+
!--------------------------------
338+
339+
!cleanup:
340+
call f%destroy()
341+
call f2%destroy()
342+
343+
end subroutine test_10
344+
345+
end module jf_test_10_mod
346+
347+
program jf_test_10
348+
use jf_test_10_mod , only: test_10
349+
implicit none
350+
integer :: n_errors
351+
n_errors = 0
352+
call test_10(n_errors)
353+
if (n_errors /= 0) stop 1
354+
end program jf_test_10
355+
356+
!*******************************************************************************************************

0 commit comments

Comments
 (0)