Skip to content

Commit

Permalink
Add unitary tests for [Cohttp.Header] module and change existing test…
Browse files Browse the repository at this point in the history 
…s to match the new implementation.
  • Loading branch information
@lyrm
lyrm committed Feb 8, 2021
1 parent c26abae commit 9e19c11
Show file tree
Hide file tree
Showing 4 changed files with 363 additions and 113 deletions.
4 changes: 2 additions & 2 deletions cohttp-lwt-unix/test/test_parser.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -244,14 +244,14 @@ let write_req expected req =
let make_simple_req () =
let open Cohttp in
let open Cohttp_lwt_unix in
let expected = "POST /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\ntransfer-encoding: chunked\r\nuser-agent: "^user_agent^"\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n" in
let expected = "POST /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\nuser-agent: "^user_agent^"\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n" in
let req = Request.make ~encoding:Transfer.Chunked ~meth:`POST ~headers:(Header.init_with "Foo" "bar") (Uri.of_string "/foo/bar") in
write_req expected req

let mutate_simple_req () =
let open Cohttp in
let open Cohttp_lwt_unix in
let expected = "POST /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\ntransfer-encoding: chunked\r\nuser-agent: "^user_agent^"\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n" in
let expected = "POST /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\nuser-agent: "^user_agent^"\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n" in
let req = Request.make ~encoding:Transfer.Chunked ~headers:(Header.init_with "foo" "bar") (Uri.of_string "/foo/bar") in
let req = Fieldslib.Field.fset Request.Fields.meth req `POST in
write_req expected req
Expand Down
2 changes: 1 addition & 1 deletion cohttp/test/dune
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@

(executable
(name test_header)
(modules test_header)
(modules unitary_test_header test_header)
(libraries cohttp alcotest fmt))

(rule
Expand Down
113 changes: 3 additions & 110 deletions cohttp/test/test_header.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,11 +13,9 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*}}}*)

open Printf

module String_io = Cohttp__String_io
module StringResponse = Cohttp.Response.Make(String_io.M)
module HIO = Cohttp__Header_io.Make(String_io.M)
module H = Cohttp.Header

let aes = Alcotest.check Alcotest.string
Expand Down Expand Up @@ -94,89 +92,6 @@ let get_media_type () =
Alcotest.check Alcotest.(option string) "media type"
(Some "foo/bar") (Cohttp.Header.get_media_type header)

let list_valued_header () =
let h = H.init () in
let h = H.add h "accept" "foo" in
let h = H.add h "accept" "bar" in
aeso "list valued header" (H.get h "accept") (Some "bar,foo")

let t_header =
Alcotest.testable (fun fmt h ->
let sexp = Cohttp.Header.sexp_of_t h in
Sexplib0.Sexp.pp_hum fmt sexp
) (fun x y -> Cohttp.Header.compare x y = 0)

let large_header () =
let sz = 1024 * 1024 * 100 in
let h = H.init () in
let v1 = String.make sz 'a' in
let h = H.add h "x-large" v1 in
let h = H.add h v1 "foo" in
aeso "x-large" (H.get h "x-large") (Some v1);
let obuf = Buffer.create (sz + 1024) in
HIO.write h obuf;
let ibuf = Buffer.contents obuf in
let sbuf = String_io.open_in ibuf in
Alcotest.check t_header "large_header" (HIO.parse sbuf) h

let many_headers () =
let size = 1000000 in
let rec add_header num h =
match num with
| 0 -> h
| n ->
let k = sprintf "h%d" n in
let v = sprintf "v%d" n in
let h = H.add h k v in
add_header (num - 1) h
in
let h = add_header size (H.init ()) in
Alcotest.(check int) "many_headers" (List.length (H.to_list h)) size

module Updates = struct
let h = H.init ()
|> fun h -> H.add h "first" "1"
|> fun h -> H.add h "second" "2"
|> fun h -> H.add h "accept" "foo"
|> fun h -> H.add h "accept" "bar"

