Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use ocamlformat 0.14.1 #45

Merged
merged 3 commits into from
May 4, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 8 additions & 0 deletions .ocamlformat
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
version = 0.14.1
break-infix = fit-or-vertical
parse-docstrings = true
indicate-multiline-delimiters=no
nested-match=align
sequence-style=separator
break-before-in=auto
if-then-else=keyword-first
19 changes: 0 additions & 19 deletions .travis.yml

This file was deleted.

31 changes: 13 additions & 18 deletions bench/benchmarks.ml
Original file line number Diff line number Diff line change
Expand Up @@ -15,18 +15,17 @@ module Old_version = struct
let decode ?alphabet input =
let length = String.length input in
let input =
if length mod 4 = 0 then input
else input ^ String.make (4 - (length mod 4)) padding
in
if length mod 4 = 0
then input
else input ^ String.make (4 - (length mod 4)) padding in
let length = String.length input in
let words = length / 4 in
let padding =
match length with
| 0 -> 0
| _ when input.[length - 2] = padding -> 2
| _ when input.[length - 1] = padding -> 1
| _ -> 0
in
| _ -> 0 in
let output = Bytes.make ((words * 3) - padding) '\000' in
for i = 0 to words - 1 do
let a = of_char ?alphabet input.[(4 * i) + 0]
Expand All @@ -38,10 +37,10 @@ module Old_version = struct
and y = (n lsr 8) land 255
and z = n land 255 in
Bytes.set output ((3 * i) + 0) (char_of_int x) ;
if i <> words - 1 || padding < 2 then
Bytes.set output ((3 * i) + 1) (char_of_int y) ;
if i <> words - 1 || padding < 1 then
Bytes.set output ((3 * i) + 2) (char_of_int z)
if i <> words - 1 || padding < 2
then Bytes.set output ((3 * i) + 1) (char_of_int y) ;
if i <> words - 1 || padding < 1
then Bytes.set output ((3 * i) + 2) (char_of_int z)
done ;
Bytes.unsafe_to_string output

Expand Down Expand Up @@ -71,7 +70,8 @@ module Old_version = struct
for i = 1 to padding_len do
Bytes.set output (Bytes.length output - i) padding
done ;
if pad then Bytes.unsafe_to_string output
if pad
then Bytes.unsafe_to_string output
else Bytes.sub_string output 0 (Bytes.length output - padding_len)
end

Expand Down Expand Up @@ -101,15 +101,10 @@ 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 = 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 = Test.create_indexed ~name:"Old" ~args old_encode_and_decode

let command =
Bench.make_command [ test_b64; test_old ]
let command = Bench.make_command [ test_b64; test_old ]

let () = Command.run command
2 changes: 1 addition & 1 deletion bench/dune
Original file line number Diff line number Diff line change
@@ -1,3 +1,3 @@
(executable
(name benchmarks)
(libraries base64 core_bench))
(libraries base64 core_bench))
56 changes: 31 additions & 25 deletions config/config.ml
Original file line number Diff line number Diff line change
@@ -1,48 +1,54 @@
module Config = Configurator.V1

