./src/tests/jf_test

JSON/jf_test_4 [ Unittest ]

[ Top ] [ 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

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