gazagnaire.org
OCaml wire format DSL with EverParse 3D output for verified parsers
1(* Test wire library *)
2
3open Wire
4
5let contains ~sub s = Re.execp (Re.compile (Re.str sub)) s
6
7(* Helper: encode record to string using Codec API *)
8let encode_record_to_string codec v =
9 let ws = Codec.wire_size codec in
10 let buf = Bytes.create ws in
11 Codec.encode codec v buf 0;
12 Ok (Bytes.unsafe_to_string buf)
13
14(* Helper: decode record from string using Codec API *)
15let decode_record_from_string codec s =
16 let ws = Codec.wire_size codec in
17 if String.length s < ws then
18 Error (Unexpected_eof { expected = ws; got = String.length s })
19 else Ok (Codec.decode codec (Bytes.of_string s) 0)
20
21let test_bitfields () =
22 let bf =
23 struct_ "BF"
24 [
25 field "x" (bits ~width:6 bf_uint32);
26 field "y"
27 ~constraint_:Expr.(ref "y" <= int 900)
28 (bits ~width:10 bf_uint32);
29 field "z"
30 ~constraint_:Expr.(ref "y" + ref "z" <= int 60000)
31 (bits ~width:16 bf_uint32);
32 ]
33 in
34 let m = module_ "Bitfields" [ typedef bf ] in
35 let output = to_3d m in
36 Alcotest.(check bool) "non-empty output" true (String.length output > 0);
37 Alcotest.(check bool) "contains UINT32" true (contains ~sub:"UINT32" output);
38 Alcotest.(check bool) "contains BF" true (contains ~sub:"BF" output)
39
40let test_enumerations () =
41 let m =
42 module_ "Enumerations"
43 [
44 enum_decl "Enum8"
45 [ ("Enum8_1", 0); ("Enum8_2", 1); ("Enum8_3", 2) ]
46 uint8;
47 ]
48 in
49 let output = to_3d m in
50 Alcotest.(check bool) "non-empty output" true (String.length output > 0);
51 Alcotest.(check bool) "contains enum" true (contains ~sub:"enum" output);
52 Alcotest.(check bool) "contains Enum8_1" true (contains ~sub:"Enum8_1" output)
53
54let test_field_dependence () =
55 let t_struct = param_struct "t" [ param "a" uint32 ] [ field "x" uint32 ] in
56 let s_struct =
57 struct_ "s"
58 [ field "a" uint32; field "b" (apply (type_ref "t") [ ref "a" ]) ]
59 in
60 let m = module_ "FieldDependence" [ typedef t_struct; typedef s_struct ] in
61 let output = to_3d m in
62 Alcotest.(check bool) "non-empty output" true (String.length output > 0);
63 Alcotest.(check bool) "contains param" true (contains ~sub:"UINT32 a" output)
64
65let test_casetype () =
66 let d_casetype =
67 casetype_decl "_D"
68 [ param "key" uint32 ]
69 uint32
70 [ decl_case 1 uint16; decl_case 2 uint32 ]
71 in
72 let m = module_ "Casetype" [ d_casetype ] in
73 let output = to_3d m in
74 Alcotest.(check bool) "non-empty output" true (String.length output > 0);
75 Alcotest.(check bool)
76 "contains casetype" true
77 (contains ~sub:"casetype" output);
78 Alcotest.(check bool)
79 "contains switch" true
80 (contains ~sub:"switch (key)" output);
81 (* Public name should not have underscore *)
82 Alcotest.(check bool) "public name is D" true (contains ~sub:"} D;" output)
83
84let test_pretty_print () =
85 let simple =
86 struct_ "Simple" [ field "a" uint8; field "b" uint16be; field "c" uint32 ]
87 in
88 let m = module_ "Simple" [ typedef simple ] in
89 let output = to_3d m in
90 Alcotest.(check bool) "contains typedef" true (String.length output > 0);
91 Alcotest.(check bool) "contains UINT8" true (contains ~sub:"UINT8" output);
92 Alcotest.(check bool)
93 "contains UINT16BE" true
94 (contains ~sub:"UINT16BE" output)
95
96(* Parsing tests *)
97
98let test_parse_uint8 () =
99 let input = "\x42" in
100 match parse_string uint8 input with
101 | Ok v -> Alcotest.(check int) "uint8 value" 0x42 v
102 | Error e -> Alcotest.failf "%a" pp_parse_error e
103
104let test_parse_uint16_le () =
105 let input = "\x01\x02" in
106 match parse_string uint16 input with
107 | Ok v -> Alcotest.(check int) "uint16 le value" 0x0201 v
108 | Error e -> Alcotest.failf "%a" pp_parse_error e
109
110let test_parse_uint16_be () =
111 let input = "\x01\x02" in
112 match parse_string uint16be input with
113 | Ok v -> Alcotest.(check int) "uint16 be value" 0x0102 v
114 | Error e -> Alcotest.failf "%a" pp_parse_error e
115
116let test_parse_uint32_le () =
117 let input = "\x01\x02\x03\x04" in
118 match parse_string uint32 input with
119 | Ok v -> Alcotest.(check int) "uint32 le value" 0x04030201 v
120 | Error e -> Alcotest.failf "%a" pp_parse_error e
121
122let test_parse_uint32_be () =
123 let input = "\x01\x02\x03\x04" in
124 match parse_string uint32be input with
125 | Ok v -> Alcotest.(check int) "uint32 be value" 0x01020304 v
126 | Error e -> Alcotest.failf "%a" pp_parse_error e
127
128let test_parse_uint64_le () =
129 let input = "\x01\x02\x03\x04\x05\x06\x07\x08" in
130 match parse_string uint64 input with
131 | Ok v -> Alcotest.(check int64) "uint64 le value" 0x0807060504030201L v
132 | Error e -> Alcotest.failf "%a" pp_parse_error e
133
134let test_parse_array () =
135 let input = "\x01\x02\x03" in
136 let t = array ~len:(int 3) uint8 in
137 match parse_string t input with
138 | Ok v -> Alcotest.(check (list int)) "array values" [ 1; 2; 3 ] v
139 | Error e -> Alcotest.failf "%a" pp_parse_error e
140
141let test_parse_byte_array () =
142 let input = "hello" in
143 let t = byte_array ~size:(int 5) in
144 match parse_string t input with
145 | Ok v -> Alcotest.(check string) "byte_array value" "hello" v
146 | Error e -> Alcotest.failf "%a" pp_parse_error e
147
148let test_parse_enum_valid () =
149 let input = "\x01" in
150 let t = enum "Test" [ ("A", 0); ("B", 1); ("C", 2) ] uint8 in
151 match parse_string t input with
152 | Ok v -> Alcotest.(check int) "enum value" 1 v
153 | Error e -> Alcotest.failf "%a" pp_parse_error e
154
155let test_parse_enum_invalid () =
156 let input = "\xFF" in
157 let t = enum "Test" [ ("A", 0); ("B", 1); ("C", 2) ] uint8 in
158 match parse_string t input with
159 | Ok _ -> Alcotest.fail "expected error for invalid enum"
160 | Error (Invalid_enum { value; _ }) ->
161 Alcotest.(check int) "invalid enum value" 255 value
162 | Error e -> Alcotest.failf "wrong error: %a" pp_parse_error e
163
164let test_parse_all_bytes () =
165 let input = "hello world" in
166 match parse_string all_bytes input with
167 | Ok v -> Alcotest.(check string) "all_bytes value" "hello world" v
168 | Error e -> Alcotest.failf "%a" pp_parse_error e
169
170let test_parse_all_zeros_valid () =
171 let input = "\x00\x00\x00" in
172 match parse_string all_zeros input with
173 | Ok _ -> ()
174 | Error e -> Alcotest.failf "%a" pp_parse_error e
175
176let test_parse_all_zeros_invalid () =
177 let input = "\x00\x01\x00" in
178 match parse_string all_zeros input with
179 | Ok _ -> Alcotest.fail "expected error for non-zero byte"
180 | Error (All_zeros_failed { offset }) ->
181 Alcotest.(check int) "non-zero offset" 1 offset
182 | Error e -> Alcotest.failf "wrong error: %a" pp_parse_error e
183
184let test_parse_bitfield () =
185 let input = "\xFF\xFF\xFF\xFF" in
186 let t = bits ~width:6 bf_uint32 in
187 match parse_string t input with
188 | Ok v -> Alcotest.(check int) "bitfield value (6 bits)" 63 v
189 | Error e -> Alcotest.failf "%a" pp_parse_error e
190
191let test_parse_eof () =
192 let input = "\x01" in
193 match parse_string uint16 input with
194 | Ok _ -> Alcotest.fail "expected EOF error"
195 | Error (Unexpected_eof { expected; got }) ->
196 Alcotest.(check int) "expected bytes" 2 expected;
197 Alcotest.(check int) "got bytes" 1 got
198 | Error e -> Alcotest.failf "wrong error: %a" pp_parse_error e
199
200let test_parse_struct () =
201 let input = "\x01\x02\x03" in
202 let s =
203 struct_ "Test" [ field "a" uint8; field "b" uint8; field "c" uint8 ]
204 in
205 let t = struct_typ s in
206 match parse_string t input with
207 | Ok () -> ()
208 | Error e -> Alcotest.failf "%a" pp_parse_error e
209
210let test_parse_struct_constraint () =
211 (* Test struct with constraint that should pass *)
212 let input = "\x0A" in
213 let s =
214 struct_ "Constrained"
215 [ field "x" ~constraint_:Expr.(ref "x" <= int 100) uint8 ]
216 in
217 let t = struct_typ s in
218 match parse_string t input with
219 | Ok () -> ()
220 | Error e -> Alcotest.failf "%a" pp_parse_error e
221
222let test_parse_struct_constraint_fail () =
223 (* Test struct with constraint that should fail *)
224 let input = "\xFF" in
225 let s =
226 struct_ "Constrained"
227 [ field "x" ~constraint_:Expr.(ref "x" <= int 100) uint8 ]
228 in
229 let t = struct_typ s in
230 match parse_string t input with
231 | Ok _ -> Alcotest.fail "expected constraint failure"
232 | Error (Constraint_failed _) -> ()
233 | Error e -> Alcotest.failf "wrong error: %a" pp_parse_error e
234
235(* Encoding tests *)
236
237let test_encode_uint8 () =
238 let encoded = encode_to_string uint8 0x42 in
239 Alcotest.(check string) "uint8 encoding" "\x42" encoded
240
241let test_encode_uint16_le () =
242 let encoded = encode_to_string uint16 0x0201 in
243 Alcotest.(check string) "uint16 le encoding" "\x01\x02" encoded
244
245let test_encode_uint16_be () =
246 let encoded = encode_to_string uint16be 0x0102 in
247 Alcotest.(check string) "uint16 be encoding" "\x01\x02" encoded
248
249let test_encode_uint32_le () =
250 let encoded = encode_to_string uint32 0x04030201 in
251 Alcotest.(check string) "uint32 le encoding" "\x01\x02\x03\x04" encoded
252
253let test_encode_uint32_be () =
254 let encoded = encode_to_string uint32be 0x01020304 in
255 Alcotest.(check string) "uint32 be encoding" "\x01\x02\x03\x04" encoded
256
257let test_encode_array () =
258 let t = array ~len:(int 3) uint8 in
259 let encoded = encode_to_string t [ 1; 2; 3 ] in
260 Alcotest.(check string) "array encoding" "\x01\x02\x03" encoded
261
262let test_encode_byte_array () =
263 let t = byte_array ~size:(int 5) in
264 let encoded = encode_to_string t "hello" in
265 Alcotest.(check string) "byte_array encoding" "hello" encoded
266
267let test_encode_enum () =
268 let t = enum "Test" [ ("A", 0); ("B", 1); ("C", 2) ] uint8 in
269 let encoded = encode_to_string t 1 in
270 Alcotest.(check string) "enum encoding" "\x01" encoded
271
272let test_encode_bitfield () =
273 let t = bits ~width:6 bf_uint32 in
274 let encoded = encode_to_string t 63 in
275 (* 63 = 0x3F, but stored in 4 bytes as uint32 LE *)
276 Alcotest.(check string) "bitfield encoding" "\x3F\x00\x00\x00" encoded
277
278(* Roundtrip tests *)
279
280let test_roundtrip_uint8 () =
281 let original = 0x42 in
282 let encoded = encode_to_string uint8 original in
283 match parse_string uint8 encoded with
284 | Ok decoded -> Alcotest.(check int) "roundtrip uint8" original decoded
285 | Error e -> Alcotest.failf "%a" pp_parse_error e
286
287let test_roundtrip_uint16 () =
288 let original = 0x1234 in
289 let encoded = encode_to_string uint16 original in
290 match parse_string uint16 encoded with
291 | Ok decoded -> Alcotest.(check int) "roundtrip uint16" original decoded
292 | Error e -> Alcotest.failf "%a" pp_parse_error e
293
294let test_roundtrip_uint32 () =
295 let original = 0x12345678 in
296 let encoded = encode_to_string uint32 original in
297 match parse_string uint32 encoded with
298 | Ok decoded -> Alcotest.(check int) "roundtrip uint32" original decoded
299 | Error e -> Alcotest.failf "%a" pp_parse_error e
300
301let test_roundtrip_array () =
302 let original = [ 1; 2; 3; 4; 5 ] in
303 let t = array ~len:(int 5) uint8 in
304 let encoded = encode_to_string t original in
305 match parse_string t encoded with
306 | Ok decoded -> Alcotest.(check (list int)) "roundtrip array" original decoded
307 | Error e -> Alcotest.failf "%a" pp_parse_error e
308
309let test_roundtrip_byte_array () =
310 let original = "hello" in
311 let t = byte_array ~size:(int 5) in
312 let encoded = encode_to_string t original in
313 match parse_string t encoded with
314 | Ok decoded ->
315 Alcotest.(check string) "roundtrip byte_array" original decoded
316 | Error e -> Alcotest.failf "%a" pp_parse_error e
317
318(* Record codec tests *)
319
320type simple_record = { a : int; b : int; c : int }
321
322let simple_record_codec =
323 let open Codec in
324 record "SimpleRecord" (fun a b c -> { a; b; c })
325 |+ field "a" uint8 (fun r -> r.a)
326 |+ field "b" uint16 (fun r -> r.b)
327 |+ field "c" uint32 (fun r -> r.c)
328 |> seal
329
330let test_record_encode () =
331 let v = { a = 0x42; b = 0x1234; c = 0x56789ABC } in
332 match encode_record_to_string simple_record_codec v with
333 | Error e -> Alcotest.failf "%a" pp_parse_error e
334 | Ok encoded ->
335 (* uint8 + uint16_le + uint32_le *)
336 Alcotest.(check int) "length" 7 (String.length encoded);
337 Alcotest.(check int) "byte 0 (a)" 0x42 (Char.code encoded.[0]);
338 (* uint16 LE: 0x1234 -> 0x34, 0x12 *)
339 Alcotest.(check int) "byte 1 (b low)" 0x34 (Char.code encoded.[1]);
340 Alcotest.(check int) "byte 2 (b high)" 0x12 (Char.code encoded.[2])
341
342let test_record_decode () =
343 let input = "\x42\x34\x12\xBC\x9A\x78\x56" in
344 match decode_record_from_string simple_record_codec input with
345 | Ok v ->
346 Alcotest.(check int) "a" 0x42 v.a;
347 Alcotest.(check int) "b" 0x1234 v.b;
348 Alcotest.(check int) "c" 0x56789ABC v.c
349 | Error e -> Alcotest.failf "%a" pp_parse_error e
350
351let test_record_roundtrip () =
352 let original = { a = 0xAB; b = 0xCDEF; c = 0x12345678 } in
353 match encode_record_to_string simple_record_codec original with
354 | Error e -> Alcotest.failf "encode: %a" pp_parse_error e
355 | Ok encoded -> (
356 match decode_record_from_string simple_record_codec encoded with
357 | Ok decoded ->
358 Alcotest.(check int) "a roundtrip" original.a decoded.a;
359 Alcotest.(check int) "b roundtrip" original.b decoded.b;
360 Alcotest.(check int) "c roundtrip" original.c decoded.c
361 | Error e -> Alcotest.failf "%a" pp_parse_error e)
362
363let test_record_to_struct () =
364 let s = Codec.to_struct simple_record_codec in
365 let m = module_ "SimpleRecord" [ typedef s ] in
366 let output = to_3d m in
367 Alcotest.(check bool) "contains UINT8" true (contains ~sub:"UINT8" output);
368 Alcotest.(check bool) "contains UINT16" true (contains ~sub:"UINT16" output);
369 Alcotest.(check bool) "contains UINT32" true (contains ~sub:"UINT32" output);
370 Alcotest.(check bool) "contains field a" true (contains ~sub:"a;" output);
371 Alcotest.(check bool) "contains field b" true (contains ~sub:"b;" output);
372 Alcotest.(check bool) "contains field c" true (contains ~sub:"c;" output)
373
374(* Record with multiple uint16be fields *)
375type multi_record = { x : int; y : int }
376
377let multi_record_codec =
378 let open Codec in
379 record "MultiRecord" (fun x y -> { x; y })
380 |+ field "x" uint16be (fun r -> r.x)
381 |+ field "y" uint16be (fun r -> r.y)
382 |> seal
383
384let test_record_with_multi () =
385 let original = { x = 0x1234; y = 0x5678 } in
386 match encode_record_to_string multi_record_codec original with
387 | Error e -> Alcotest.failf "encode: %a" pp_parse_error e
388 | Ok encoded -> (
389 Alcotest.(check int) "length" 4 (String.length encoded);
390 match decode_record_from_string multi_record_codec encoded with
391 | Ok decoded ->
392 Alcotest.(check int) "x" original.x decoded.x;
393 Alcotest.(check int) "y" original.y decoded.y
394 | Error e -> Alcotest.failf "%a" pp_parse_error e)
395
396(* Record with byte_array field *)
397type ba_record = { id : int; uuid : string; tag : int }
398
399let ba_record_codec =
400 let open Codec in
401 record "BaRecord" (fun id uuid tag -> { id; uuid; tag })
402 |+ field "id" uint32be (fun r -> r.id)
403 |+ field "uuid" (byte_array ~size:(int 16)) (fun r -> r.uuid)
404 |+ field "tag" uint16be (fun r -> r.tag)
405 |> seal
406
407let test_record_byte_array_roundtrip () =
408 let original = { id = 0x12345678; uuid = "0123456789abcdef"; tag = 0xABCD } in
409 match encode_record_to_string ba_record_codec original with
410 | Error e -> Alcotest.failf "encode: %a" pp_parse_error e
411 | Ok encoded -> (
412 Alcotest.(check int) "wire size" 22 (String.length encoded);
413 match decode_record_from_string ba_record_codec encoded with
414 | Ok decoded ->
415 Alcotest.(check int) "id" original.id decoded.id;
416 Alcotest.(check string) "uuid" original.uuid decoded.uuid;
417 Alcotest.(check int) "tag" original.tag decoded.tag
418 | Error e -> Alcotest.failf "%a" pp_parse_error e)
419
420let test_record_byte_array_padding () =
421 (* Short string should be zero-padded *)
422 let original = { id = 1; uuid = "short"; tag = 2 } in
423 match encode_record_to_string ba_record_codec original with
424 | Error e -> Alcotest.failf "encode: %a" pp_parse_error e
425 | Ok encoded -> (
426 Alcotest.(check int) "wire size" 22 (String.length encoded);
427 (* Verify zero padding: bytes 9..19 should be zero *)
428 for i = 9 to 19 do
429 Alcotest.(check int)
430 (Fmt.str "padding byte %d" i)
431 0
432 (Char.code encoded.[i])
433 done;
434 match decode_record_from_string ba_record_codec encoded with
435 | Ok decoded ->
436 (* Decoded uuid includes the zero padding *)
437 Alcotest.(check int) "uuid length" 16 (String.length decoded.uuid);
438 Alcotest.(check string)
439 "uuid prefix" "short"
440 (String.sub decoded.uuid 0 5)
441 | Error e -> Alcotest.failf "%a" pp_parse_error e)
442
443(* Codec bitfield tests *)
444
445type bf32_record = { bf_a : int; bf_b : int; bf_c : int; bf_d : int }
446
447let bf32_codec =
448 let open Codec in
449 record "Bf32Test" (fun a b c d -> { bf_a = a; bf_b = b; bf_c = c; bf_d = d })
450 |+ field "a" (bits ~width:3 bf_uint32be) (fun t -> t.bf_a)
451 |+ field "b" (bits ~width:5 bf_uint32be) (fun t -> t.bf_b)
452 |+ field "c" (bits ~width:16 bf_uint32be) (fun t -> t.bf_c)
453 |+ field "d" (bits ~width:8 bf_uint32be) (fun t -> t.bf_d)
454 |> seal
455
456type bf16_record = {
457 bf_ver : int;
458 bf_flags : int;
459 bf_id : int;
460 bf_count : int;
461 bf_len : int;
462}
463
464let bf16_codec =
465 let open Codec in
466 record "Bf16Test" (fun ver flags id count len ->
467 {
468 bf_ver = ver;
469 bf_flags = flags;
470 bf_id = id;
471 bf_count = count;
472 bf_len = len;
473 })
474 |+ field "ver" (bits ~width:3 bf_uint16be) (fun t -> t.bf_ver)
475 |+ field "flags" (bits ~width:2 bf_uint16be) (fun t -> t.bf_flags)
476 |+ field "id" (bits ~width:11 bf_uint16be) (fun t -> t.bf_id)
477 |+ field "count" (bits ~width:14 bf_uint16be) (fun t -> t.bf_count)
478 |+ field "len" (bits ~width:2 bf_uint16be) (fun t -> t.bf_len)
479 |> seal
480
481let test_codec_bitfield_wire_size () =
482 Alcotest.(check int) "bf32 wire_size" 4 (Codec.wire_size bf32_codec);
483 Alcotest.(check int) "bf16 wire_size" 4 (Codec.wire_size bf16_codec)
484
485let test_codec_bitfield_roundtrip () =
486 let original = { bf_a = 5; bf_b = 20; bf_c = 0x1234; bf_d = 0xAB } in
487 match encode_record_to_string bf32_codec original with
488 | Error e -> Alcotest.failf "encode: %a" pp_parse_error e
489 | Ok encoded -> (
490 match decode_record_from_string bf32_codec encoded with
491 | Ok decoded ->
492 Alcotest.(check int) "a" original.bf_a decoded.bf_a;
493 Alcotest.(check int) "b" original.bf_b decoded.bf_b;
494 Alcotest.(check int) "c" original.bf_c decoded.bf_c;
495 Alcotest.(check int) "d" original.bf_d decoded.bf_d
496 | Error e -> Alcotest.failf "%a" pp_parse_error e)
497
498let test_codec_bitfield_byte_layout () =
499 (* a=5 (3b), b=20 (5b), c=0x1234 (16b), d=0xAB (8b)
500 MSB-first packing: 101_10100_0001001000110100_10101011
501 = 0xB4 0x12 0x34 0xAB *)
502 let v = { bf_a = 5; bf_b = 20; bf_c = 0x1234; bf_d = 0xAB } in
503 match encode_record_to_string bf32_codec v with
504 | Error e -> Alcotest.failf "encode: %a" pp_parse_error e
505 | Ok encoded ->
506 Alcotest.(check int) "length" 4 (String.length encoded);
507 Alcotest.(check int) "byte 0" 0xB4 (Char.code encoded.[0]);
508 Alcotest.(check int) "byte 1" 0x12 (Char.code encoded.[1]);
509 Alcotest.(check int) "byte 2" 0x34 (Char.code encoded.[2]);
510 Alcotest.(check int) "byte 3" 0xAB (Char.code encoded.[3])
511
512let test_codec_bitfield_decode () =
513 (* Decode 0xB41234AB -> a=5, b=20, c=0x1234, d=0xAB *)
514 let input = "\xB4\x12\x34\xAB" in
515 match decode_record_from_string bf32_codec input with
516 | Ok v ->
517 Alcotest.(check int) "a" 5 v.bf_a;
518 Alcotest.(check int) "b" 20 v.bf_b;
519 Alcotest.(check int) "c" 0x1234 v.bf_c;
520 Alcotest.(check int) "d" 0xAB v.bf_d
521 | Error e -> Alcotest.failf "%a" pp_parse_error e
522
523let test_codec_bitfield_multi_group () =
524 (* Two bf_uint16be groups: (3+2+11=16) + (14+2=16) = 32 bits = 4 bytes *)
525 let v =
526 { bf_ver = 5; bf_flags = 2; bf_id = 0x7FF; bf_count = 0x3FFF; bf_len = 3 }
527 in
528 match encode_record_to_string bf16_codec v with
529 | Error e -> Alcotest.failf "encode: %a" pp_parse_error e
530 | Ok encoded -> (
531 Alcotest.(check int) "length" 4 (String.length encoded);
532 (* First group: 101_10_11111111111 = 0xB7FF *)
533 Alcotest.(check int) "byte 0" 0xB7 (Char.code encoded.[0]);
534 Alcotest.(check int) "byte 1" 0xFF (Char.code encoded.[1]);
535 (* Second group: 11111111111111_11 = 0xFFFF *)
536 Alcotest.(check int) "byte 2" 0xFF (Char.code encoded.[2]);
537 Alcotest.(check int) "byte 3" 0xFF (Char.code encoded.[3]);
538 (* Roundtrip decode *)
539 match decode_record_from_string bf16_codec encoded with
540 | Ok decoded ->
541 Alcotest.(check int) "ver" v.bf_ver decoded.bf_ver;
542 Alcotest.(check int) "flags" v.bf_flags decoded.bf_flags;
543 Alcotest.(check int) "id" v.bf_id decoded.bf_id;
544 Alcotest.(check int) "count" v.bf_count decoded.bf_count;
545 Alcotest.(check int) "len" v.bf_len decoded.bf_len
546 | Error e -> Alcotest.failf "%a" pp_parse_error e)
547
548let test_codec_bitfield_to_struct () =
549 let s = Codec.to_struct bf32_codec in
550 let m = module_ "Bf32Test" [ typedef s ] in
551 let output = to_3d m in
552 Alcotest.(check bool)
553 "contains UINT32BE" true
554 (contains ~sub:"UINT32BE" output);
555 Alcotest.(check bool) "contains field a" true (contains ~sub:"a" output);
556 Alcotest.(check bool) "contains field b" true (contains ~sub:"b" output)
557
558(* FFI stub generation tests *)
559
560let test_c_stubs () =
561 let s =
562 struct_ "SimpleHeader"
563 [ field "version" uint8; field "length" uint16; field "flags" uint8 ]
564 in
565 let stubs = to_c_stubs [ s ] in
566 Alcotest.(check bool)
567 "contains read stub" true
568 (contains ~sub:"caml_wire_SimpleHeader_read" stubs);
569 Alcotest.(check bool)
570 "contains write stub" true
571 (contains ~sub:"caml_wire_SimpleHeader_write" stubs)
572
573let suite =
574 ( "wire",
575 [
576 (* generation *)
577 Alcotest.test_case "generation: bitfields" `Quick test_bitfields;
578 Alcotest.test_case "generation: enumerations" `Quick test_enumerations;
579 Alcotest.test_case "generation: field dependence" `Quick
580 test_field_dependence;
581 Alcotest.test_case "generation: casetype" `Quick test_casetype;
582 Alcotest.test_case "generation: pretty print" `Quick test_pretty_print;
583 (* parsing *)
584 Alcotest.test_case "parse: uint8" `Quick test_parse_uint8;
585 Alcotest.test_case "parse: uint16 le" `Quick test_parse_uint16_le;
586 Alcotest.test_case "parse: uint16 be" `Quick test_parse_uint16_be;
587 Alcotest.test_case "parse: uint32 le" `Quick test_parse_uint32_le;
588 Alcotest.test_case "parse: uint32 be" `Quick test_parse_uint32_be;
589 Alcotest.test_case "parse: uint64 le" `Quick test_parse_uint64_le;
590 Alcotest.test_case "parse: array" `Quick test_parse_array;
591 Alcotest.test_case "parse: byte_array" `Quick test_parse_byte_array;
592 Alcotest.test_case "parse: enum valid" `Quick test_parse_enum_valid;
593 Alcotest.test_case "parse: enum invalid" `Quick test_parse_enum_invalid;
594 Alcotest.test_case "parse: all_bytes" `Quick test_parse_all_bytes;
595 Alcotest.test_case "parse: all_zeros valid" `Quick
596 test_parse_all_zeros_valid;
597 Alcotest.test_case "parse: all_zeros invalid" `Quick
598 test_parse_all_zeros_invalid;
599 Alcotest.test_case "parse: bitfield" `Quick test_parse_bitfield;
600 Alcotest.test_case "parse: eof error" `Quick test_parse_eof;
601 Alcotest.test_case "parse: struct" `Quick test_parse_struct;
602 Alcotest.test_case "parse: struct constraint" `Quick
603 test_parse_struct_constraint;
604 Alcotest.test_case "parse: struct constraint fail" `Quick
605 test_parse_struct_constraint_fail;
606 (* encoding *)
607 Alcotest.test_case "encode: uint8" `Quick test_encode_uint8;
608 Alcotest.test_case "encode: uint16 le" `Quick test_encode_uint16_le;
609 Alcotest.test_case "encode: uint16 be" `Quick test_encode_uint16_be;
610 Alcotest.test_case "encode: uint32 le" `Quick test_encode_uint32_le;
611 Alcotest.test_case "encode: uint32 be" `Quick test_encode_uint32_be;
612 Alcotest.test_case "encode: array" `Quick test_encode_array;
613 Alcotest.test_case "encode: byte_array" `Quick test_encode_byte_array;
614 Alcotest.test_case "encode: enum" `Quick test_encode_enum;
615 Alcotest.test_case "encode: bitfield" `Quick test_encode_bitfield;
616 (* roundtrip *)
617 Alcotest.test_case "roundtrip: uint8" `Quick test_roundtrip_uint8;
618 Alcotest.test_case "roundtrip: uint16" `Quick test_roundtrip_uint16;
619 Alcotest.test_case "roundtrip: uint32" `Quick test_roundtrip_uint32;
620 Alcotest.test_case "roundtrip: array" `Quick test_roundtrip_array;
621 Alcotest.test_case "roundtrip: byte_array" `Quick
622 test_roundtrip_byte_array;
623 (* record *)
624 Alcotest.test_case "record: encode" `Quick test_record_encode;
625 Alcotest.test_case "record: decode" `Quick test_record_decode;
626 Alcotest.test_case "record: roundtrip" `Quick test_record_roundtrip;
627 Alcotest.test_case "record: to_struct" `Quick test_record_to_struct;
628 Alcotest.test_case "record: with_multi" `Quick test_record_with_multi;
629 Alcotest.test_case "record: byte_array roundtrip" `Quick
630 test_record_byte_array_roundtrip;
631 Alcotest.test_case "record: byte_array padding" `Quick
632 test_record_byte_array_padding;
633 (* codec bitfields *)
634 Alcotest.test_case "codec bitfield: wire_size" `Quick
635 test_codec_bitfield_wire_size;
636 Alcotest.test_case "codec bitfield: roundtrip" `Quick
637 test_codec_bitfield_roundtrip;
638 Alcotest.test_case "codec bitfield: byte layout" `Quick
639 test_codec_bitfield_byte_layout;
640 Alcotest.test_case "codec bitfield: decode" `Quick
641 test_codec_bitfield_decode;
642 Alcotest.test_case "codec bitfield: multi group" `Quick
643 test_codec_bitfield_multi_group;
644 Alcotest.test_case "codec bitfield: to_struct" `Quick
645 test_codec_bitfield_to_struct;
646 (* ffi stubs *)
647 Alcotest.test_case "ffi: c_stubs" `Quick test_c_stubs;
648 ] )