From 5e440178e7d9c9a6a71bd192d6319fbe8c6b65fc Mon Sep 17 00:00:00 2001 From: Timothy Bourke Date: Sun, 30 Jan 2022 16:17:44 +0100 Subject: [PATCH 1/3] Fix make on master --- bench/benchmarks.ml | 4 ++-- fuzz/fuzz_rfc2045.ml | 4 ++-- fuzz/fuzz_rfc4648.ml | 11 +++++------ test/test.ml | 6 +++--- 4 files changed, 12 insertions(+), 13 deletions(-) diff --git a/bench/benchmarks.ml b/bench/benchmarks.ml index f0133b1..2ae4345 100644 --- a/bench/benchmarks.ml +++ b/bench/benchmarks.ml @@ -101,9 +101,9 @@ let old_encode_and_decode len = let args = [ 0; 10; 50; 100; 500; 1000; 2500; 5000 ] -let test_b64 = Test.create_indexed ~name:"Base64" ~args b64_encode_and_decode +let test_b64 = Bench.Test.create_indexed ~name:"Base64" ~args b64_encode_and_decode -let test_old = Test.create_indexed ~name:"Old" ~args old_encode_and_decode +let test_old = Bench.Test.create_indexed ~name:"Old" ~args old_encode_and_decode let command = Bench.make_command [ test_b64; test_old ] diff --git a/fuzz/fuzz_rfc2045.ml b/fuzz/fuzz_rfc2045.ml index 7b76488..9e7a891 100644 --- a/fuzz/fuzz_rfc2045.ml +++ b/fuzz/fuzz_rfc2045.ml @@ -8,8 +8,8 @@ exception Decode_error of string let register_printer () = Printexc.register_printer (function - | Encode_error err -> Some (Fmt.strf "(Encoding error: %s)" err) - | Decode_error err -> Some (Fmt.strf "(Decoding error: %s)" err) + | Encode_error err -> Some (Fmt.str "(Encoding error: %s)" err) + | Decode_error err -> Some (Fmt.str "(Decoding error: %s)" err) | _ -> None) let pp_chr = diff --git a/fuzz/fuzz_rfc4648.ml b/fuzz/fuzz_rfc4648.ml index ecab44d..2f461b2 100644 --- a/fuzz/fuzz_rfc4648.ml +++ b/fuzz/fuzz_rfc4648.ml @@ -35,8 +35,7 @@ let pp = pp_scalar ~get:String.get ~length:String.length let ( <.> ) f g x = f (g x) let char_from_alphabet alphabet : string gen = - map [ range 64 ] - (String.make 1 <.> Char.chr <.> Array.unsafe_get (Base64.alphabet alphabet)) + map [ range 64 ] (String.make 1 <.> String.get (Base64.alphabet alphabet)) let random_string_from_alphabet alphabet len : string gen = let rec add_char_from_alphabet acc = function @@ -83,7 +82,7 @@ let ( // ) x y = let canonic alphabet = let dmap = Array.make 256 (-1) in - Array.iteri (fun i x -> dmap.(x) <- i) (Base64.alphabet alphabet) ; + String.iteri (fun i x -> dmap.(Char.code x) <- i) (Base64.alphabet alphabet); fun (input, off, len) -> let real_len = String.length input in let input_len = len in @@ -108,8 +107,8 @@ let canonic alphabet = match remainder_len with 1 -> 0x3c | 2 -> 0x30 | _ -> assert false in let decoded = dmap.(Char.code last) in let canonic = decoded land mask in - let encoded = (Base64.alphabet alphabet).(canonic) in - Bytes.set output (off + input_len - 1) (Char.chr encoded) ; + let encoded = (Base64.alphabet alphabet).[canonic] in + Bytes.set output (off + input_len - 1) encoded ; (Bytes.unsafe_to_string output, off, normalized_len) let isomorphism0 (input, off, len) = @@ -145,7 +144,7 @@ let range_of_max max : (int * int) gen = dynamic_bind (range (max / 2)) @@ fun off -> map [ range (max - off) ] (fun len -> (off, len)) -let failf fmt = Fmt.kstrf fail fmt +let failf fmt = Fmt.kstr fail fmt let no_exception pad off len input = try diff --git a/test/test.ml b/test/test.ml index 41a4b9a..8117edb 100644 --- a/test/test.ml +++ b/test/test.ml @@ -269,7 +269,7 @@ let strict_base64_rfc2045_to_string x = let test_strict_with_malformed_input_rfc2045 = List.mapi (fun i (has, _) -> - Alcotest.test_case (Fmt.strf "strict rfc2045 - %02d" i) `Quick + Alcotest.test_case (Fmt.str "strict rfc2045 - %02d" i) `Quick @@ fun () -> try let _ = strict_base64_rfc2045_of_string has in @@ -280,7 +280,7 @@ let test_strict_with_malformed_input_rfc2045 = let test_strict_rfc2045 = List.mapi (fun i (has, expect) -> - Alcotest.test_case (Fmt.strf "strict rfc2045 - %02d" i) `Quick + Alcotest.test_case (Fmt.str "strict rfc2045 - %02d" i) `Quick @@ fun () -> try let res0 = strict_base64_rfc2045_of_string has in @@ -293,7 +293,7 @@ let test_strict_rfc2045 = let test_relaxed_rfc2045 = List.mapi (fun i (has, expect) -> - Alcotest.test_case (Fmt.strf "relaxed rfc2045 - %02d" i) `Quick + Alcotest.test_case (Fmt.str "relaxed rfc2045 - %02d" i) `Quick @@ fun () -> let res0 = relaxed_base64_rfc2045_of_string has in Alcotest.(check string) "decode(x)" res0 expect) From 3414e065ad43bc3b61e6fd8a4d56a649f0897b99 Mon Sep 17 00:00:00 2001 From: Romain Calascibetta Date: Mon, 31 Jan 2022 15:11:42 +0100 Subject: [PATCH 2/3] Run benchmarks only into a specific dune's profile --- bench/dune | 1 + dune-project | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/bench/dune b/bench/dune index 8c5b1e0..bac91b3 100644 --- a/bench/dune +++ b/bench/dune @@ -1,3 +1,4 @@ (executable (name benchmarks) + (enabled_if (= %{profile} benchmark)) (libraries base64 core_bench)) diff --git a/dune-project b/dune-project index 2af7ef7..f719bf6 100644 --- a/dune-project +++ b/dune-project @@ -1,2 +1,2 @@ -(lang dune 2.0) +(lang dune 2.3) (name base64) From d8780f18f48b6db205eb1e5414b9c6101e288589 Mon Sep 17 00:00:00 2001 From: Romain Calascibetta Date: Mon, 31 Jan 2022 15:13:36 +0100 Subject: [PATCH 3/3] Allow to run fuzzers only into a specific dune's context --- fuzz/dune | 2 ++ 1 file changed, 2 insertions(+) diff --git a/fuzz/dune b/fuzz/dune index 9dd8385..3e21436 100644 --- a/fuzz/dune +++ b/fuzz/dune @@ -1,9 +1,11 @@ (executable (name fuzz_rfc2045) + (enabled_if (= %{profile} fuzz)) (modules fuzz_rfc2045) (libraries astring crowbar fmt base64.rfc2045)) (executable (name fuzz_rfc4648) + (enabled_if (= %{profile} fuzz)) (modules fuzz_rfc4648) (libraries astring crowbar fmt base64))