./src/tests/jf_test

JSON/jf_test_7 [ Unittest ]

[ Top ] [ Unittest ]

NAME

jf_test_7

DESCRIPTION

Seventh 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_7_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 contains
 57 
 58     subroutine test_7(error_cnt)
 59 
 60 !   Indent test
 61 
 62     implicit none
 63 
 64     integer,intent(out) :: error_cnt
 65 
 66     type(json_value),pointer :: root,a,b,c,do,e,e1,e2
 67 
 68     error_cnt = 0
 69     call json_initialize()
 70     if (json_failed()) then
 71         call json_print_error_message(error_unit)
 72         error_cnt = error_cnt + 1
 73     end if
 74 
 75     write(error_unit,'(A)') ''
 76     write(error_unit,'(A)') '================================='
 77     write(error_unit,'(A)') '   EXAMPLE 7 : indent test'
 78     write(error_unit,'(A)') '================================='
 79     write(error_unit,'(A)') ''
 80 
 81 !-----------------------
 82 ! jsonlint indention is
 83 !-----------------------
 84 !{
 85 !    "a": {
 86 !        "ints": [
 87 !            1,
 88 !            2,
 89 !            3
 90 !        ],
 91 !        "chars": [
 92 !            "a",
 93 !            "b",
 94 !            "c"
 95 !        ]
 96 !    },
 97 !    "b": {
 98 !        "c": {
 99 !            "val1": 1066
100 !        }
101 !    },
102 !    "d": {
103 !        "val2": 1815
104 !    },
105 !    "array": [
106 !        {
107 !            "int1": 1
108 !        },
109 !        {
110 !            "int1": 1,
111 !            "int2": 2
112 !        }
113 !    ]
114 !}
115 
116     !create a json structure:
117     call json_create_object(root,'root')
118     if (json_failed()) then
119         call json_print_error_message(error_unit)
120         error_cnt = error_cnt + 1
121     end if
122     call json_create_object(a,'a')
123     if (json_failed()) then
124         call json_print_error_message(error_unit)
125         error_cnt = error_cnt + 1
126     end if
127     call json_add(a,'ints', [1,2,3])
128     if (json_failed()) then
129         call json_print_error_message(error_unit)
130         error_cnt = error_cnt + 1
131     end if
132     call json_create_object(b,'b')
133     if (json_failed()) then
134         call json_print_error_message(error_unit)
135         error_cnt = error_cnt + 1
136     end if
137     call json_add(a,'chars', ['a','b','c'])
138     if (json_failed()) then
139         call json_print_error_message(error_unit)
140         error_cnt = error_cnt + 1
141     end if
142     call json_create_object(c,'c')
143     if (json_failed()) then
144         call json_print_error_message(error_unit)
145         error_cnt = error_cnt + 1
146     end if
147     call json_add(c,'val1', 1066)
148     if (json_failed()) then
149         call json_print_error_message(error_unit)
150         error_cnt = error_cnt + 1
151     end if
152     call json_create_object(do,'d')
153     if (json_failed()) then
154         call json_print_error_message(error_unit)
155         error_cnt = error_cnt + 1
156     end if
157     call json_add(do,'val2', 1815)
158     if (json_failed()) then
159         call json_print_error_message(error_unit)
160         error_cnt = error_cnt + 1
161     end if
162 
163     call json_create_array(e,'array')   !objects in an array
164     if (json_failed()) then
165         call json_print_error_message(error_unit)
166         error_cnt = error_cnt + 1
167     end if
168     call json_create_object(e1,'')
169     if (json_failed()) then
170         call json_print_error_message(error_unit)
171         error_cnt = error_cnt + 1
172     end if
173     call json_add(e1,'int1', 1)
174     if (json_failed()) then
175         call json_print_error_message(error_unit)
176         error_cnt = error_cnt + 1
177     end if
178     call json_create_object(e2,'')
179     if (json_failed()) then
180         call json_print_error_message(error_unit)
181         error_cnt = error_cnt + 1
182     end if
183     call json_add(e2,'int1', 1)
184     if (json_failed()) then
185         call json_print_error_message(error_unit)
186         error_cnt = error_cnt + 1
187     end if
188     call json_add(e2,'int2', 2)
189     if (json_failed()) then
190         call json_print_error_message(error_unit)
191         error_cnt = error_cnt + 1
192     end if
193     call json_add(e,e1)
194     if (json_failed()) then
195         call json_print_error_message(error_unit)
196         error_cnt = error_cnt + 1
197     end if
198     call json_add(e,e2)
199     if (json_failed()) then
200         call json_print_error_message(error_unit)
201         error_cnt = error_cnt + 1
202     end if
203 
204     call json_add(root,a)
205     if (json_failed()) then
206         call json_print_error_message(error_unit)
207         error_cnt = error_cnt + 1
208     end if
209     call json_add(root,b)
210     if (json_failed()) then
211         call json_print_error_message(error_unit)
212         error_cnt = error_cnt + 1
213     end if
214     call json_add(b,c)
215     if (json_failed()) then
216         call json_print_error_message(error_unit)
217         error_cnt = error_cnt + 1
218     end if
219     call json_add(root,do)
220     if (json_failed()) then
221         call json_print_error_message(error_unit)
222         error_cnt = error_cnt + 1
223     end if
224     call json_add(root,e)
225     if (json_failed()) then
226         call json_print_error_message(error_unit)
227         error_cnt = error_cnt + 1
228     end if
229 
230     nullify(a)  !don't need these anymore
231     nullify(b)
232     nullify(c)
233     nullify(do)
234     nullify(e)
235     nullify(e1)
236     nullify(e2)
237 
238     call json_print(root,output_unit)  !print to the console
239     if (json_failed()) then
240         call json_print_error_message(error_unit)
241         error_cnt = error_cnt + 1
242     end if
243 
244     call json_destroy(root)  !cleanup
245     if (json_failed()) then
246         call json_print_error_message(error_unit)
247         error_cnt = error_cnt + 1
248     end if
249 
250     end subroutine test_7
251 
252 end module jf_test_7_mod
253 
254 program jf_test_7
255     use jf_test_7_mod , only: test_7
256     implicit none
257     integer :: n_errors
258     n_errors = 0
259     call test_7(n_errors)
260     if (n_errors /= 0) stop 1
261 end program jf_test_7