Skip to content

Commit 1c0f8d5

Browse files
jacobwilliamsjacobwilliams
committed
added new unit tests with some of the uncovered routines [not finished]
1 parent fb3b0ee commit 1c0f8d5

File tree

1 file changed

+259
-0
lines changed

1 file changed

+259
-0
lines changed

‎src/tests/jf_test_10.f90

Lines changed: 259 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,259 @@
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+
type(json_file) :: f,f2
66+
type(json_value),pointer :: p
67+
character(len=:),allocatable :: str
68+
logical :: found,lval
69+
integer :: var_type,n_children
70+
character(len=256),dimension(:),allocatable :: str_vec
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+
242+
!cleanup:
243+
call f%destroy()
244+
call f2%destroy()
245+
246+
end subroutine test_10
247+
248+
end module jf_test_10_mod
249+
250+
program jf_test_10
251+
use jf_test_10_mod , only: test_10
252+
implicit none
253+
integer :: n_errors
254+
n_errors = 0
255+
call test_10(n_errors)
256+
if (n_errors /= 0) stop 1
257+
end program jf_test_10
258+
259+
!*******************************************************************************************************

0 commit comments

Comments
 (0)