let pre407 = {ocaml|external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_string_set16u" [@@noalloc]|ocaml}
let standard = {ocaml|external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_bytes_set16u" [@@noalloc]|ocaml}
let pre407 =
{ocaml|external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_string_set16u" [@@noalloc]|ocaml}

type t =
{ major : int
; minor : int
; patch : int option
; extra : string option }
let standard =
{ocaml|external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_bytes_set16u" [@@noalloc]|ocaml}

let v ?patch ?extra major minor = { major; minor; patch; extra; }
type t = { major : int; minor : int; patch : int option; extra : string option }

let v ?patch ?extra major minor = { major; minor; patch; extra }

let parse s =
try Scanf.sscanf s "%d.%d.%d+%s" (fun major minor patch extra -> v ~patch ~extra major minor)
with End_of_file | Scanf.Scan_failure _ ->
( try Scanf.sscanf s "%d.%d+%s" (fun major minor extra -> v ~extra major minor)
try
Scanf.sscanf s "%d.%d.%d+%s" (fun major minor patch extra ->
v ~patch ~extra major minor)
with End_of_file | Scanf.Scan_failure _ -> (
try
Scanf.sscanf s "%d.%d+%s" (fun major minor extra -> v ~extra major minor)
with End_of_file | Scanf.Scan_failure _ -> (
try
Scanf.sscanf s "%d.%d.%d" (fun major minor patch ->
v ~patch major minor)
with End_of_file | Scanf.Scan_failure _ ->
( try Scanf.sscanf s "%d.%d.%d" (fun major minor patch -> v ~patch major minor)
with End_of_file | Scanf.Scan_failure _ ->
Scanf.sscanf s "%d.%d" (fun major minor -> v major minor) ) )
Scanf.sscanf s "%d.%d" (fun major minor -> v major minor)))

let ( >|= ) x f = match x with
| Some x -> Some (f x )
| None -> None
let ( >|= ) x f = match x with Some x -> Some (f x) | None -> None

let ocaml_cp ~src ~dst =
let ic = open_in src in
let oc = open_out dst in
let bf = Bytes.create 0x1000 in
let rec go () = match input ic bf 0 (Bytes.length bf) with
let rec go () =
match input ic bf 0 (Bytes.length bf) with
| 0 -> ()
| len -> output oc bf 0 len ; go ()
| len ->
output oc bf 0 len ;
go ()
| exception End_of_file -> () in
go () ; close_in ic ; close_out oc
;;
go () ;
close_in ic ;
close_out oc

let () =
Config.main ~name:"config-base64" @@ fun t ->
match Config.ocaml_config_var t "version" >|= parse with
| Some version ->
let dst = "unsafe.ml" in
let dst = "unsafe.ml" in

if (version.major, version.minor) >= (4, 7)
then ocaml_cp ~src:"unsafe_stable.ml" ~dst
else ocaml_cp ~src:"unsafe_pre407.ml" ~dst
if (version.major, version.minor) >= (4, 7)
then ocaml_cp ~src:"unsafe_stable.ml" ~dst
else ocaml_cp ~src:"unsafe_pre407.ml" ~dst
| None -> Config.die "OCaml version is not available"
| exception exn -> Config.die "Got an exception: %s" (Printexc.to_string exn)
3 changes: 1 addition & 2 deletions dune-project
Original file line number Diff line number Diff line change
@@ -1,3 +1,2 @@
(lang dune 1.0)
(lang dune 2.0)
(name base64)
(version dev)
2 changes: 1 addition & 1 deletion fuzz/dune
Original file line number Diff line number Diff line change
Expand Up @@ -6,4 +6,4 @@
(executable
(name fuzz_rfc4648)
(modules fuzz_rfc4648)
(libraries astring crowbar fmt base64))
(libraries astring crowbar fmt base64))
61 changes: 29 additions & 32 deletions fuzz/fuzz_rfc2045.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
open Crowbar

exception Encode_error of string

exception Decode_error of string

(** Pretty printers *)
Expand All @@ -9,30 +10,32 @@ 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)
| _ -> None )
| _ -> None)

let pp_chr =
let escaped = function ' ' .. '~' as c -> String.make 1 c | _ -> "." in
Fmt.using escaped Fmt.string

let pp_scalar : type buffer.
let pp_scalar :
type buffer.
get:(buffer -> int -> char) -> length:(buffer -> int) -> buffer Fmt.t =
fun ~get ~length ppf b ->
let l = length b in
for i = 0 to l / 16 do
Fmt.pf ppf "%08x: " (i * 16) ;
let j = ref 0 in
while !j < 16 do
if (i * 16) + !j < l then
Fmt.pf ppf "%02x" (Char.code @@ get b ((i * 16) + !j))
if (i * 16) + !j < l
then Fmt.pf ppf "%02x" (Char.code @@ get b ((i * 16) + !j))
else Fmt.pf ppf " " ;
if !j mod 2 <> 0 then Fmt.pf ppf " " ;
incr j
done ;
Fmt.pf ppf " " ;
j := 0 ;
while !j < 16 do
if (i * 16) + !j < l then Fmt.pf ppf "%a" pp_chr (get b ((i * 16) + !j))
if (i * 16) + !j < l
then Fmt.pf ppf "%a" pp_chr (get b ((i * 16) + !j))
else Fmt.pf ppf " " ;
incr j
done ;
Expand All @@ -46,18 +49,18 @@ let pp = pp_scalar ~get:String.get ~length:String.length
let check_encode str =
let subs = Astring.String.cuts ~sep:"\r\n" str in
let check str =
if String.length str > 78 then
raise (Encode_error "too long string returned")
in
List.iter check subs ; str
if String.length str > 78
then raise (Encode_error "too long string returned") in
List.iter check subs ;
str

