./src/tests/jf_test

JSON/jf_test_10 [ Unittest ]

[ Top ] [ Unittest ]

NAME

jf_test_10

DESCRIPTION

Tenth unit test.

AUTHOR

Jacob Williams : 3/10/3015

LICENSE

JSON-FORTRAN: A Fortran 2008 JSON API

https://github.com/jacobwilliams/json-fortran

Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
The names of its contributors may not be used to endorse or promote products derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

SOURCE

 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/inputs/' !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(kind=CK,len=256),dimension(:),allocatable :: str_vec
 66     type(json_file) :: f,f2
 67     type(json_value),pointer :: p
 68     character(kind=CK,len=:),allocatable :: str
 69     logical :: found,lval
 70     integer :: var_type,n_children
 71 
 72     character(kind=CDK,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 
251             write(error_unit,'(A)') 'json_info...'
252             call json_info(p,var_type,n_children)
253             if (json_failed()) then
254                 call json_print_error_message(error_unit)
255                 error_cnt = error_cnt + 1
256             else
257                 write(error_unit,'(A)') '...success'
258             end if
259 
260             write(error_unit,'(A)') 'json_remove_if_present...'
261             call json_remove_if_present(p,'version.patch')
262             if (json_failed()) then
263                 call json_print_error_message(error_unit)
264                 error_cnt = error_cnt + 1
265             else
266                 write(error_unit,'(A)') '...success'
267             end if
268         else
269             write(error_unit,'(A)') 'Error: variable was not there.'
270             error_cnt = error_cnt + 1
271         end if
272     end if
273 
274     write(error_unit,'(A)') 'json_update_logical...'
275     call json_update(p,'data(1).tf1',.true.,found)
276     if (json_failed()) then
277         call json_print_error_message(error_unit)
278         error_cnt = error_cnt + 1
279     else
280         if (found) then
281             write(error_unit,'(A)') '...success'
282         else
283             write(error_unit,'(A)') 'Error: variable was not there.'
284             error_cnt = error_cnt + 1
285         end if
286     end if
287 
288     write(error_unit,'(A)') 'json_update_double...'
289     call json_update(p,'data(2).real',-1.0d0,found)
290     if (json_failed()) then
291         call json_print_error_message(error_unit)
292         error_cnt = error_cnt + 1
293     else
294         if (found) then
295             write(error_unit,'(A)') '...success'
296         else
297             write(error_unit,'(A)') 'Error: variable was not there.'
298             error_cnt = error_cnt + 1
299         end if
300     end if
301 
302     write(error_unit,'(A)') 'json_get_logical...'
303     call json_get(p,'data(1).tf1',lval,found)
304     if (json_failed()) then
305         call json_print_error_message(error_unit)
306         error_cnt = error_cnt + 1
307     else
308         if (found) then
309             write(error_unit,'(A)') '...success'
310         else
311             write(error_unit,'(A)') 'Error: variable was not there.'
312             error_cnt = error_cnt + 1
313         end if
314     end if
315 
316     write(error_unit,'(A)') 'json_get_string_vec...'
317     call json_get(p,'files',str_vec,found)
318     if (json_failed()) then
319         call json_print_error_message(error_unit)
320         error_cnt = error_cnt + 1
321     else
322         !also make sure the values are correct:
323         if (found .and. size(str_vec)==5 .and. &
324             str_vec(1)=='..\path\to\files\file1.txt') then
325             write(error_unit,'(A)') '...success'
326         else
327             write(error_unit,'(A)') 'Error: incorrect result: '//trim(str_vec(1))
328             error_cnt = error_cnt + 1
329         end if
330     end if
331 
332     write(error_unit,'(A)') 'json_create...'
333     write(error_unit,'(A)') 'json_create_logical...'; call json_destroy(p); call json_create_logical(p,.true.,'foo')
334     write(error_unit,'(A)') 'json_create_integer...'; call json_destroy(p); call json_create_integer(p,1000,'foo')
335     write(error_unit,'(A)') 'json_create_double ...'; call json_destroy(p); call json_create_double (p,9.0d0,'foo')
336     write(error_unit,'(A)') 'json_create_string ...'; call json_destroy(p); call json_create_string (p,'foo','bar')
337     write(error_unit,'(A)') 'json_create_null   ...'; call json_destroy(p); call json_create_null   (p,'foo')
338     write(error_unit,'(A)') 'json_create_object ...'; call json_destroy(p); call json_create_object (p,'foo')
339     if (json_failed()) then
340         call json_print_error_message(error_unit)
341         error_cnt = error_cnt + 1
342     else
343         write(error_unit,'(A)') '...success'
344     end if
345 
346 
347     !--------------------------------
348 
349     !cleanup:
350     !call f%destroy()   !WARNING: causing "pointer being freed was not allocated" errors.... need to investigate
351     !call f2%destroy()
352 
353     end subroutine test_10
354 
355 end module jf_test_10_mod
356 
357 program jf_test_10
358     use jf_test_10_mod , only: test_10
359     implicit none
360     integer :: n_errors
361     n_errors = 0
362     call test_10(n_errors)
363     if (n_errors /= 0) stop 1
364 end program jf_test_10