@@ -48,7 +48,7 @@ program json_test
48
48
! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
49
49
!
50
50
! *******************************************************************************************************
51
- use ,intrinsic :: iso_fortran_env, only: wp = > real64 ! double precision reals
51
+ use ,intrinsic :: iso_fortran_env, wp = > real64 ! double precision reals
52
52
53
53
use json_module
54
54
@@ -75,12 +75,78 @@ program json_test
75
75
call test_6() ! these are attempting to read invalid json files
76
76
77
77
call test_7() ! indent test
78
+
79
+ call test_8() ! read from string test
78
80
79
81
! call memory_leak_test()
80
82
81
83
contains
82
84
! *******************************************************************************************************
83
85
86
+ ! **************************************************************
87
+ subroutine test_8 ()
88
+ ! **************************************************************
89
+ !
90
+ ! read a JSON structure from a string
91
+ !
92
+ ! **************************************************************
93
+
94
+ implicit none
95
+
96
+ type (json_value),pointer :: p
97
+
98
+ character (len=* ),parameter :: str = ' { "label": "foo",' // new_line(' ' )// ' "value": "bar" }'
99
+
100
+ character (len=* ),parameter :: str2 = ' { "label": "foo",' // new_line(' ' )// &
101
+ ' "value": "bar",' // new_line(' ' )// &
102
+ ' "empty_array": [],' // new_line(' ' )// &
103
+ ' "empty_object": {}' // new_line(' ' )// &
104
+ ' }'
105
+
106
+ character (len=* ),parameter :: str_invalid = ' { "label": "foo",' // new_line(' ' )// ' "value : "bar" }'
107
+
108
+ call json_initialize()
109
+
110
+ write (* ,' (A)' ) ' '
111
+ write (* ,' (A)' ) ' ================================='
112
+ write (* ,' (A)' ) ' EXAMPLE 8 : read JSON from string'
113
+ write (* ,' (A)' ) ' ================================='
114
+ write (* ,' (A)' ) ' '
115
+
116
+ write (* ,' (A)' ) ' **************'
117
+ write (* ,' (A)' ) ' Valid test 1:'
118
+ write (* ,' (A)' ) ' **************'
119
+ write (* ,' (A)' ) ' '
120
+ call json_parse(str= str, p= p) ! read it from str
121
+ call json_print(p,OUTPUT_UNIT) ! print to console
122
+ call json_destroy(p) ! cleanup
123
+ if (json_failed()) call print_error_message()
124
+ write (* ,' (A)' ) ' '
125
+
126
+ write (* ,' (A)' ) ' **************'
127
+ write (* ,' (A)' ) ' Valid test 2:'
128
+ write (* ,' (A)' ) ' **************'
129
+ write (* ,' (A)' ) ' '
130
+ call json_parse(str= str2, p= p) ! read it from str
131
+ call json_print(p,OUTPUT_UNIT) ! print to console
132
+ call json_destroy(p) ! cleanup
133
+ if (json_failed()) call print_error_message()
134
+ write (* ,' (A)' ) ' '
135
+
136
+ write (* ,' (A)' ) ' **************'
137
+ write (* ,' (A)' ) ' Invalid test:'
138
+ write (* ,' (A)' ) ' **************'
139
+ write (* ,' (A)' ) ' '
140
+ call json_parse(str= str_invalid, p= p) ! read it from str
141
+ call json_print(p,OUTPUT_UNIT) ! print to console
142
+ call json_destroy(p) ! cleanup
143
+ if (json_failed()) call print_error_message()
144
+ write (* ,' (A)' ) ' '
145
+
146
+ ! **************************************************************
147
+ end subroutine test_8
148
+ ! **************************************************************
149
+
84
150
! **************************************************************
85
151
subroutine test_7 ()
86
152
! **************************************************************
@@ -171,9 +237,11 @@ subroutine test_7()
171
237
nullify(e2)
172
238
173
239
call json_print(root,6 ) ! print to the console
174
-
240
+
175
241
call json_destroy(root) ! cleanup
176
242
243
+ if (json_failed()) call print_error_message()
244
+
177
245
! **************************************************************
178
246
end subroutine test_7
179
247
! **************************************************************
0 commit comments