diff --git a/src/Tiny_httpd_util.ml b/src/Tiny_httpd_util.ml index b5009de0..f2b769e2 100644 --- a/src/Tiny_httpd_util.ml +++ b/src/Tiny_httpd_util.ml @@ -1,3 +1,14 @@ + +(* test utils *) +(*$inject + let pp_res f = function Ok x -> f x | Error e -> Printexc.to_string e + let pp_res_query = (Q.Print.(pp_res (list (pair string string)))) + let err_map f = function Ok x-> Ok (f x) | Error e -> Error e + let sort_l l = List.sort compare l + let eq_sorted a b = (=) (err_map sort_l a)(err_map sort_l b) + let is_ascii_char c = Char.code c < 128 +*) + let percent_encode ?(skip=fun _->false) s = let buf = Buffer.create (String.length s) in String.iter @@ -11,6 +22,12 @@ let percent_encode ?(skip=fun _->false) s = s; Buffer.contents buf +(*$= & ~printer:(fun s->s) + "hello%20world" (percent_encode "hello world") + "%23%25^%24%40^%40" (percent_encode "#%^$@^@") + "a%20ohm%2b5235%25%26%40%23%20---%20_" (percent_encode "a ohm+5235%&@# --- _") +*) + let hex_int (s:string) : int = Scanf.sscanf s "%x" (fun x->x) let percent_decode (s:string) : _ option = @@ -35,6 +52,13 @@ let percent_decode (s:string) : _ option = Some (Buffer.contents buf) with Exit -> None +(*$QR & ~count:1_000 ~long_factor:20 + Q.string (fun s -> + String.iter (fun c -> Q.assume @@ is_ascii_char c) s; + match percent_decode (percent_encode s) with + | Some s' -> s=s' + | None -> Q.Test.fail_report "invalid percent encoding") +*) let parse_query s : (_ list, _) result= let pairs = ref [] in @@ -63,3 +87,19 @@ let parse_query s : (_ list, _) result= Ok !pairs with e -> Error e +(*$= & ~printer:pp_res_query ~cmp:eq_sorted + (Ok ["a", "b"; "c", "d"]) (parse_query "a=b&c=d") +*) + +(*$QR & ~long_factor:20 ~count:1_000 + Q.(small_list (pair string string)) + (fun l -> + List.iter (fun (a,b) -> + Q.assume (a<>"" && b<>"" ); + String.iter (fun c -> Q.assume @@ is_ascii_char c) a; + String.iter (fun c -> Q.assume @@ is_ascii_char c) b; + ) l; + let s = String.concat "&" + (List.map (fun (x,y) -> percent_encode x ^"="^percent_encode y) l) in + eq_sorted (Ok l) (parse_query s)) +*) diff --git a/src/dune b/src/dune index 202dbcb0..1ee3eba7 100644 --- a/src/dune +++ b/src/dune @@ -3,5 +3,6 @@ (name tiny_httpd) (public_name tiny_httpd) (libraries threads) + (inline_tests (backend qtest.lib)) (flags :standard -safe-string) (wrapped false)) diff --git a/tiny_httpd.opam b/tiny_httpd.opam index 88d178a5..f76c5e23 100644 --- a/tiny_httpd.opam +++ b/tiny_httpd.opam @@ -14,6 +14,8 @@ depends: [ "base-threads" "ocaml" { >= "4.03.0" } "odoc" {with-doc} + "qtest" {with-test} + "qcheck" {with-test} ] tags: [ "http" "thread" "server" "tiny_httpd" "http_of_dir" "simplehttpserver" ] homepage: "https://github.com/c-cube/tiny_httpd/"