QEMU/KVM virtual machine management via QMP
ocaml-qemu: switch test_qmp / test_qemu to Json.Error.to_string
+29
-31
+16
-19
test/test_qemu.ml
+16
-19
test/test_qemu.ml
···
11
11
module Qmp = Qemu.Qmp
12
12
13
13
let parse_json s =
14
-
match Json.Value.of_string s with Ok json -> json | Error e -> failwith e
14
+
match Json.Value.of_string s with
15
+
| Ok json -> json
16
+
| Error e -> failwith (Json.Error.to_string e)
15
17
16
18
let check_message_ok msg json =
17
19
match Qmp.Message.of_string json with
···
278
280
let cmd = Qmp.Command.make ~id:"cookie#1" "query-name" in
279
281
let json = Qmp.Command.to_json cmd in
280
282
(* Roundtrip through Command codec *)
281
-
match Json.Value.to_string json with
282
-
| Ok s -> (
283
-
match Json.of_string Qmp.Command.jsont s with
284
-
| Ok cmd' ->
285
-
(* Encode again and check it still contains our id *)
286
-
let json' = Qmp.Command.to_json cmd' in
287
-
let s' = Json.Value.to_string json' e in
288
-
(* Both serializations should match *)
289
-
Alcotest.(check string) "roundtrip" s s'
290
-
| Error e -> Alcotest.failf "decode: %s" e)
291
-
| Error e -> Alcotest.fail e
283
+
let s = Json.Value.to_string json in
284
+
match Json.of_string Qmp.Command.jsont s with
285
+
| Ok cmd' ->
286
+
(* Encode again and check it still contains our id *)
287
+
let json' = Qmp.Command.to_json cmd' in
288
+
let s' = Json.Value.to_string json' in
289
+
Alcotest.(check string) "roundtrip" s s'
290
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e)
292
291
293
292
let test_command_roundtrip () =
294
293
let cmds =
···
309
308
in
310
309
List.iter
311
310
(fun cmd ->
312
-
let json = Qmp.Command.to_json cmd in
313
-
match Json.Value.to_string json with
314
-
| Ok s -> (
315
-
match Json.of_string Qmp.Command.jsont s with
316
-
| Ok _ -> ()
317
-
| Error e -> Alcotest.failf "roundtrip decode: %s" e)
318
-
| Error e -> Alcotest.failf "roundtrip encode: %s" e)
311
+
let s = Json.Value.to_string (Qmp.Command.to_json cmd) in
312
+
match Json.of_string Qmp.Command.jsont s with
313
+
| Ok _ -> ()
314
+
| Error e ->
315
+
Alcotest.failf "roundtrip decode: %s" (Json.Error.to_string e))
319
316
cmds
320
317
321
318
(* {1 Status parsing tests} *)
+13
-12
test/test_qmp_protocol.ml
+13
-12
test/test_qmp_protocol.ml
···
18
18
module Qmp = Qemu.Qmp
19
19
20
20
let parse_json s =
21
-
match Json.Value.of_string s with Ok json -> json | Error e -> failwith e
21
+
match Json.Value.of_string s with
22
+
| Ok json -> json
23
+
| Error e -> failwith (Json.Error.to_string e)
22
24
23
25
let encode_json json = Json.Value.to_string json
24
26
25
27
(* {1 Version codec tests} *)
26
28
27
29
let test_version_make_roundtrip () =
28
-
(* make -> jsont encode -> jsont decode -> check fields *)
30
+
(* make -> json encode -> json decode -> check fields *)
29
31
let v = Qmp.Version.make 9 0 0 "v9.0.0" in
30
-
let json = Json.encode Qmp.Version.jsont v in
31
-
match json with
32
+
match Json.encode Qmp.Version.jsont v with
33
+
| Error e -> Alcotest.failf "encode: %s" (Json.Error.to_string e)
32
34
| Ok json -> (
33
35
match Json.decode Qmp.Version.jsont json with
34
36
| Ok v' ->
···
36
38
Alcotest.(check int) "minor" 0 v'.qemu.minor;
37
39
Alcotest.(check int) "micro" 0 v'.qemu.micro;
38
40
Alcotest.(check string) "package" "v9.0.0" v'.package
39
-
| Error e -> Alcotest.failf "decode: %s" e)
40
-
| Error e -> Alcotest.failf "encode: %s" e
41
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e))
41
42
42
43
let test_version_high_numbers () =
43
44
let v = Qmp.Version.make 99 12 3 "custom-build-2025" in
···
56
57
Alcotest.(check int) "minor" 2 v.qemu.minor;
57
58
Alcotest.(check int) "micro" 5 v.qemu.micro;
58
59
Alcotest.(check string) "package" "Debian 1:7.2+dfsg-7" v.package
59
-
| Error e -> Alcotest.failf "decode: %s" e
60
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e)
60
61
61
62
let test_version_extra_fields_ignored () =
62
63
(* Jsont skip_unknown should tolerate extra fields *)
···
68
69
| Ok v ->
69
70
Alcotest.(check int) "major" 8 v.qemu.major;
70
71
Alcotest.(check string) "package" "" v.package
71
-
| Error e -> Alcotest.failf "decode: %s" e
72
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e)
72
73
73
74
(* {1 Greeting tests -- QEMU 9.0 spec vector} *)
74
75
···
160
161
(* Roundtrip through codec *)
161
162
match Json.of_string Qmp.Command.jsont s with
162
163
| Ok _ -> ()
163
-
| Error e -> Alcotest.failf "roundtrip: %s" e
164
+
| Error e -> Alcotest.failf "roundtrip: %s" (Json.Error.to_string e)
164
165
165
166
let test_command_with_id_args () =
166
167
let args = parse_json {|{"protocol": "tcp", "hostname": "localhost"}|} in
···
169
170
let s = encode_json json in
170
171
match Json.of_string Qmp.Command.jsont s with
171
172
| Ok _ -> ()
172
-
| Error e -> Alcotest.failf "roundtrip: %s" e
173
+
| Error e -> Alcotest.failf "roundtrip: %s" (Json.Error.to_string e)
173
174
174
175
let test_command_blockdev_add () =
175
176
(* More complex arguments -- blockdev-add with nested config *)
···
182
183
let s = encode_json json in
183
184
match Json.of_string Qmp.Command.jsont s with
184
185
| Ok _ -> ()
185
-
| Error e -> Alcotest.failf "roundtrip: %s" e
186
+
| Error e -> Alcotest.failf "roundtrip: %s" (Json.Error.to_string e)
186
187
187
188
(* {1 Status run_state string roundtrip} *)
188
189
···
302
303
| Ok ts ->
303
304
Alcotest.(check int) "seconds" 1267040730 ts.seconds;
304
305
Alcotest.(check int) "microseconds" 682951 ts.microseconds
305
-
| Error e -> Alcotest.failf "decode: %s" e
306
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e)
306
307
307
308
(* {1 Event data extraction} *)
308
309