JSON/jf_test_4 [ Unittest ]
NAME
jf_test_4
DESCRIPTION
Fourth 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_4_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 :: filename4 = 'test4.json' 60 61 contains 62 63 64 subroutine test_4(error_cnt) 65 66 ! Populate a JSON structure, write it to a file, 67 ! then read it. 68 ! 69 ! Also tests the json_value_to_string routine to write 70 ! the file to a character string. 71 72 implicit none 73 74 integer,intent(out) :: error_cnt 75 type(json_value),pointer :: p,inp 76 type(json_file) :: json 77 78 integer :: i 79 character(len=10) :: istr 80 character(len=:),allocatable :: string 81 82 error_cnt = 0 83 call json_initialize() 84 if (json_failed()) then 85 call json_print_error_message(error_unit) 86 error_cnt = error_cnt + 1 87 end if 88 89 write(error_unit,'(A)') '' 90 write(error_unit,'(A)') '=================================' 91 write(error_unit,'(A)') ' EXAMPLE 4' 92 write(error_unit,'(A)') '=================================' 93 write(error_unit,'(A)') '' 94 95 write(error_unit,'(A)') '' 96 write(error_unit,'(A)') 'creating structure' 97 98 call json_create_object(p,dir//filename4) !create the value and associate the pointer 99 !add the file name as the name of the overall structure 100 if (json_failed()) then 101 call json_print_error_message(error_unit) 102 error_cnt = error_cnt + 1 103 end if 104 105 !config structure: 106 call json_create_object(inp,'INPUTS') !an object 107 if (json_failed()) then 108 call json_print_error_message(error_unit) 109 error_cnt = error_cnt + 1 110 end if 111 !add just integers: 112 do i=1,100 113 write(istr,fmt='(I10)') i 114 istr = adjustl(istr) 115 call json_add(inp, 'x'//trim(istr),i) 116 if (json_failed()) then 117 call json_print_error_message(error_unit) 118 error_cnt = error_cnt + 1 119 end if 120 end do 121 call json_add(p, inp) 122 if (json_failed()) then 123 call json_print_error_message(error_unit) 124 error_cnt = error_cnt + 1 125 end if 126 nullify(inp) 127 128 write(error_unit,'(A)') '' 129 write(error_unit,'(A)') 'write to file' 130 131 !write the file: 132 call json_print(p,trim(dir//filename4)) 133 if (json_failed()) then 134 call json_print_error_message(error_unit) 135 error_cnt = error_cnt + 1 136 end if 137 138 write(error_unit,'(A)') '' 139 write(error_unit,'(A)') 'write to string' 140 write(error_unit,'(A)') '' 141 !write it to a string, and print to console: 142 call json_print_to_string(p, string) 143 if (json_failed()) then 144 call json_print_error_message(error_unit) 145 error_cnt = error_cnt + 1 146 end if 147 write(output_unit,'(A)') string 148 deallocate(string) !cleanup 149 150 !cleanup: 151 call json_destroy(p) 152 if (json_failed()) then 153 call json_print_error_message(error_unit) 154 error_cnt = error_cnt + 1 155 end if 156 157 write(error_unit,'(A)') '' 158 write(error_unit,'(A)') 'read file' 159 160 call json%load_file(filename = dir//filename4) 161 if (json_failed()) then 162 call json_print_error_message(error_unit) 163 error_cnt = error_cnt + 1 164 end if 165 166 write(error_unit,'(A)') '' 167 write(error_unit,'(A)') 'cleanup' 168 call json%destroy() 169 if (json_failed()) then 170 call json_print_error_message(error_unit) 171 error_cnt = error_cnt + 1 172 end if 173 174 end subroutine test_4 175 176 end module jf_test_4_mod 177 178 program jf_test_4 179 use jf_test_4_mod , only: test_4 180 implicit none 181 integer :: n_errors 182 n_errors = 0 183 call test_4(n_errors) 184 if (n_errors /= 0) stop 1 185 end program jf_test_4