open Ppxlib

open Ast_helper

open Bytepattern

let keyword fmt = Spices.(default |> fg (color "#00FF00") |> build) fmt

let error fmt = Spices.(default |> fg (color "#FF0000") |> build) fmt

let loc = Location.none

let id name =

let longident = Location.{ loc; txt = Longident.parse name } in

Exp.ident longident

let int n = Exp.constant (Const.int n)

let ocaml str =

let lexbuf = Lexing.from_string ~with_positions:false str in

Parse.expression lexbuf

let () =

let test str expected =

let actual = Lexer.read ~loc str in

let actual_str = Format.asprintf "%a" Lexer.pp actual in

let expect_str = Format.asprintf "%a" Lexer.pp expected in

if String.equal actual_str expect_str then

Format.printf "lexer test %S %s\r\n%!" str (keyword "OK")

else (

Format.printf "%s\n\nExpected:\n\n%a\n\nbut found:\n\n%a\n\n"

(error "Tokens do not match")

Lexer.pp expected Lexer.pp actual;

assert false)

in

test "" [];

test "all" [ IDENT "all" ];

test "all::4" [ IDENT "all"; COLON_COLON; NUMBER 4 ];

test "all::1024" [ IDENT "all"; COLON_COLON; NUMBER 1024 ];

test "all::utf8" [ IDENT "all"; COLON_COLON; IDENT "utf8" ];

test "2112::utf8" [ NUMBER 2112; COLON_COLON; IDENT "utf8" ];

test {|"rush\r\n"::bytes|} [ STRING "rush\r\n"; COLON_COLON; IDENT "bytes" ];

test {|"rush"::utf8|} [ STRING "rush"; COLON_COLON; IDENT "utf8" ];

test "all::bytes(10)"

[ IDENT "all"; COLON_COLON; IDENT "bytes"; EXPRESSION (int 10) ];

test "all::bytes(10),"

[ IDENT "all"; COLON_COLON; IDENT "bytes"; EXPRESSION (int 10); COMMA ];

test "all::bytes(foo)"

[ IDENT "all"; COLON_COLON; IDENT "bytes"; EXPRESSION (id "foo") ];

test "all::bytes(foo 1234)"

[ IDENT "all"; COLON_COLON; IDENT "bytes"; EXPRESSION (ocaml "foo 1234") ];

test "all::bytes(foo ())"

[ IDENT "all"; COLON_COLON; IDENT "bytes"; EXPRESSION (ocaml "foo ()") ];

test "all::bytes( (foo ()) * 8 / ( 10 - 1 ) )"

[

IDENT "all";

COLON_COLON;

IDENT "bytes";

EXPRESSION (ocaml "((foo ()) * 8) / (10 - 1)");

];

test "all::bytes(10), rest::binary"

[

IDENT "all";

COLON_COLON;

IDENT "bytes";

EXPRESSION (int 10);

COMMA;

IDENT "rest";

COLON_COLON;

IDENT "binary";

];

test

{| fin::1, comp::1, _rsv::2, 1::4 , 0::1, 127::7 , len ::64

,

mask::32

,payload::bytes(

len

)

|}

[

IDENT "fin";

COLON_COLON;

NUMBER 1;

COMMA;

IDENT "comp";

COLON_COLON;

NUMBER 1;

COMMA;

IDENT "_rsv";

COLON_COLON;

NUMBER 2;

COMMA;

NUMBER 1;

COLON_COLON;

NUMBER 4;

COMMA;

NUMBER 0;

COLON_COLON;

NUMBER 1;

COMMA;

NUMBER 127;

COLON_COLON;

NUMBER 7;

COMMA;

IDENT "len";

COLON_COLON;

NUMBER 64;

COMMA;

IDENT "mask";

COLON_COLON;

NUMBER 32;

COMMA;

IDENT "payload";

COLON_COLON;

IDENT "bytes";

EXPRESSION (id "len");

];

()

let () =

let open Parser in

let test str expected =

let actual = Parser.parse ~loc str in

let actual_str = Format.asprintf "%a" Parser.pp actual in

let expect_str = Format.asprintf "%a" Parser.pp expected in

if String.equal actual_str expect_str then

Format.printf "parser test %S %s\r\n%!" str (keyword "OK")

else (

Format.printf "%s\n\nExpected:\n\n%a\n\nbut found:\n\n%a\n\n"

(error "Parse trees do not match")

Parser.pp expected Parser.pp actual;

assert false)

in

test "" [];

test "all" [ Bind { name = "all"; size = Rest } ];

test "all::8" [ Bind { name = "all"; size = Fixed_bits 8 } ];

test "all::1024" [ Bind { name = "all"; size = Fixed_bits 1024 } ];

test "all::utf8" [ Bind { name = "all"; size = Utf8 } ];

test "all::bytes" [ Bind { name = "all"; size = Rest } ];

test "all::bytes(10)" [ Bind { name = "all"; size = Dynamic_bytes (int 10) } ];

test "all::bytes(foo ())"

[ Bind { name = "all"; size = Dynamic_bytes (ocaml "foo ()") } ];

test "all::bytes( (foo ()) * 8 / ( 10 - 1 ) )"

[

Bind

{

name = "all";

size = Dynamic_bytes (ocaml "((foo ()) * 8) / (10 - 1)");

};

];

test "2112::utf8" [ Expect { value = Number 2112; size = Utf8 } ];

test {|"rush"|} [ Expect { value = String "rush"; size = Rest } ];

test {|"rush\r\n"::bytes|}

[ Expect { value = String "rush\r\n"; size = Rest } ];

test {|"rush"::utf8|} [ Expect { value = String "rush"; size = Utf8 } ];

test "len::8, body::bytes(len)"

[

Bind { name = "len"; size = Fixed_bits 8 };

Bind { name = "body"; size = Dynamic_bytes (id "len") };

];

test "one::8, all::bytes"

[

Bind { name = "one"; size = Fixed_bits 8 };

Bind { name = "all"; size = Rest };

];

test

{| fin::1, comp::1, _rsv::2, 1::4, 0::1, 127::7, len::bytes(8), mask::32, payload::bytes(len), rest |}

[

bind "fin" (Fixed_bits 1);

bind "comp" (Fixed_bits 1);

bind "_rsv" (Fixed_bits 2);

expect (Number 1) (Fixed_bits 4);

expect (Number 0) (Fixed_bits 1);

expect (Number 127) (Fixed_bits 7);

bind "len" (Dynamic_bytes (int 8));

bind "mask" (Fixed_bits 32);

bind "payload" (Dynamic_bytes (id "len"));

bind "rest" Rest;

];

()

let () =

let open Construction_lower in

let test str expected =

let actual = parse ~loc str |> Construction_lower.lower ~loc in

let actual_str = Format.asprintf "%a" Construction_lower.pp actual in

let expect_str = Format.asprintf "%a" Construction_lower.pp expected in

if String.equal actual_str expect_str then

Format.printf "cstr-low test %S %s\r\n%!" str (keyword "OK")

else (

Format.printf "%s\n\nExpected:\n\n%a\n\nbut found:\n\n%a\n\n"

(error "Construction_lowered trees do not match")

Construction_lower.pp expected Construction_lower.pp actual;

assert false)

in

test "" [ Empty ];

test "all" [ Bypass "all" ];

test "all::8"

[

Create_transient "_trns";

Add_next_fixed_bits { src = "all"; size = 8 };

Commit_transient "_trns";

];

test "all::1024"

[

Create_transient "_trns";

Add_next_fixed_bits { src = "all"; size = 1024 };

Commit_transient "_trns";

];

test "all::utf8"

[

Create_transient "_trns";

Add_next_utf8 { src = "all" };

Commit_transient "_trns";

];

test "all::bytes" [ Bypass "all" ];

test "all::bytes(10)"

[

Create_transient "_trns";

Add_next_dynamic_bytes { src = "all"; expr = int 10 };

Commit_transient "_trns";

];

test "all::bytes(foo ())"

[

Create_transient "_trns";

Add_next_dynamic_bytes { src = "all"; expr = ocaml "foo ()" };

Commit_transient "_trns";

];

test "all::bytes( (foo ()) * 8 / ( 10 - 1 ) )"

[

Create_transient "_trns";

Add_next_dynamic_bytes

{ src = "all"; expr = ocaml "((foo ()) * 8) / (10 - 1)" };

Commit_transient "_trns";

];

test "2112::1"

[

Create_transient "_trns";

Add_int_fixed_bits { value = 2112; size = 1 };

Commit_transient "_trns";

];

test "2112::bits(1234)"

[

Create_transient "_trns";

Add_int_dynamic_bits { value = 2112; expr = int 1234 };

Commit_transient "_trns";

];

test "2112::bytes(1234)"

[

Create_transient "_trns";

Add_int_dynamic_bytes { value = 2112; expr = int 1234 };

Commit_transient "_trns";

];

test {|"rush"::utf8|}

[

Create_transient "_trns";

Add_string_utf8 { value = "rush" };

Commit_transient "_trns";

];

test {|"rush"::bytes|}

[

Create_transient "_trns";

Add_string_bytes { value = "rush" };

Commit_transient "_trns";

];

test {|"rush"::bytes(3)|}

[

Create_transient "_trns";

Add_string_dynamic_bytes { value = "rush"; expr = int 3 };

Commit_transient "_trns";

];

test "len::8, body::bytes(len)"

[

Create_transient "_trns";

Add_next_fixed_bits { src = "len"; size = 8 };

Add_next_dynamic_bytes { src = "body"; expr = id "len" };

Commit_transient "_trns";

];

test "one::8, all::bytes"

[

Create_transient "_trns";

Add_next_fixed_bits { src = "one"; size = 8 };

Add_rest { src = "all" };

Commit_transient "_trns";

];

test

{| fin::1, comp::1, _rsv::2,

1::4, 0::1, 127::7,

len::bytes(8), mask::32,

payload::bytes(len), rest |}

[

Create_transient "_trns";

Add_next_fixed_bits { src = "fin"; size = 1 };

Add_next_fixed_bits { src = "comp"; size = 1 };

Add_next_fixed_bits { src = "_rsv"; size = 2 };

Add_int_fixed_bits { value = 1; size = 4 };

Add_int_fixed_bits { value = 0; size = 1 };

Add_int_fixed_bits { value = 127; size = 7 };

Add_next_dynamic_bytes { src = "len"; expr = int 8 };

Add_next_fixed_bits { src = "mask"; size = 32 };

Add_next_dynamic_bytes { src = "payload"; expr = id "len" };

Add_rest { src = "rest" };

Commit_transient "_trns";

];

()

let () =

let test str expected =

let lower = Bytepattern.parse ~loc str in

let actual = lower |> Bytepattern.to_transient_builder ~loc in

let actual = Ppxlib.Pprintast.string_of_expression actual in

let expected = Ppxlib.Pprintast.string_of_expression expected in

if not (String.equal actual expected) then (

Format.printf "%s\n\nExpected:\n\n%s\n\nbut found:\n\n%s\n\n"

(error "Construction ASTs do not match")

expected actual;

assert false)

else Format.printf "transl-low test %S %s\r\n%!" str (keyword "OK")

in

(* test: empty pattern is just an empty bytestring *)

test {| |} [%expr Bytestring.empty];

test {| all |} [%expr all];

test {| all::bytes |} [%expr all];

test {| all::8 |}

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_bits _trns ~size:8 all;

Bytestring.Transient.commit _trns];

test "all::1024"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_bits _trns ~size:1024 all;

Bytestring.Transient.commit _trns];

test "all::utf8"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_utf8 _trns all;

Bytestring.Transient.commit _trns];

test "all::bytes(10)"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_string _trns ~size:10 all;

Bytestring.Transient.commit _trns];

test "all::bytes(foo ())"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_string _trns ~size:(foo ()) all;

Bytestring.Transient.commit _trns];

test "all::bytes( (foo ()) * 8 / ( 10 - 1 ) )"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_string _trns ~size:(foo () * 8 / (10 - 1)) all;

Bytestring.Transient.commit _trns];

test "len::8 , body::bytes(len)"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_bits _trns ~size:8 len;

Bytestring.Transient.add_string _trns ~size:len body;

Bytestring.Transient.commit _trns];

test "one::8, all ::bytes"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_bits _trns ~size:8 one;

Bytestring.Transient.add_string _trns all;

Bytestring.Transient.commit _trns];

test "2112::1"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_literal_int _trns ~size:1 2112;

Bytestring.Transient.commit _trns];

test "2112::bits(1234)"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_literal_int _trns ~size:1234 2112;

Bytestring.Transient.commit _trns];

test "2112::bytes(1234)"

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_literal_int _trns ~size:(1234 * 8) 2112;

Bytestring.Transient.commit _trns];

test {|"rush"|}

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_literal_string _trns "rush";

Bytestring.Transient.commit _trns];

test {|"rush"::utf8|}

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_literal_utf8 _trns "rush";

Bytestring.Transient.commit _trns];

test {|"rush"::bytes|}

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_literal_string _trns "rush";

Bytestring.Transient.commit _trns];

test {|"rush"::bytes(3)|}

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_literal_string _trns ~size:3 "rush";

Bytestring.Transient.commit _trns];

test

{| fin::1, comp::1, _rsv::2,

1::4, 0::1, 127::7,

len::bits(8*8), mask::32,

payload::bytes(len), rest |}

[%expr

let _trns = Bytestring.Transient.create () in

Bytestring.Transient.add_bits _trns ~size:1 fin;

Bytestring.Transient.add_bits _trns ~size:1 comp;

Bytestring.Transient.add_bits _trns ~size:2 _rsv;

Bytestring.Transient.add_literal_int _trns ~size:4 1;

Bytestring.Transient.add_literal_int _trns ~size:1 0;

Bytestring.Transient.add_literal_int _trns ~size:7 127;

Bytestring.Transient.add_bits _trns ~size:(8 * 8) len;

Bytestring.Transient.add_bits _trns ~size:32 mask;

Bytestring.Transient.add_string _trns ~size:len payload;

Bytestring.Transient.add_string _trns rest;

Bytestring.Transient.commit _trns];

()

let () =

let open Matching_lower in

let test str expected =

let actual = parse ~loc str |> Matching_lower.lower ~loc in

let actual_str = Format.asprintf "%a" Matching_lower.pp actual in

let expect_str = Format.asprintf "%a" Matching_lower.pp expected in

if String.equal actual_str expect_str then

Format.printf "match-low test %S %s\r\n%!" str (keyword "OK")

else (

Format.printf "%s\n\nExpected:\n\n%a\n\nbut found:\n\n%a\n\n"

(error "Matching_lower trees do not match")

Matching_lower.pp expected Matching_lower.pp actual;

assert false)

in

test "" [ Empty "_data_src" ];

test "all" [ Bypass { src = "_data_src"; name = "all" } ];

test "all::8"

[

Create_iterator "_data_src";

Bind_next_fixed_bits { src = "all"; size = 8; iter = "_data_src" };

Empty "_data_src";

];

test "all::1024"

[

Create_iterator "_data_src";

Bind_next_fixed_bits { src = "all"; size = 1024; iter = "_data_src" };

Empty "_data_src";

];

test "all::utf8"

[

Create_iterator "_data_src";

Bind_next_utf8 { src = "all"; iter = "_data_src" };

Empty "_data_src";

];

test "all::bytes" [ Bypass { src = "_data_src"; name = "all" } ];

test "all::bytes(10)"

[

Create_iterator "_data_src";

Bind_next_dynamic_bytes { src = "all"; expr = int 10; iter = "_data_src" };

Empty "_data_src";

];

test "all::bytes(foo ())"

[

Create_iterator "_data_src";

Bind_next_dynamic_bytes

{ src = "all"; expr = ocaml "foo ()"; iter = "_data_src" };

Empty "_data_src";

];

test "all::bytes( (foo ()) * 8 / ( 10 - 1 ) )"

[

Create_iterator "_data_src";

Bind_next_dynamic_bytes

{

src = "all";

expr = ocaml "((foo ()) * 8) / (10 - 1)";

iter = "_data_src";

};

Empty "_data_src";

];

test "2112::1"

[

Create_iterator "_data_src";

Expect_int_fixed_bits { value = 2112; size = 1; iter = "_data_src" };

Empty "_data_src";

];

test "2112::bits(1234)"

[

Create_iterator "_data_src";

Expect_int_dynamic_bits

{ value = 2112; expr = int 1234; iter = "_data_src" };

Empty "_data_src";

];

test "2112::bytes(1234)"

[

Create_iterator "_data_src";

Expect_int_dynamic_bytes

{ value = 2112; expr = int 1234; iter = "_data_src" };

Empty "_data_src";

];

test {|"rush"::utf8|}

[

Create_iterator "_data_src";

Expect_string_utf8 { value = "rush"; iter = "_data_src" };

Empty "_data_src";

];

test {|"rush"::bytes|}

[

Create_iterator "_data_src";

Expect_string_bytes { value = "rush"; iter = "_data_src" };

Empty "_data_src";

];

test {|"rush"::bytes(3)|}

[

Create_iterator "_data_src";

Expect_string_dynamic_bytes

{ value = "rush"; expr = int 3; iter = "_data_src" };

Empty "_data_src";

];

test "len::8, body::bytes(len)"

[

Create_iterator "_data_src";

Bind_next_fixed_bits { src = "len"; size = 8; iter = "_data_src" };

Bind_next_dynamic_bytes

{ src = "body"; expr = id "len"; iter = "_data_src" };

Empty "_data_src";

];

test "one::8, all::bytes"

[

Create_iterator "_data_src";

Bind_next_fixed_bits { src = "one"; size = 8; iter = "_data_src" };

Bind_rest { src = "all"; iter = "_data_src" };

Empty "_data_src";

];

test

{| fin::1, comp::1, _rsv::2,

1::4, 0::1, 127::7,

len::bytes(8), mask::32,

payload::bytes(len), rest |}

[

Create_iterator "_data_src";

Bind_next_fixed_bits { src = "fin"; size = 1; iter = "_data_src" };

Bind_next_fixed_bits { src = "comp"; size = 1; iter = "_data_src" };

Bind_next_fixed_bits { src = "_rsv"; size = 2; iter = "_data_src" };

Expect_int_fixed_bits { value = 1; size = 4; iter = "_data_src" };

Expect_int_fixed_bits { value = 0; size = 1; iter = "_data_src" };

Expect_int_fixed_bits { value = 127; size = 7; iter = "_data_src" };

Bind_next_dynamic_bytes { src = "len"; expr = int 8; iter = "_data_src" };

Bind_next_fixed_bits { src = "mask"; size = 32; iter = "_data_src" };

Bind_next_dynamic_bytes

{ src = "payload"; expr = id "len"; iter = "_data_src" };

Bind_rest { src = "rest"; iter = "_data_src" };

Empty "_data_src";

];

()

let () =

let loc = Location.none in

let test str expected =

let lower = Bytepattern.parse ~loc str in

let actual = lower |> Bytepattern.to_pattern_match ~loc ~body:[%expr ()] in

let actual = Ppxlib.Pprintast.string_of_expression actual in

let expected = Ppxlib.Pprintast.string_of_expression expected in

if not (String.equal actual expected) then (

Format.printf "%s\n\nExpected:\n\n%s\n\nbut found:\n\n%s\n\n"

(error "Native matching trees do not match")

expected actual;

assert false)

else Format.printf "match-native test %S %s\r\n%!" str (keyword "OK")

in

(* test: empty pattern is just an empty bytestring *)

test {| |}

[%expr

Bytestring.Iter.expect_empty _data_src;

()];

test {| all |}

[%expr

let all = _data_src in

()];

test {| all::bytes |}

[%expr

let all = _data_src in

()];

test {| all::8 |}

[%expr

let _data_src = Bytestring.to_iter _data_src in

let all = Bytestring.Iter.next_bits ~size:8 _data_src in

Bytestring.Iter.expect_empty _data_src;

()];

test "all::1024"

[%expr

let _data_src = Bytestring.to_iter _data_src in

let all = Bytestring.Iter.next_bits ~size:1024 _data_src in

Bytestring.Iter.expect_empty _data_src;

()];

test "all::utf8"

[%expr

let _data_src = Bytestring.to_iter _data_src in

let all = Bytestring.Iter.next_utf8 _data_src in

Bytestring.Iter.expect_empty _data_src;

()];

test "all::bytes(10)"

[%expr

let _data_src = Bytestring.to_iter _data_src in

let all = Bytestring.Iter.next_bytes ~size:10 _data_src in

Bytestring.Iter.expect_empty _data_src;

()];

test "all::bytes(foo ())"

[%expr

let _data_src = Bytestring.to_iter _data_src in

let all = Bytestring.Iter.next_bytes ~size:(foo ()) _data_src in

Bytestring.Iter.expect_empty _data_src;

()];

test "all::bytes( (foo ()) * 8 / ( 10 - 1 ) )"

[%expr

let _data_src = Bytestring.to_iter _data_src in

let all =

Bytestring.Iter.next_bytes ~size:(foo () * 8 / (10 - 1)) _data_src

in

Bytestring.Iter.expect_empty _data_src;

()];

test "len::8 , body::bytes(len)"

[%expr

let _data_src = Bytestring.to_iter _data_src in

let len = Bytestring.Iter.next_bits ~size:8 _data_src in

let body = Bytestring.Iter.next_bytes ~size:len _data_src in

Bytestring.Iter.expect_empty _data_src;

()];

test "one::8, all ::bytes"

[%expr

let _data_src = Bytestring.to_iter _data_src in

let one = Bytestring.Iter.next_bits ~size:8 _data_src in

let all = Bytestring.Iter.rest _data_src in

Bytestring.Iter.expect_empty _data_src;

()];

test "2112::1"

[%expr

let _data_src = Bytestring.to_iter _data_src in

Bytestring.Iter.expect_literal_int _data_src ~size:1 2112;

Bytestring.Iter.expect_empty _data_src;

()];

test "2112::bits(1234)"

[%expr

let _data_src = Bytestring.to_iter _data_src in

Bytestring.Iter.expect_literal_int _data_src ~size:1234 2112;

Bytestring.Iter.expect_empty _data_src;

()];

test "2112::bytes(1234)"

[%expr

let _data_src = Bytestring.to_iter _data_src in

Bytestring.Iter.expect_literal_int _data_src ~size:(1234 * 8) 2112;

Bytestring.Iter.expect_empty _data_src;

()];

test {|"rush"::utf8|}

[%expr

let _data_src = Bytestring.to_iter _data_src in

Bytestring.Iter.expect_literal_utf8 _data_src "rush";

Bytestring.Iter.expect_empty _data_src;

()];

test {|"rush"::bytes|}

[%expr

let _data_src = Bytestring.to_iter _data_src in

Bytestring.Iter.expect_literal_string _data_src "rush";

Bytestring.Iter.expect_empty _data_src;

()];

test {|"rush"::bytes(3)|}

[%expr

let _data_src = Bytestring.to_iter _data_src in

Bytestring.Iter.expect_literal_string _data_src ~size:3 "rush";

Bytestring.Iter.expect_empty _data_src;

()];

test

{| fin::1, comp::1, _rsv::2,

1::4, 0::1, 127::7,

len::bits(8*8), mask::32,

payload::bytes(foo len), rest |}

[%expr

let _data_src = Bytestring.to_iter _data_src in

let fin = Bytestring.Iter.next_bits ~size:1 _data_src in

let comp = Bytestring.Iter.next_bits ~size:1 _data_src in

let _rsv = Bytestring.Iter.next_bits ~size:2 _data_src in

Bytestring.Iter.expect_literal_int _data_src ~size:4 1;

Bytestring.Iter.expect_literal_int _data_src ~size:1 0;

Bytestring.Iter.expect_literal_int _data_src ~size:7 127;

let len = Bytestring.Iter.next_bits ~size:(8 * 8) _data_src in

let mask = Bytestring.Iter.next_bits ~size:32 _data_src in

let payload = Bytestring.Iter.next_bytes ~size:(foo len) _data_src in

let rest = Bytestring.Iter.rest _data_src in

Bytestring.Iter.expect_empty _data_src;

()]

let () =

let loc = Location.none in

let test ?guard n strs expected =

let lowers =

List.mapi

(fun idx str ->

let guard = if idx = 0 then guard else None in

let test_name =

id ("test_" ^ string_of_int n ^ "_body_" ^ string_of_int idx)

in

(Bytepattern.parse ~loc str, guard, [%expr [%e test_name]]))

strs

in

let actual = Bytepattern.to_prefix_match ~loc lowers in

let actual =

Format.asprintf "%a" Bytepattern.Prefix_matching.pp [ actual ]

in

let expect = Format.asprintf "%a" Bytepattern.Prefix_matching.pp expected in

if not (String.equal actual expect) then (

Format.printf "%s\n\nExpected:\n\n%s\n\nbut found:\n\n%s\n\n"

(error "#%d Prefix matching trees do not match" n)

expect actual;

assert false)

else Format.printf "match-prefix test #%d %s\r\n%!" n (keyword "OK")

in

(* test: empty pattern is just an empty bytestring *)

test 0 [ {| |}; {| |} ]

[

Prefix

( [ Empty "_data_src" ],

[

Try_run ([], (None, id "test_0_body_0"));

Try_run ([], (None, id "test_0_body_1"));

] );

];

test 1

[

{| hello::8, byte::2, other::3 |}; {| hello::8,byte::2 |}; {| world::10 |};

]

[

Prefix

( [ Create_iterator "_data_src" ],

[

Prefix

( [

Bind_next_fixed_bits

{ src = "hello"; size = 8; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "byte"; size = 2; iter = "_data_src" };

],

[

Try_run

( [

Bind_next_fixed_bits

{ src = "other"; size = 3; iter = "_data_src" };

Empty "_data_src";

],

(None, id "test_1_body_0") );

Try_run ([ Empty "_data_src" ], (None, id "test_1_body_1"));

] );

Try_run

( [

Bind_next_fixed_bits

{ src = "world"; size = 10; iter = "_data_src" };

Empty "_data_src";

],

(None, id "test_1_body_2") );

] );

];

test 2

[

{| fin::1, comp::1, 0::2, 1::4, 0::1, 127::7,

len::bits(compute_bits ()), _mask::32, _payload::bytes(len), rest, |};

{| fin::1, comp::1, 0::2, 1::4, 0::1, 127::7, |};

{| fin::1, comp::1 |};

{| rest |};

]

[

Prefix

( [],

[

Prefix

( [

Create_iterator "_data_src";

Bind_next_fixed_bits

{ src = "fin"; size = 1; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "comp"; size = 1; iter = "_data_src" };

],

[

Prefix

( [

Expect_int_fixed_bits

{ value = 0; size = 2; iter = "_data_src" };

Expect_int_fixed_bits

{ value = 1; size = 4; iter = "_data_src" };

Expect_int_fixed_bits

{ value = 0; size = 1; iter = "_data_src" };

Expect_int_fixed_bits

{ value = 127; size = 7; iter = "_data_src" };

],

[

Try_run

( [

Bind_next_dynamic_bits

{

src = "len";

expr = ocaml "compute_bits ()";

iter = "_data_src";

};

Bind_next_fixed_bits

{ src = "_mask"; size = 32; iter = "_data_src" };

Bind_next_dynamic_bytes

{

src = "_payload";

expr = ocaml "len";

iter = "_data_src";

};

Bind_rest { src = "rest"; iter = "_data_src" };

Empty "_data_src";

],

(None, id "test_2_body_0") );

Try_run

([ Empty "_data_src" ], (None, id "test_2_body_1"));

] );

Try_run ([ Empty "_data_src" ], (None, id "test_2_body_2"));

] );

Try_run

( [ Bypass { src = "_data_src"; name = "rest" } ],

(None, id "test_2_body_3") );

] );

];

test 3 ~guard:[%expr run_guard ()]

[

{| fin :: 1, compressed :: 1, rsv :: 2, opcode :: 4, 1 :: 1, 127 :: 7,

length :: 64, mask :: 32, payload :: bytes(length), rest :: bytes |};

{| fin :: 1, compressed :: 1, rsv :: 2, opcode :: 4, 1 :: 1, 127 :: 7,

length :: 64, mask :: 32, payload :: bytes(length), rest :: bytes |};

{| fin :: 1, compressed :: 1, rsv :: 2, opcode :: 4, 1 :: 1, 127 :: 7,

length :: 64, mask :: 32, payload :: bytes(length), rest :: bytes |};

{| data :: bytes |};

]

[

Prefix

( [],

[

Prefix

( [

Create_iterator "_data_src";

Bind_next_fixed_bits

{ src = "fin"; size = 1; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "compressed"; size = 1; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "rsv"; size = 2; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "opcode"; size = 4; iter = "_data_src" };

Expect_int_fixed_bits

{ value = 1; size = 1; iter = "_data_src" };

Expect_int_fixed_bits

{ value = 127; size = 7; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "length"; size = 64; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "mask"; size = 32; iter = "_data_src" };

Bind_next_dynamic_bytes

{

src = "payload";

expr = ocaml "length";

iter = "_data_src";

};

Bind_rest { src = "rest"; iter = "_data_src" };

Empty "_data_src";

],

[

Try_run ([], (Some (ocaml "run_guard ()"), id "test_3_body_0"));

Try_run ([], (None, id "test_3_body_1"));

Try_run ([], (None, id "test_3_body_2"));

] );

Try_run

( [ Bypass { src = "_data_src"; name = "data" } ],

(None, id "test_3_body_3") );

] );

];

test 4 ~guard:[%expr run_guard ()]

[

{| fin :: 1, compressed :: 1, rsv :: 2, opcode :: 4, 1 :: 1, 127 :: 7,

length :: 64, mask :: 32, payload :: bytes(length), rest :: bytes |};

]

[

Try_run

( [

Create_iterator "_data_src";

Bind_next_fixed_bits { src = "fin"; size = 1; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "compressed"; size = 1; iter = "_data_src" };

Bind_next_fixed_bits { src = "rsv"; size = 2; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "opcode"; size = 4; iter = "_data_src" };

Expect_int_fixed_bits { value = 1; size = 1; iter = "_data_src" };

Expect_int_fixed_bits { value = 127; size = 7; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "length"; size = 64; iter = "_data_src" };

Bind_next_fixed_bits { src = "mask"; size = 32; iter = "_data_src" };

Bind_next_dynamic_bytes

{ src = "payload"; expr = ocaml "length"; iter = "_data_src" };

Bind_rest { src = "rest"; iter = "_data_src" };

Empty "_data_src";

],

(Some (ocaml "run_guard ()"), id "test_4_body_0") );

];

test 5

[

{| fin :: 1, compressed :: 1, rsv :: 2, opcode :: 4, 1 :: 1, 127 :: 7,

length :: 64, mask :: 32, payload :: bytes(length), rest :: bytes |};

{| fin :: 1, compressed :: 1, rsv :: 2, opcode :: 4, 0 :: 1, 126 :: 7,

length :: 16, mask :: 32, payload :: bytes(length * 8), rest :: bytes |};

{| fin :: 1, compressed :: 1, rsv :: 2, opcode :: 4, 0 :: 1,

length :: 7, mask :: 32, payload :: bytes(length * 8), rest :: bytes |};

{| data :: bytes |};

]

[

Prefix

( [],

[

Prefix

( [

Create_iterator "_data_src";

Bind_next_fixed_bits

{ src = "fin"; size = 1; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "compressed"; size = 1; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "rsv"; size = 2; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "opcode"; size = 4; iter = "_data_src" };

],

[

Try_run

( [

Expect_int_fixed_bits

{ value = 1; size = 1; iter = "_data_src" };

Expect_int_fixed_bits

{ value = 127; size = 7; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "length"; size = 64; iter = "_data_src" };

Bind_next_fixed_bits

{ src = "mask"; size = 32; iter = "_data_src" };

Bind_next_dynamic_bytes

{

src = "payload";

expr = ocaml "length";

iter = "_data_src";

};

Bind_rest { src = "rest"; iter = "_data_src" };

Empty "_data_src";

],

(None, id "test_5_body_0") );