JSON/jf_test_1 [ 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
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_1_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 :: filename1 = 'test1.json' 60 61 contains 62 63 subroutine test_1(error_cnt) 64 65 ! Read a sample JSON file and retrieve some data from it 66 67 implicit none 68 69 integer,intent(out) :: error_cnt 70 type(json_file) :: json !the JSON structure read from the file: 71 integer :: ival 72 character(len=:),allocatable :: cval 73 real(wp) :: rval 74 logical :: found 75 type(json_value),pointer :: p 76 77 error_cnt = 0 78 call json_initialize() 79 if (json_failed()) then 80 call json_print_error_message(error_unit) 81 error_cnt = error_cnt + 1 82 end if 83 84 write(error_unit,'(A)') '' 85 write(error_unit,'(A)') '=================================' 86 write(error_unit,'(A)') ' TEST 1' 87 write(error_unit,'(A)') '=================================' 88 write(error_unit,'(A)') '' 89 90 ! parse the json file: 91 write(error_unit,'(A)') '' 92 write(error_unit,'(A)') 'parsing file '//dir//filename1 93 94 call json%load_file(filename = dir//filename1) 95 96 if (json_failed()) then !if there was an error reading the file 97 98 call json_print_error_message(error_unit) 99 error_cnt = error_cnt + 1 100 101 else 102 103 ! print the parsed data to the console 104 write(error_unit,'(A)') '' 105 write(error_unit,'(A)') 'printing the file...' 106 call json%print_file() 107 if (json_failed()) then 108 call json_print_error_message(error_unit) 109 error_cnt = error_cnt + 1 110 end if 111 112 ! extract data from the parsed value 113 write(error_unit,'(A)') '' 114 write(error_unit,'(A)') 'get some data from the file...' 115 116 write(error_unit,'(A)') '' 117 call json%get('version.svn', ival) 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,I5)') 'version.svn = ',ival 123 end if 124 125 write(error_unit,'(A)') '' 126 call json%get('data(1).array(2)', cval) 127 if (json_failed()) then 128 call json_print_error_message(error_unit) 129 error_cnt = error_cnt + 1 130 else 131 write(error_unit,'(A)') 'data(1).array(2) = '//trim(cval) 132 end if 133 134 write(error_unit,'(A)') '' 135 call json%get('files(1)', cval) 136 if (json_failed()) then 137 call json_print_error_message(error_unit) 138 error_cnt = error_cnt + 1 139 else 140 write(error_unit,'(A)') 'files(1) = '//trim(cval) 141 end if 142 143 write(error_unit,'(A)') '' 144 call json%get('files(2)', cval) 145 if (json_failed()) then 146 call json_print_error_message(error_unit) 147 error_cnt = error_cnt + 1 148 else 149 write(error_unit,'(A)') 'files(2) = '//trim(cval) 150 end if 151 152 write(error_unit,'(A)') '' 153 call json%get('files(3)', cval) 154 if (json_failed()) then 155 call json_print_error_message(error_unit) 156 error_cnt = error_cnt + 1 157 else 158 write(error_unit,'(A)') 'files(3) = '//trim(cval) 159 end if 160 161 write(error_unit,'(A)') '' 162 call json%get('data(2).real', rval) 163 if (json_failed()) then 164 call json_print_error_message(error_unit) 165 error_cnt = error_cnt + 1 166 else 167 write(error_unit,'(A,E30.16)') 'data(2).real = ',rval 168 end if 169 170 write(error_unit,'(A)') '' 171 call json%get('files[4]', cval) !has hex characters 172 if (json_failed()) then 173 call json_print_error_message(error_unit) 174 error_cnt = error_cnt + 1 175 else 176 write(error_unit,'(A)') 'files[4] = '//trim(cval) 177 end if 178 179 write(error_unit,'(A)') '' 180 call json%get('files[5]', cval) !string with spaces and no escape characters 181 if (json_failed()) then 182 call json_print_error_message(error_unit) 183 error_cnt = error_cnt + 1 184 else 185 write(error_unit,'(A)') 'files[5] = '//trim(cval) 186 end if 187 188 ! 189 ! Test of values that aren't there: 190 ! Note: when using the "found" output, the exceptions are cleared automatically. 191 ! 192 193 write(error_unit,'(A)') '' 194 call json%get('files[10]', cval, found) !value that isn't there 195 if (.not. found) then 196 write(error_unit,'(A)') 'files[10] not in file.' 197 else 198 write(error_unit,'(1x,A)') 'files[10] = '//trim(cval) 199 error_cnt = error_cnt + 1 200 end if 201 202 write(error_unit,'(A)') '' 203 call json%get('version.blah', ival, found) !value that isn't there 204 if (.not. found) then 205 write(error_unit,'(A)') 'version.blah not in file.' 206 else 207 write(error_unit,'(A)') 'version.blah = ',ival 208 error_cnt = error_cnt + 1 209 end if 210 211 write(error_unit,'(A)') '' 212 write(error_unit,'(A)') ' Test removing data from the json structure:' 213 214 call json%get('files', p) !in the middle of a list 215 call json_remove(p) 216 if (json_failed()) then 217 call json_print_error_message(error_unit) 218 error_cnt = error_cnt + 1 219 end if 220 221 call json%get('data(1).array', p) !at the end of a list 222 call json_remove(p) 223 if (json_failed()) then 224 call json_print_error_message(error_unit) 225 error_cnt = error_cnt + 1 226 end if 227 228 call json%get('data(2).number', p) !at the beginning of a list 229 call json_remove(p) 230 if (json_failed()) then 231 call json_print_error_message(error_unit) 232 error_cnt = error_cnt + 1 233 end if 234 235 write(error_unit,'(A)') '' 236 write(error_unit,'(A)') 'printing the modified structure...' 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 call json%print_file() 266 if (json_failed()) then 267 call json_print_error_message(error_unit) 268 error_cnt = error_cnt + 1 269 end if 270 271 end if 272 273 ! clean up 274 write(error_unit,'(A)') '' 275 write(error_unit,'(A)') 'destroy...' 276 call json%destroy() 277 if (json_failed()) then 278 call json_print_error_message(error_unit) 279 error_cnt = error_cnt + 1 280 end if 281 282 end subroutine test_1 283 284 end module jf_test_1_mod 285 286 program jf_test_1 287 use jf_test_1_mod , only: test_1 288 implicit none 289 integer :: n_errors 290 n_errors = 0 291 call test_1(n_errors) 292 if (n_errors /= 0) stop 1 293 end program jf_test_1