./src/tests/jf_test

JSON/jf_test_1 [ Unittest ]

[ Top ] [ Unittest ]

NAME

jf_test_1

DESCRIPTION

First unit test

USES

json_module iso_fortran_env (intrinsic)

HISTORY

Izaak Beekman : 2/18/2015 : Created (refactoried original json_example.f90 file)

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

 49 module jf_test_1_mod
 50 
 51     use json_module
 52     use, intrinsic :: iso_fortran_env , only: error_unit, output_unit, wp => real64
 53 
 54     implicit none
 55 
 56     character(len=*),parameter :: dir = '../files/inputs/'    !working directory
 57     character(len=*),parameter :: filename1 = 'test1.json'
 58 
 59 contains
 60 
 61     subroutine test_1(error_cnt)
 62 
 63 !   Read a sample JSON file and retrieve some data from it
 64 
 65     implicit none
 66 
 67     integer,intent(out) :: error_cnt
 68     type(json_file) :: json    !the JSON structure read from the file:
 69     integer :: ival
 70     character(kind=CK,len=:),allocatable :: cval
 71     real(wp) :: rval
 72     logical :: found
 73     type(json_value),pointer :: p
 74 
 75     error_cnt = 0
 76     call json_initialize()
 77     if (json_failed()) then
 78       call json_print_error_message(error_unit)
 79       error_cnt = error_cnt + 1
 80     end if
 81 
 82     write(error_unit,'(A)') ''
 83     write(error_unit,'(A)') '================================='
 84     write(error_unit,'(A)') '   TEST 1'
 85     write(error_unit,'(A)') '================================='
 86     write(error_unit,'(A)') ''
 87 
 88     ! parse the json file:
 89     write(error_unit,'(A)') ''
 90     write(error_unit,'(A)') 'parsing file '//dir//filename1
 91 
 92     call json%load_file(filename = dir//filename1)
 93 
 94     if (json_failed()) then    !if there was an error reading the file
 95 
 96       call json_print_error_message(error_unit)
 97       error_cnt = error_cnt + 1
 98 
 99     else
100 
101       ! print the parsed data to the console
102       write(error_unit,'(A)') ''
103       write(error_unit,'(A)') 'printing the file...'
104       write(output_unit,'(A)') '{ "part a" :' !Wrap 3 outputs to make stdout valid json
105       call json%print_file()
106       if (json_failed()) then
107         call json_print_error_message(error_unit)
108         error_cnt = error_cnt + 1
109       end if
110 
111       ! extract data from the parsed value
112       write(error_unit,'(A)') ''
113       write(error_unit,'(A)') 'get some data from the file...'
114 
115       write(error_unit,'(A)') ''
116       call json%get('version.svn', ival)
117       if (json_failed()) then
118         call json_print_error_message(error_unit)
119         error_cnt = error_cnt + 1
120       else
121         write(error_unit,'(A,I5)') 'version.svn = ',ival
122       end if
123 
124       write(error_unit,'(A)') ''
125       call json%get('data(1).array(2)', cval)
126       if (json_failed()) then
127         call json_print_error_message(error_unit)
128         error_cnt = error_cnt + 1
129       else
130         write(error_unit,'(A)') 'data(1).array(2) = '//trim(cval)
131       end if
132 
133       write(error_unit,'(A)') ''
134       call json%get('files(1)', cval)
135       if (json_failed()) then
136         call json_print_error_message(error_unit)
137         error_cnt = error_cnt + 1
138       else
139         write(error_unit,'(A)') 'files(1) = '//trim(cval)
140       end if
141 
142       write(error_unit,'(A)') ''
143       call json%get('files(2)', cval)
144       if (json_failed()) then
145         call json_print_error_message(error_unit)
146         error_cnt = error_cnt + 1
147       else
148         write(error_unit,'(A)') 'files(2) = '//trim(cval)
149       end if
150 
151       write(error_unit,'(A)') ''
152       call json%get('files(3)', cval)
153       if (json_failed()) then
154         call json_print_error_message(error_unit)
155         error_cnt = error_cnt + 1
156       else
157         write(error_unit,'(A)') 'files(3) = '//trim(cval)
158       end if
159 
160       write(error_unit,'(A)') ''
161       call json%get('data(2).real', rval)
162       if (json_failed()) then
163         call json_print_error_message(error_unit)
164         error_cnt = error_cnt + 1
165       else
166         write(error_unit,'(A,E30.16)') 'data(2).real = ',rval
167       end if
168 
169       write(error_unit,'(A)') ''
170       call json%get('files[4]', cval)      !has hex characters
171       if (json_failed()) then
172         call json_print_error_message(error_unit)
173         error_cnt = error_cnt + 1
174       else
175         write(error_unit,'(A)') 'files[4] = '//trim(cval)
176       end if
177 
178       write(error_unit,'(A)') ''
179       call json%get('files[5]', cval)      !string with spaces and no escape characters
180       if (json_failed()) then
181         call json_print_error_message(error_unit)
182         error_cnt = error_cnt + 1
183       else
184         write(error_unit,'(A)') 'files[5] = '//trim(cval)
185       end if
186 
187       !
188       ! Test of values that aren't there:
189       ! Note: when using the "found" output, the exceptions are cleared automatically.
190       !
191 
192       write(error_unit,'(A)') ''
193       call json%get('files[10]', cval, found)      !value that isn't there
194       if (.not. found) then
195         write(error_unit,'(A)') 'files[10] not in file.'
196       else
197         write(error_unit,'(1x,A)') 'files[10] = '//trim(cval)
198         error_cnt = error_cnt + 1
199       end if
200 
201       write(error_unit,'(A)') ''
202       call json%get('version.blah', ival, found)      !value that isn't there
203       if (.not. found) then
204         write(error_unit,'(A)') 'version.blah not in file.'
205       else
206         write(error_unit,'(A)') 'version.blah = ',ival
207         error_cnt = error_cnt + 1
208       end if
209 
210       write(error_unit,'(A)') ''
211       write(error_unit,'(A)') ' Test removing data from the json structure:'
212 
213       call json%get('files', p)         !in the middle of a list
214       call json_remove(p)
215       if (json_failed()) then
216         call json_print_error_message(error_unit)
217         error_cnt = error_cnt + 1
218       end if
219 
220       call json%get('data(1).array', p)   !at the end of a list
221       call json_remove(p)
222       if (json_failed()) then
223         call json_print_error_message(error_unit)
224         error_cnt = error_cnt + 1
225       end if
226 
227       call json%get('data(2).number', p)  !at the beginning of a list
228       call json_remove(p)
229       if (json_failed()) then
230         call json_print_error_message(error_unit)
231         error_cnt = error_cnt + 1
232       end if
233 
234       write(error_unit,'(A)') ''
235       write(error_unit,'(A)') 'printing the modified structure...'
236       write(output_unit,'(A)') ', "part b" : '
237       call json%print_file()
238       if (json_failed()) then
239         call json_print_error_message(error_unit)
240         error_cnt = error_cnt + 1
241       end if
242 
243       write(error_unit,'(A)') ''
244       write(error_unit,'(A)') ' Test replacing data from the json structure:'
245 
246       call json%get('data(1)', p)
247       call json_update(p,'name','Cuthbert',found)
248       if (json_failed()) then
249         call json_print_error_message(error_unit)
250         error_cnt = error_cnt + 1
251       end if
252 
253       !call json%get('data(2)', p)
254       !call json_update(p,'real',[1.0_wp, 2.0_wp, 3.0_wp],found)   !don't have one like this yet...
255 
256       !use the json_file procedure to update a variable:
257       call json%update('version.svn',999,found)
258       if (json_failed()) then
259         call json_print_error_message(error_unit)
260         error_cnt = error_cnt + 1
261       end if
262 
263       write(error_unit,'(A)') ''
264       write(error_unit,'(A)') 'printing the modified structure...'
265       write(output_unit,'(A)') ', "part c" : '
266       call json%print_file()
267       write(output_unit,'(A)') '}'
268       if (json_failed()) then
269         call json_print_error_message(error_unit)
270         error_cnt = error_cnt + 1
271       end if
272 
273     end if
274 
275     ! clean up
276     write(error_unit,'(A)') ''
277     write(error_unit,'(A)') 'destroy...'
278     call json%destroy()
279     if (json_failed()) then
280       call json_print_error_message(error_unit)
281       error_cnt = error_cnt + 1
282     end if
283 
284     end subroutine test_1
285 
286 end module jf_test_1_mod
287 
288 program jf_test_1
289     use jf_test_1_mod , only: test_1
290     implicit none
291     integer :: n_errors
292     n_errors = 0
293     call test_1(n_errors)
294     if (n_errors /= 0) stop 1
295 end program jf_test_1