let encode input =
let buf = Buffer.create 80 in
let encoder = Base64_rfc2045.encoder (`Buffer buf) in
String.iter
(fun c ->
let ret = Base64_rfc2045.encode encoder (`Char c) in
match ret with `Ok -> () | _ -> assert false )
match ret with `Ok -> () | _ -> assert false)
(* XXX(dinosaure): [`Partial] can never occur. *)
input ;
let encode = Base64_rfc2045.encode encoder `End in
Expand All @@ -68,23 +71,22 @@ let encode input =
let decode input =
let decoder = Base64_rfc2045.decoder (`String input) in
let rec go acc =
if Base64_rfc2045.decoder_dangerous decoder then
raise (Decode_error "Dangerous input") ;
if Base64_rfc2045.decoder_dangerous decoder
then raise (Decode_error "Dangerous input") ;
match Base64_rfc2045.decode decoder with
| `End -> List.rev acc
| `Flush output -> go (output :: acc)
| `Malformed _ -> raise (Decode_error "Malformed")
| `Wrong_padding -> raise (Decode_error "Wrong padding")
| _ -> (* XXX(dinosaure): [`Await] can never occur. *) assert false
in
| _ -> (* XXX(dinosaure): [`Await] can never occur. *) assert false in
String.concat "" (go [])

(** String generators *)

let bytes_fixed_range : string gen = dynamic_bind (range 78) bytes_fixed

let char_from_alpha alpha : string gen =
map [range (String.length alpha)] (fun i -> alpha.[i] |> String.make 1)
map [ range (String.length alpha) ] (fun i -> alpha.[i] |> String.make 1)

let string_from_alpha n =
let acc = const "" in
Expand All @@ -93,9 +95,8 @@ let string_from_alpha n =
| 0 -> acc
| n ->
add_char_from_alpha alpha
(concat_gen_list (const "") [acc; char_from_alpha alpha])
(n - 1)
in
(concat_gen_list (const "") [ acc; char_from_alpha alpha ])
(n - 1) in
add_char_from_alpha alpha acc n

let random_string_from_alpha n = dynamic_bind (range n) string_from_alpha
Expand All @@ -106,23 +107,20 @@ let bytes_fixed_range_from_alpha : string gen =
let set_canonic str =
let l = String.length str in
let to_drop = l * 6 mod 8 in
if
to_drop = 6
(* XXX(clecat): Case when we need to drop 6 bits which means a whole letter *)
if to_drop = 6
(* XXX(clecat): Case when we need to drop 6 bits which means a whole letter *)
then String.sub str 0 (l - 1)
else if
to_drop <> 0
(* XXX(clecat): Case when we need to drop 2 or 4 bits: we apply a mask droping the bits *)
else if to_drop <> 0
(* XXX(clecat): Case when we need to drop 2 or 4 bits: we apply a mask droping the bits *)
then (
let buf = Bytes.of_string str in
let value =
String.index Base64_rfc2045.default_alphabet (Bytes.get buf (l - 1))
in
String.index Base64_rfc2045.default_alphabet (Bytes.get buf (l - 1)) in
let canonic =
Base64_rfc2045.default_alphabet.[value land lnot ((1 lsl to_drop) - 1)]
in
Bytes.set buf (l - 1) canonic ;
Bytes.unsafe_to_string buf )
Bytes.unsafe_to_string buf)
else str

let add_padding str =
Expand All @@ -140,19 +138,18 @@ let e2d inputs =

let d2e inputs end_input =
let end_input = add_padding end_input in
let inputs = inputs @ [end_input] in
let inputs = inputs @ [ end_input ] in
let input =
List.fold_left
(fun acc s -> if String.length s <> 0 then acc ^ "\r\n" ^ s else acc)
(List.hd inputs) (List.tl inputs)
in
(List.hd inputs) (List.tl inputs) in
let decode = decode input in
let encode = encode decode in
check_eq ~pp ~cmp:String.compare ~eq:String.equal input encode

let () =
register_printer () ;
add_test ~name:"rfc2045: encode -> decode" [list bytes_fixed_range] e2d ;
add_test ~name:"rfc2045: encode -> decode" [ list bytes_fixed_range ] e2d ;
add_test ~name:"rfc2045: decode -> encode"
[list (string_from_alpha 76); random_string_from_alpha 76]
[ list (string_from_alpha 76); random_string_from_alpha 76 ]
d2e
Loading