let replace_headers_if_exists () =
let h = H.replace h "second" "2a" in
Alcotest.(check (option string)) "replace_existing_header" (Some "2a") (H.get h "second")

let replace_headers_if_absent () =
let h = H.replace h "third" "3" in
Alcotest.(check (option string)) "replace_new_header" (Some "3") (H.get h "third")

let update_headers_if_exists () =
let h1 = H.update h "second" (function | Some _ -> Some "2a" | None -> None) in
let h2 = H.replace h "second" "2a" in
Alcotest.(check t_header) "update_existing_header" h1 h2

let update_headers_if_exists_rm () =
let h1 = H.update h "second" (function | Some _ -> None | None -> Some "3") in
let h2 = H.remove h "second" in
Alcotest.(check t_header) "update_remove_header" h1 h2

let update_headers_if_absent_add () =
let h = H.update h "third" (function | Some _ -> None | None -> Some "3") in
Alcotest.(check (option string)) "update_add_new_header" (Some "3") (H.get h "third")

let update_headers_if_absent_rm () =
let h1 = H.update h "third" (function _ -> None) in
Alcotest.(check t_header) "update_remove_absent_header" h h1

let update_headers_if_exists_multi () =
let h1 = H.update h "accept" (function | Some v -> Some ("baz,"^v) | None -> None) in
let h2 = H.add h "accept" "baz" in
Alcotest.(check (option string)) "update_existing_header_multivalued" (H.get h1 "accept") (H.get h2 "accept")

let update_headers_if_absent () =
let h1 = H.update h "third" (function | Some _ -> Some "3" | None -> None) in
Alcotest.(check t_header) "update_new_header: unchanged" h h1;
Alcotest.(check (option string)) "update_new_header: map unchanged" None (H.get h "third")
end

module Content_range = struct
let h1 = H.of_list ["Content-Length", "123"]
let h2 = H.of_list ["Content-Range", "bytes 200-300/1000"]
Expand Down Expand Up @@ -483,16 +398,8 @@ let test_cachecontrol_concat () =
"Cache-Control: max-age:86400"] in
let h = headers_of_response "concat Cache-Control" resp in
aeso "test_cachecontrol_concat"
(Some "public,max-age:86400") (H.get h "Cache-Control")
(Some "public,max-age:86400") (H.get_multi_concat h "Cache-Control")

let transfer_encoding () =
let h = H.of_list ["transfer-encoding", "gzip";
"transfer-encoding", "chunked"] in
let sh = H.to_string h in
aes "transfer_encoding_string_is_ordered"
sh "transfer-encoding: gzip\r\ntransfer-encoding: chunked\r\n\r\n";
let sh = H.get h "transfer-encoding" in
aeso "transfer_encoding_get_is_ordered" (Some "gzip,chunked") sh

let () = Printexc.record_backtrace true

Expand Down Expand Up @@ -534,20 +441,6 @@ let () =
];
"Cache Control", [
"concat", `Quick, test_cachecontrol_concat
];
"Header", [
"get list valued", `Quick, list_valued_header;
"trim whitespace", `Quick, trim_ws;
"replace existing", `Quick, Updates.replace_headers_if_exists;
"replace absent", `Quick, Updates.replace_headers_if_absent;
"update existing", `Quick, Updates.update_headers_if_exists;
"update existing list", `Quick, Updates.update_headers_if_exists_multi;
"update add absent", `Quick, Updates.update_headers_if_absent_add;
"update rm existing", `Quick, Updates.update_headers_if_exists_rm;
"update rm absent", `Quick, Updates.update_headers_if_absent_rm;
"update absent", `Quick, Updates.update_headers_if_absent;
"many headers", `Slow, many_headers;
"transfer encoding is in correct order", `Quick, transfer_encoding;
];
Unitary_test_header.tests
]
@ if Sys.word_size = 64 then ["large header", `Slow, large_header] else []
]
Loading

0 comments on commit 9e19c11

Please sign in to comment.