17
17
! LICENSE
18
18
!
19
19
! JSON-FORTRAN: A Fortran 2008 JSON API
20
+ !
20
21
! https://github.com/jacobwilliams/json-fortran
21
22
!
22
23
! Copyright (c) 2014, Jacob Williams
24
+ !
23
25
! All rights reserved.
24
26
!
25
27
! Redistribution and use in source and binary forms, with or without modification,
26
28
! are permitted provided that the following conditions are met:
27
- !
28
29
! * Redistributions of source code must retain the above copyright notice, this
29
30
! list of conditions and the following disclaimer.
30
- !
31
31
! * Redistributions in binary form must reproduce the above copyright notice, this
32
32
! list of conditions and the following disclaimer in the documentation and/or
33
33
! other materials provided with the distribution.
34
- !
35
34
! * The names of its contributors may not be used to endorse or promote products
36
35
! derived from this software without specific prior written permission.
37
- !
38
36
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
39
37
! ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
40
38
! WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
@@ -77,8 +75,8 @@ subroutine test_1(error_cnt)
77
75
error_cnt = 0
78
76
call json_initialize()
79
77
if (json_failed()) then
80
- call json_print_error_message(error_unit)
81
- error_cnt = error_cnt + 1
78
+ call json_print_error_message(error_unit)
79
+ error_cnt = error_cnt + 1
82
80
end if
83
81
84
82
write (error_unit,' (A)' ) ' '
@@ -95,178 +93,178 @@ subroutine test_1(error_cnt)
95
93
96
94
if (json_failed()) then ! if there was an error reading the file
97
95
96
+ call json_print_error_message(error_unit)
97
+ error_cnt = error_cnt + 1
98
+
99
+ else
100
+
101
+ ! print the parsed data to the console
102
+ write (error_unit,' (A)' ) ' '
103
+ write (error_unit,' (A)' ) ' printing the file...'
104
+ call json% print_file()
105
+ if (json_failed()) then
98
106
call json_print_error_message(error_unit)
99
107
error_cnt = error_cnt + 1
108
+ end if
100
109
101
- else
110
+ ! extract data from the parsed value
111
+ write (error_unit,' (A)' ) ' '
112
+ write (error_unit,' (A)' ) ' get some data from the file...'
113
+
114
+ write (error_unit,' (A)' ) ' '
115
+ call json% get(' version.svn' , ival)
116
+ if (json_failed()) then
117
+ call json_print_error_message(error_unit)
118
+ error_cnt = error_cnt + 1
119
+ else
120
+ write (error_unit,' (A,I5)' ) ' version.svn = ' ,ival
121
+ end if
122
+
123
+ write (error_unit,' (A)' ) ' '
124
+ call json% get(' data(1).array(2)' , cval)
125
+ if (json_failed()) then
126
+ call json_print_error_message(error_unit)
127
+ error_cnt = error_cnt + 1
128
+ else
129
+ write (error_unit,' (A)' ) ' data(1).array(2) = ' // trim (cval)
130
+ end if
131
+
132
+ write (error_unit,' (A)' ) ' '
133
+ call json% get(' files(1)' , cval)
134
+ if (json_failed()) then
135
+ call json_print_error_message(error_unit)
136
+ error_cnt = error_cnt + 1
137
+ else
138
+ write (error_unit,' (A)' ) ' files(1) = ' // trim (cval)
139
+ end if
140
+
141
+ write (error_unit,' (A)' ) ' '
142
+ call json% get(' files(2)' , cval)
143
+ if (json_failed()) then
144
+ call json_print_error_message(error_unit)
145
+ error_cnt = error_cnt + 1
146
+ else
147
+ write (error_unit,' (A)' ) ' files(2) = ' // trim (cval)
148
+ end if
102
149
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
150
+ write (error_unit,' (A)' ) ' '
151
+ call json% get(' files(3)' , cval)
152
+ if (json_failed()) then
153
+ call json_print_error_message(error_unit)
154
+ error_cnt = error_cnt + 1
155
+ else
156
+ write (error_unit,' (A)' ) ' files(3) = ' // trim (cval)
157
+ end if
158
+
159
+ write (error_unit,' (A)' ) ' '
160
+ call json% get(' data(2).real' , rval)
161
+ if (json_failed()) then
162
+ call json_print_error_message(error_unit)
163
+ error_cnt = error_cnt + 1
164
+ else
165
+ write (error_unit,' (A,E30.16)' ) ' data(2).real = ' ,rval
166
+ end if
167
+
168
+ write (error_unit,' (A)' ) ' '
169
+ call json% get(' files[4]' , cval) ! has hex characters
170
+ if (json_failed()) then
171
+ call json_print_error_message(error_unit)
172
+ error_cnt = error_cnt + 1
173
+ else
174
+ write (error_unit,' (A)' ) ' files[4] = ' // trim (cval)
175
+ end if
176
+
177
+ write (error_unit,' (A)' ) ' '
178
+ call json% get(' files[5]' , cval) ! string with spaces and no escape characters
179
+ if (json_failed()) then
180
+ call json_print_error_message(error_unit)
181
+ error_cnt = error_cnt + 1
182
+ else
183
+ write (error_unit,' (A)' ) ' files[5] = ' // trim (cval)
184
+ end if
185
+
186
+ !
187
+ ! Test of values that aren't there:
188
+ ! Note: when using the "found" output, the exceptions are cleared automatically.
189
+ !
190
+
191
+ write (error_unit,' (A)' ) ' '
192
+ call json% get(' files[10]' , cval, found) ! value that isn't there
193
+ if (.not. found) then
194
+ write (error_unit,' (A)' ) ' files[10] not in file.'
195
+ else
196
+ write (error_unit,' (1x,A)' ) ' files[10] = ' // trim (cval)
197
+ error_cnt = error_cnt + 1
198
+ end if
199
+
200
+ write (error_unit,' (A)' ) ' '
201
+ call json% get(' version.blah' , ival, found) ! value that isn't there
202
+ if (.not. found) then
203
+ write (error_unit,' (A)' ) ' version.blah not in file.'
204
+ else
205
+ write (error_unit,' (A)' ) ' version.blah = ' ,ival
206
+ error_cnt = error_cnt + 1
207
+ end if
208
+
209
+ write (error_unit,' (A)' ) ' '
210
+ write (error_unit,' (A)' ) ' Test removing data from the json structure:'
211
+
212
+ call json% get(' files' , p) ! in the middle of a list
213
+ call json_remove(p)
214
+ if (json_failed()) then
215
+ call json_print_error_message(error_unit)
216
+ error_cnt = error_cnt + 1
217
+ end if
218
+
219
+ call json% get(' data(1).array' , p) ! at the end of a list
220
+ call json_remove(p)
221
+ if (json_failed()) then
222
+ call json_print_error_message(error_unit)
223
+ error_cnt = error_cnt + 1
224
+ end if
225
+
226
+ call json% get(' data(2).number' , p) ! at the beginning of a list
227
+ call json_remove(p)
228
+ if (json_failed()) then
229
+ call json_print_error_message(error_unit)
230
+ error_cnt = error_cnt + 1
231
+ end if
232
+
233
+ write (error_unit,' (A)' ) ' '
234
+ write (error_unit,' (A)' ) ' printing the modified structure...'
235
+ call json% print_file()
236
+ if (json_failed()) then
237
+ call json_print_error_message(error_unit)
238
+ error_cnt = error_cnt + 1
239
+ end if
240
+
241
+ write (error_unit,' (A)' ) ' '
242
+ write (error_unit,' (A)' ) ' Test replacing data from the json structure:'
243
+
244
+ call json% get(' data(1)' , p)
245
+ call json_update(p,' name' ,' Cuthbert' ,found)
246
+ if (json_failed()) then
247
+ call json_print_error_message(error_unit)
248
+ error_cnt = error_cnt + 1
249
+ end if
250
+
251
+ ! call json%get('data(2)', p)
252
+ ! call json_update(p,'real',[1.0_wp, 2.0_wp, 3.0_wp],found) !don't have one like this yet...
253
+
254
+ ! use the json_file procedure to update a variable:
255
+ call json% update(' version.svn' ,999 ,found)
256
+ if (json_failed()) then
257
+ call json_print_error_message(error_unit)
258
+ error_cnt = error_cnt + 1
259
+ end if
260
+
261
+ write (error_unit,' (A)' ) ' '
262
+ write (error_unit,' (A)' ) ' printing the modified structure...'
263
+ call json% print_file()
264
+ if (json_failed()) then
265
+ call json_print_error_message(error_unit)
266
+ error_cnt = error_cnt + 1
267
+ end if
270
268
271
269
end if
272
270
@@ -275,8 +273,8 @@ subroutine test_1(error_cnt)
275
273
write (error_unit,' (A)' ) ' destroy...'
276
274
call json% destroy()
277
275
if (json_failed()) then
278
- call json_print_error_message(error_unit)
279
- error_cnt = error_cnt + 1
276
+ call json_print_error_message(error_unit)
277
+ error_cnt = error_cnt + 1
280
278
end if
281
279
282
280
end subroutine test_1
0 commit comments