./src/tests/jf_test

JSON/jf_test_2 [ Unittest ]

[ Top ] [ Unittest ]

NAME

jf_test_2

DESCRIPTION

Second 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_2_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/'    !working directory
 57     character(len=*),parameter :: filename2 = 'test2.json'
 58 
 59 contains
 60 
 61     subroutine test_2(error_cnt)
 62 
 63 !   Populate a JSON structure and write it to a file.
 64 
 65     implicit none
 66 
 67     integer,intent(out) :: error_cnt
 68 
 69     type(json_value),pointer    :: p, inp, traj
 70 
 71     integer :: iunit
 72 
 73     error_cnt = 0
 74     call json_initialize()
 75     if (json_failed()) then
 76         call json_print_error_message(error_unit)
 77         error_cnt = error_cnt + 1
 78     end if
 79 
 80     write(error_unit,'(A)') ''
 81     write(error_unit,'(A)') '================================='
 82     write(error_unit,'(A)') '   EXAMPLE 2'
 83     write(error_unit,'(A)') '================================='
 84     write(error_unit,'(A)') ''
 85 
 86     !root:
 87     call json_create_object(p,dir//filename2)    ! create the value and associate the pointer
 88                                                  ! add the file name as the name of the overall structure
 89     if (json_failed()) then
 90         call json_print_error_message(error_unit)
 91         error_cnt = error_cnt + 1
 92     end if
 93 
 94     write(error_unit,'(A)') ''
 95     write(error_unit,'(A)') 'initialize the structure...'
 96 
 97     !config structure:
 98     call json_create_object(inp,'inputs')   !an object
 99     if (json_failed()) then
100         call json_print_error_message(error_unit)
101         error_cnt = error_cnt + 1
102     end if
103     call json_add(p, inp)
104     if (json_failed()) then
105         call json_print_error_message(error_unit)
106         error_cnt = error_cnt + 1
107     end if
108 
109     !trajectory structure:
110     call json_create_array(traj,'trajectory')    !an array
111     if (json_failed()) then
112         call json_print_error_message(error_unit)
113         error_cnt = error_cnt + 1
114     end if
115     call json_add(p, traj)
116     if (json_failed()) then
117         call json_print_error_message(error_unit)
118         error_cnt = error_cnt + 1
119     end if
120 
121     write(error_unit,'(A)') ''
122     write(error_unit,'(A)') 'adding some data to structure...'
123 
124     !add some variables:
125 
126     !input variables:
127     call json_add(inp, 't0', 0.1_wp)
128     if (json_failed()) then
129         call json_print_error_message(error_unit)
130         error_cnt = error_cnt + 1
131     end if
132     call json_add(inp, 'tf', 1.1_wp)
133     if (json_failed()) then
134         call json_print_error_message(error_unit)
135         error_cnt = error_cnt + 1
136     end if
137     call json_add(inp, 'x0', 9999.000_wp)
138     if (json_failed()) then
139         call json_print_error_message(error_unit)
140         error_cnt = error_cnt + 1
141     end if
142     call json_add(inp, 'integer_scalar', 1)
143     if (json_failed()) then
144         call json_print_error_message(error_unit)
145         error_cnt = error_cnt + 1
146     end if
147     call json_add(inp, 'integer_array', [2,4,99])
148     if (json_failed()) then
149         call json_print_error_message(error_unit)
150         error_cnt = error_cnt + 1
151     end if
152     call json_add(inp, 'names', ['aaa','bbb','ccc'])
153     if (json_failed()) then
154         call json_print_error_message(error_unit)
155         error_cnt = error_cnt + 1
156     end if
157     call json_add(inp, 'logical_scalar', .true.)
158     if (json_failed()) then
159         call json_print_error_message(error_unit)
160         error_cnt = error_cnt + 1
161     end if
162     call json_add(inp, 'logical_vector', [.true., .false., .true.])
163     if (json_failed()) then
164         call json_print_error_message(error_unit)
165         error_cnt = error_cnt + 1
166     end if
167     nullify(inp)
168 
169     !trajectory variables:
170     call add_variables_to_input(traj, 'Rx', 'km', 'J2000', 'EARTH', [1.0_wp, 2.0_wp, 3.0_wp], error_cnt )
171     call add_variables_to_input(traj, 'Ry', 'km', 'J2000', 'EARTH', [10.0_wp, 20.0_wp, 30.0_wp], error_cnt )
172     call add_variables_to_input(traj, 'Rz', 'km', 'J2000', 'EARTH', [100.0_wp, 200.0d0, 300.0_wp], error_cnt )
173     call add_variables_to_input(traj, 'Vx', 'km/s', 'J2000', 'EARTH', [1.0e-3_wp, 2.0e-3_wp, 3.0e-3_wp], error_cnt )
174     call add_variables_to_input(traj, 'Vy', 'km/s', 'J2000', 'EARTH', [2.0e-3_wp, 20.0e-3_wp, 3.0e-3_wp], error_cnt )
175     call add_variables_to_input(traj, 'Vz', 'km/s', 'J2000', 'EARTH', [3.0e-3_wp, 30.0e-3_wp, 40.0e-3_wp], error_cnt )
176     nullify(traj)
177 
178     write(error_unit,'(A)') ''
179     write(error_unit,'(A)') 'writing file '//trim(dir//filename2)//'...'
180 
181     open(newunit=iunit, file=dir//filename2, status='REPLACE')
182     call json_print(p,iunit)
183     if (json_failed()) then
184         call json_print_error_message(error_unit)
185         error_cnt = error_cnt + 1
186     end if
187     close(iunit)
188 
189     !cleanup:
190     call json_destroy(p)
191     if (json_failed()) then
192         call json_print_error_message(error_unit)
193         error_cnt = error_cnt + 1
194     end if
195 
196     write(error_unit,'(A)') ''
197 
198     end subroutine test_2
199 
200     subroutine add_variables_to_input(me, variable, units, frame, center, rdata, error_cnt)
201     !Used by test_2.
202 
203     implicit none
204 
205     type(json_value),pointer :: me
206     character(len=*),intent(in) :: variable, units, frame, center
207     real(wp),dimension(:),intent(in) :: rdata
208     integer, intent(inout) :: error_cnt
209 
210     type(json_value),pointer :: var        !a variable in the trajectory:
211 
212     !initialize:
213     nullify(var)
214 
215     !create the object before data can be added:
216     call json_create_object(var,'')    !name does not matter
217     if (json_failed()) then
218         call json_print_error_message(error_unit)
219         error_cnt = error_cnt + 1
220     end if
221 
222     !variable info:
223     call json_add(var, 'VARIABLE',trim(variable))
224     if (json_failed()) then
225         call json_print_error_message(error_unit)
226         error_cnt = error_cnt + 1
227     end if
228     call json_add(var, 'UNITS', trim(units))
229     if (json_failed()) then
230         call json_print_error_message(error_unit)
231         error_cnt = error_cnt + 1
232     end if
233     call json_add(var, 'FRAME', trim(frame))
234     if (json_failed()) then
235         call json_print_error_message(error_unit)
236         error_cnt = error_cnt + 1
237     end if
238     call json_add(var, 'CENTER', trim(center))
239     if (json_failed()) then
240         call json_print_error_message(error_unit)
241         error_cnt = error_cnt + 1
242     end if
243 
244     !trajectory [vector of reals]:
245     call json_add(var, 'DATA', rdata)
246     if (json_failed()) then
247         call json_print_error_message(error_unit)
248         error_cnt = error_cnt + 1
249     end if
250 
251     !add this variable to trajectory structure:
252     call json_add(me, var)
253     if (json_failed()) then
254         call json_print_error_message(error_unit)
255         error_cnt = error_cnt + 1
256     end if
257 
258     !cleanup:
259     nullify(var)
260 
261     end subroutine add_variables_to_input
262 
263 end module jf_test_2_mod
264 
265 program jf_test_2
266     use jf_test_2_mod , only: test_2
267     implicit none
268     integer :: n_errors
269     n_errors = 0
270     call test_2(n_errors)
271     if (n_errors /= 0) stop 1
272 end program jf_test_2