mirror of
https://github.com/c-cube/tiny_httpd.git
synced 2025-12-06 11:15:35 -05:00
remove dep on ounit2 and qtest
This commit is contained in:
parent
0908d71e19
commit
82ebf85ee7
5 changed files with 75 additions and 76 deletions
|
|
@ -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))
|
|
||||||
*)
|
|
||||||
|
|
|
||||||
|
|
@ -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
4
tests/unit/dune
Normal 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
70
tests/unit/t_util.ml
Normal 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
|
||||||
|
|
@ -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" ]
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue