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; ]; () (** Lowered representation of the pattern language for Constructing matches *) 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"; ]; () (** Bytestring construction tests *) 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"; ]; () (** Bytestring matching tests *) 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; ()] (** Bytestring prefix optimizatoin tests *) 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") ); Try_run ( [ Expect_int_fixed_bits { value = 0; size = 1; iter = "_data_src" }; Expect_int_fixed_bits { value = 126; size = 7; iter = "_data_src" }; Bind_next_fixed_bits { src = "length"; size = 16; iter = "_data_src" }; Bind_next_fixed_bits { src = "mask"; size = 32; iter = "_data_src" }; Bind_next_dynamic_bytes { src = "payload"; expr = ocaml "length * 8"; iter = "_data_src"; }; Bind_rest { src = "rest"; iter = "_data_src" }; Empty "_data_src"; ], (None, id "test_5_body_1") ); Try_run ( [ Expect_int_fixed_bits { value = 0; size = 1; iter = "_data_src" }; Bind_next_fixed_bits { src = "length"; size = 7; iter = "_data_src" }; Bind_next_fixed_bits { src = "mask"; size = 32; iter = "_data_src" }; Bind_next_dynamic_bytes { src = "payload"; expr = ocaml "length * 8"; iter = "_data_src"; }; Bind_rest { src = "rest"; iter = "_data_src" }; Empty "_data_src"; ], (None, id "test_5_body_2") ); ] ); Try_run ( [ Bypass { src = "_data_src"; name = "data" } ], (None, id "test_5_body_3") ); ] ); ]; () (** Bytestring prefix matching tests *) 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_match_expression ~loc ~data:[%expr data] lowers in let actual = Ppxlib.Pprintast.string_of_expression actual in let expect = Ppxlib.Pprintast.string_of_expression 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 OCaml ASTs do not match" n) expect actual; assert false) else Format.printf "match test #%d %s\r\n%!" n (keyword "OK") in (* test: empty pattern is just an empty bytestring *) test 0 [ {| |}; {| |} ] [%expr (fun _data_src -> Bytestring.Iter.expect_empty _data_src; try test_0_body_0 with Bytestring.No_match -> ( try test_0_body_1 with Bytestring.No_match -> raise Bytestring.No_match)) data]; test 1 [ {| hello::8, byte::2, other::3 |}; {| hello::8,byte::2 |}; {| world::10 |}; ] [%expr (fun _data_src -> let _data_src = Bytestring.to_iter _data_src in try let hello = Bytestring.Iter.next_bits ~size:8 _data_src in let byte = Bytestring.Iter.next_bits ~size:2 _data_src in try let other = Bytestring.Iter.next_bits ~size:3 _data_src in Bytestring.Iter.expect_empty _data_src; test_1_body_0 with Bytestring.No_match -> ( try Bytestring.Iter.expect_empty _data_src; test_1_body_1 with Bytestring.No_match -> raise Bytestring.No_match) with Bytestring.No_match -> ( try let world = Bytestring.Iter.next_bits ~size:10 _data_src in Bytestring.Iter.expect_empty _data_src; test_1_body_2 with Bytestring.No_match -> raise Bytestring.No_match)) data]; 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 |}; ] [%expr (fun _data_src -> try 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 try Bytestring.Iter.expect_literal_int _data_src ~size:2 0; 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; try let len = Bytestring.Iter.next_bits ~size:(compute_bits ()) _data_src in let _mask = Bytestring.Iter.next_bits ~size:32 _data_src in let _payload = Bytestring.Iter.next_bytes ~size:len _data_src in let rest = Bytestring.Iter.rest _data_src in Bytestring.Iter.expect_empty _data_src; test_2_body_0 with Bytestring.No_match -> ( try Bytestring.Iter.expect_empty _data_src; test_2_body_1 with Bytestring.No_match -> raise Bytestring.No_match) with Bytestring.No_match -> ( try Bytestring.Iter.expect_empty _data_src; test_2_body_2 with Bytestring.No_match -> raise Bytestring.No_match) with Bytestring.No_match -> ( try let rest = _data_src in test_2_body_3 with Bytestring.No_match -> raise Bytestring.No_match)) data]; 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 |}; {| data :: bytes |}; ] [%expr (fun _data_src -> try let _data_src = Bytestring.to_iter _data_src in let fin = Bytestring.Iter.next_bits ~size:1 _data_src in let compressed = Bytestring.Iter.next_bits ~size:1 _data_src in let rsv = Bytestring.Iter.next_bits ~size:2 _data_src in let opcode = Bytestring.Iter.next_bits ~size:4 _data_src in Bytestring.Iter.expect_literal_int _data_src ~size:1 1; Bytestring.Iter.expect_literal_int _data_src ~size:7 127; let length = Bytestring.Iter.next_bits ~size:64 _data_src in let mask = Bytestring.Iter.next_bits ~size:32 _data_src in let payload = Bytestring.Iter.next_bytes ~size:length _data_src in let rest = Bytestring.Iter.rest _data_src in Bytestring.Iter.expect_empty _data_src; if run_guard () then test_3_body_0 else test_3_body_1 with Bytestring.No_match -> ( try let data = _data_src in test_3_body_2 with Bytestring.No_match -> raise Bytestring.No_match)) data]; 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 |}; {| fin :: 1, compressed :: 1, rsv :: 2, opcode :: 4, 1 :: 1, 127 :: 7, length :: 64, mask :: 32, payload :: bytes(length), rest :: bytes |}; ] [%expr (fun _data_src -> let _data_src = Bytestring.to_iter _data_src in let fin = Bytestring.Iter.next_bits ~size:1 _data_src in let compressed = Bytestring.Iter.next_bits ~size:1 _data_src in let rsv = Bytestring.Iter.next_bits ~size:2 _data_src in let opcode = Bytestring.Iter.next_bits ~size:4 _data_src in Bytestring.Iter.expect_literal_int _data_src ~size:1 1; Bytestring.Iter.expect_literal_int _data_src ~size:7 127; let length = Bytestring.Iter.next_bits ~size:64 _data_src in let mask = Bytestring.Iter.next_bits ~size:32 _data_src in let payload = Bytestring.Iter.next_bytes ~size:length _data_src in let rest = Bytestring.Iter.rest _data_src in Bytestring.Iter.expect_empty _data_src; if run_guard () then test_4_body_0 else test_4_body_1) data]; 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\r\n\r" :: bytes |}; {| data :: bytes |}; ] [%expr (fun _data_src -> try let _data_src = Bytestring.to_iter _data_src in let fin = Bytestring.Iter.next_bits ~size:1 _data_src in let compressed = Bytestring.Iter.next_bits ~size:1 _data_src in let rsv = Bytestring.Iter.next_bits ~size:2 _data_src in let opcode = Bytestring.Iter.next_bits ~size:4 _data_src in try Bytestring.Iter.expect_literal_int _data_src ~size:1 1; Bytestring.Iter.expect_literal_int _data_src ~size:7 127; let length = Bytestring.Iter.next_bits ~size:64 _data_src in let mask = Bytestring.Iter.next_bits ~size:32 _data_src in let payload = Bytestring.Iter.next_bytes ~size:length _data_src in let rest = Bytestring.Iter.rest _data_src in Bytestring.Iter.expect_empty _data_src; test_5_body_0 with Bytestring.No_match -> ( try Bytestring.Iter.expect_literal_int _data_src ~size:1 0; Bytestring.Iter.expect_literal_int _data_src ~size:7 126; let length = Bytestring.Iter.next_bits ~size:16 _data_src in let mask = Bytestring.Iter.next_bits ~size:32 _data_src in let payload = Bytestring.Iter.next_bytes ~size:(length * 8) _data_src in let rest = Bytestring.Iter.rest _data_src in Bytestring.Iter.expect_empty _data_src; test_5_body_1 with Bytestring.No_match -> ( try Bytestring.Iter.expect_literal_int _data_src ~size:1 0; let length = Bytestring.Iter.next_bits ~size:7 _data_src in let mask = Bytestring.Iter.next_bits ~size:32 _data_src in let payload = Bytestring.Iter.next_bytes ~size:(length * 8) _data_src in Bytestring.Iter.expect_literal_string _data_src "rest\r\n\r"; Bytestring.Iter.expect_empty _data_src; test_5_body_2 with Bytestring.No_match -> raise Bytestring.No_match)) with Bytestring.No_match -> ( try let data = _data_src in test_5_body_3 with Bytestring.No_match -> raise Bytestring.No_match)) data]; ()