JSON/jf_test_10 [ 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
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
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