./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             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()   !WARNING: causing "pointer being freed was not allocated" errors.... need to investigate
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