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