remove dep on ounit2 and qtest

This commit is contained in:
Simon Cruanes 2023-05-24 15:13:27 -04:00
parent 0908d71e19
commit 82ebf85ee7
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
5 changed files with 75 additions and 76 deletions

View file

@ -1,13 +1,3 @@
(* test utils *)
(*$inject
let pp_res f = function Ok x -> f x | Error e -> 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 percent_encode ?(skip = fun _ -> false) s =
let buf = Buffer.create (String.length s) in let buf = Buffer.create (String.length s) in
String.iter String.iter
@ -21,16 +11,6 @@ let percent_encode ?(skip = fun _ -> false) s =
s; s;
Buffer.contents buf 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%&@# --- _")
*)
(*$= & ~printer:Q.(Print.(option string))
(Some "?") (percent_decode @@ percent_encode "?")
*)
let hex_int (s : string) : int = Scanf.sscanf s "%x" (fun x -> x) let hex_int (s : string) : int = Scanf.sscanf s "%x" (fun x -> x)
let percent_decode (s : string) : _ option = let percent_decode (s : string) : _ option =
@ -57,14 +37,6 @@ let percent_decode (s : string) : _ option =
Some (Buffer.contents buf) Some (Buffer.contents buf)
with Exit -> None 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")
*)
exception Invalid_query exception Invalid_query
let find_q_index_ s = String.index s '?' let find_q_index_ s = String.index s '?'
@ -96,16 +68,6 @@ let split_on_slash s : _ list =
done; done;
List.rev !l List.rev !l
(*$= & ~printer:Q.Print.(list string)
["a"; "b"] (split_on_slash "/a/b")
["coucou"; "lol"] (split_on_slash "/coucou/lol")
["a"; "b"; "c"] (split_on_slash "/a/b//c/")
["a"; "b"] (split_on_slash "//a/b/")
["a"] (split_on_slash "/a//")
[] (split_on_slash "/")
[] (split_on_slash "//")
*)
let parse_query s : (_ list, string) result = let parse_query s : (_ list, string) result =
let pairs = ref [] in let pairs = ref [] in
let is_sep_ = function let is_sep_ = function
@ -145,20 +107,3 @@ let parse_query s : (_ list, string) result =
| Invalid_argument _ | Not_found | Failure _ -> | Invalid_argument _ | Not_found | Failure _ ->
Error (Printf.sprintf "error in parse_query for %S: i=%d,j=%d" s !i !j) Error (Printf.sprintf "error in parse_query for %S: i=%d,j=%d" s !i !j)
| Invalid_query -> Error ("invalid query string: " ^ s) | Invalid_query -> Error ("invalid query string: " ^ s)
(*$= & ~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))
*)

View file

@ -1,18 +0,0 @@
(executable
(name qtest)
(modes native)
(flags :standard -warn-error -a+8 -w -33)
(libraries qcheck-core qcheck ounit2 threads threads.posix tiny_httpd))
(rule
(deps
(glob_files ../*.ml{,i}))
(targets qtest.ml)
(action
(run qtest extract --quiet %{deps} -o %{targets})))
(rule
(alias runtest)
(package tiny_httpd)
(action
(run ./qtest.exe)))

4
tests/unit/dune Normal file
View file

@ -0,0 +1,4 @@
(test
(name t_util)
(libraries tiny_httpd qcheck-core qcheck-core.runner))

70
tests/unit/t_util.ml Normal file
View file

@ -0,0 +1,70 @@
module Q = QCheck
(* test utils *)
let pp_res f = function
| Ok x -> f x
| Error e -> 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 assert_eq ?(cmp = ( = )) a b = assert (cmp a b)
open Tiny_httpd_util
let qchecks = ref []
let add_qcheck f = qchecks := f :: !qchecks
let () = assert_eq "hello%20world" (percent_encode "hello world")
let () = assert_eq "%23%25^%24%40^%40" (percent_encode "#%^$@^@")
let () =
assert_eq "a%20ohm%2B5235%25%26%40%23%20---%20_"
(percent_encode "a ohm+5235%&@# --- _")
let () = assert_eq (Some "?") (percent_decode @@ percent_encode "?")
let () =
add_qcheck
@@ QCheck.Test.make ~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 () = assert_eq [ "a"; "b" ] (split_on_slash "/a/b")
let () = assert_eq [ "coucou"; "lol" ] (split_on_slash "/coucou/lol")
let () = assert_eq [ "a"; "b"; "c" ] (split_on_slash "/a/b//c/")
let () = assert_eq [ "a"; "b" ] (split_on_slash "//a/b/")
let () = assert_eq [ "a" ] (split_on_slash "/a//")
let () = assert_eq [] (split_on_slash "/")
let () = assert_eq [] (split_on_slash "//")
let () =
assert_eq ~cmp:eq_sorted (Ok [ "a", "b"; "c", "d" ]) (parse_query "a=b&c=d")
let () =
add_qcheck
@@ QCheck.Test.make ~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))
let () = exit @@ QCheck_base_runner.run_tests ~colors:false !qchecks

View file

@ -16,10 +16,8 @@ depends: [
"seq" "seq"
"ocaml" { >= "4.04.0" } "ocaml" { >= "4.04.0" }
"odoc" {with-doc} "odoc" {with-doc}
"qtest" { >= "2.9" & with-test}
"conf-libcurl" {with-test} "conf-libcurl" {with-test}
"qcheck" {with-test & >= "0.9" } "qcheck-core" {with-test & >= "0.9" }
"ounit2" {with-test}
"ptime" {with-test} "ptime" {with-test}
] ]
tags: [ "http" "thread" "server" "tiny_httpd" "http_of_dir" "simplehttpserver" ] tags: [ "http" "thread" "server" "tiny_httpd" "http_of_dir" "simplehttpserver" ]