diff --git a/.travis.yml b/.travis.yml index 0dcc7ae242..c50d978dff 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,7 +12,6 @@ env: - PACKAGE="cohttp" DISTRO="ubuntu-lts" OCAML_VERSION="4.07" - PACKAGE="cohttp-async" DISTRO="ubuntu-lts" OCAML_VERSION="4.08" - PACKAGE="cohttp-async" DISTRO="alpine" OCAML_VERSION="4.08" - - PACKAGE="cohttp-async" DISTRO="debian-unstable" OCAML_VERSION="4.08" - PACKAGE="cohttp-async" DISTRO="ubuntu-16.04" OCAML_VERSION="4.08" - PACKAGE="cohttp-lwt-unix" DISTRO="ubuntu-lts" OCAML_VERSION="4.07" - PACKAGE="cohttp-lwt-jsoo" DISTRO="ubuntu-lts" OCAML_VERSION="4.07" @@ -22,17 +21,10 @@ env: - PACKAGE="cohttp-lwt-unix" DISTRO="alpine" OCAML_VERSION="4.06" - PACKAGE="cohttp-lwt-jsoo" DISTRO="alpine" OCAML_VERSION="4.06" - PACKAGE="cohttp-lwt" DISTRO="alpine" OCAML_VERSION="4.06" - - PACKAGE="cohttp" DISTRO="debian-unstable" OCAML_VERSION="4.05" - - PACKAGE="cohttp-lwt-unix" DISTRO="debian-unstable" OCAML_VERSION="4.05" - - PACKAGE="cohttp-lwt-jsoo" DISTRO="debian-unstable" OCAML_VERSION="4.05" - - PACKAGE="cohttp-lwt" DISTRO="debian-unstable" OCAML_VERSION="4.05" - PACKAGE="cohttp" DISTRO="ubuntu-16.04" OCAML_VERSION="4.04" - PACKAGE="cohttp-lwt-unix" DISTRO="ubuntu-16.04" OCAML_VERSION="4.04" - PACKAGE="cohttp-lwt-jsoo" DISTRO="ubuntu-16.04" OCAML_VERSION="4.04" - PACKAGE="cohttp-lwt" DISTRO="ubuntu-16.04" OCAML_VERSION="4.04" -matrix: - allow_failures: - - env: PACKAGE="cohttp-lwt-unix" DISTRO="debian-unstable" OCAML_VERSION="4.05" notifications: webhooks: diff --git a/cohttp-lwt-unix/test/dune b/cohttp-lwt-unix/test/dune index 81922b2bdc..81011c0aad 100644 --- a/cohttp-lwt-unix/test/dune +++ b/cohttp-lwt-unix/test/dune @@ -13,7 +13,17 @@ (name test_sanity) (libraries cohttp_lwt_unix_test cohttp-lwt-unix)) +(executable + (modules test_sanity_noisy) + (name test_sanity_noisy) + (libraries cohttp_lwt_unix_test cohttp-lwt-unix)) + (alias (name runtest) (package cohttp-lwt-unix) (action (run ./test_sanity.exe))) + +(alias + (name runtest) + (package cohttp-lwt-unix) + (action (run ./test_sanity_noisy.exe))) diff --git a/cohttp-lwt-unix/test/test_sanity.ml b/cohttp-lwt-unix/test/test_sanity.ml index e270da6b34..e5f0c402ca 100644 --- a/cohttp-lwt-unix/test/test_sanity.ml +++ b/cohttp-lwt-unix/test/test_sanity.ml @@ -1,6 +1,5 @@ open Lwt.Infix open OUnit -open Cohttp open Cohttp_lwt_unix open Cohttp_lwt_unix_test @@ -19,21 +18,24 @@ let chunk_body = ["one"; ""; " "; "bar"; ""] let leak_repeat = 1024 let () = Debug.activate_debug () -let () = Logs.set_level (Some Info) +let () = Logs.set_level (Some Warning) let cond = Lwt_condition.create () +let check_logs test () = + let old = Logs.(warn_count () + err_count ()) in + test () >|= fun () -> + let new_errs = Logs.(warn_count () + err_count ()) - old in + if new_errs > 0 then + Fmt.failwith "Test produced %d log messages at level >= warn" new_errs + let server = List.map const [ (* t *) Server.respond_string ~status:`OK ~body:message (); - (* empty_chunk *) - Server.respond ~status:`OK ~body:(Body.of_string_list chunk_body) (); (* pipelined_chunk *) Server.respond ~status:`OK ~body:(Body.of_string "") (); Server.respond ~status:`OK ~body:(Body.of_string_list chunk_body) (); Server.respond ~status:`OK ~body:(Body.of_string "") (); - (* not modified *) - Server.respond ~status:`Not_modified ~body:Body.empty (); (* pipelined_interleave *) Server.respond_string ~status:`OK ~body:"one" (); Server.respond_string ~status:`OK ~body:"two" (); @@ -50,12 +52,7 @@ let server = end() ] @ - (fun _ body -> (* Returns 500 on bad file *) - Body.to_string body >>= fun fname -> - Server.respond_file ~fname () >|= fun rsp -> - `Response rsp - ) - :: ( + ( Array.init (leak_repeat * 2) (fun _ _ _ -> (* no leaks *) Server.respond_string ~status:`OK ~body:"no leak" () >|= fun rsp -> @@ -98,23 +95,12 @@ let server = ] |> response_sequence -let check_logs test () = - let old = Logs.(warn_count () + err_count ()) in - test () >|= fun () -> - let new_errs = Logs.(warn_count () + err_count ()) - old in - if new_errs > 0 then - Fmt.failwith "Test produced %d log messages at level >= warn" new_errs - let ts = Cohttp_lwt_unix_test.test_server_s server begin fun uri -> let t () = Client.get uri >>= fun (_, body) -> body |> Body.to_string >|= fun body -> assert_equal body message in - let empty_chunk () = - Client.get uri >>= fun (_, body) -> - body |> Body.to_string >|= fun body -> - assert_equal body (String.concat "" chunk_body) in let pipelined_chunk () = let printer x = x in let body = String.concat "" chunk_body in @@ -135,14 +121,6 @@ let ts = ) resps >>= fun () -> assert_equal ~printer:string_of_int 3 !counter; Lwt.return_unit in - let not_modified_has_no_body () = - Client.get uri >>= fun (resp, body) -> - assert_equal (Response.status resp) `Not_modified; - let headers = Response.headers resp in - assert_equal ~printer:Transfer.string_of_encoding - Transfer.Unknown (Header.get_transfer_encoding headers); - body |> Body.is_empty >|= fun is_empty -> - assert_bool "No body returned when not modified" is_empty in let pipelined_interleave () = let r n = let uri = Uri.with_query' uri ["test", (string_of_int n)] in @@ -173,23 +151,6 @@ let ts = Client.get uri >>= fun (_resp, body) -> Body.to_string body >|= fun body -> assert_equal ~printer:string_of_int (1000 * 64) (String.length body) in - let unreadable_file_500 () = - let fname = "unreadable500" in - Lwt.finalize (fun () -> - Lwt_io.open_file ~flags:[Lwt_unix.O_CREAT] ~perm:0o006 - ~mode:Lwt_io.Output fname >>= fun oc -> - Lwt_io.write_line oc "never read" >>= fun () -> - Lwt_io.close oc >>= fun () -> - Client.post uri ~body:(Body.of_string fname) - >>= begin fun (resp, body) -> - assert_equal ~printer:Code.string_of_status - (Response.status resp) `Internal_server_error; - Body.to_string body - end >|= fun body -> - assert_equal ~printer:(fun x -> "'" ^ x ^ "'") - body "Error: Internal Server Error" - ) (fun () -> Lwt_unix.unlink fname) - in let test_no_leak () = let stream = Array.init leak_repeat (fun _ -> uri) |> Lwt_stream.of_array in Lwt_stream.fold_s (fun uri () -> @@ -222,17 +183,13 @@ let ts = Lwt.pause () in [ "sanity test", check_logs t - ; "empty chunk test", check_logs empty_chunk ; "pipelined chunk test", check_logs pipelined_chunk - ; "no body when response is not modified", check_logs not_modified_has_no_body ; "pipelined with interleaving requests", check_logs pipelined_interleave ; "massive chunked", check_logs massive_chunked - ; "unreadable file returns 500", unreadable_file_500 ; "no leaks on requests", check_logs test_no_leak ; "expert response", check_logs expert_pipelined ; "client_close", check_logs client_close ] end - -let _ = ts |> run_async_tests |> Lwt_main.run +let _ = ts |> run_async_tests |> Lwt_main.run \ No newline at end of file diff --git a/cohttp-lwt-unix/test/test_sanity_noisy.ml b/cohttp-lwt-unix/test/test_sanity_noisy.ml new file mode 100644 index 0000000000..7566952cbb --- /dev/null +++ b/cohttp-lwt-unix/test/test_sanity_noisy.ml @@ -0,0 +1,82 @@ +open Lwt.Infix +open OUnit +open Cohttp +open Cohttp_lwt_unix +open Cohttp_lwt_unix_test + +module Body = Cohttp_lwt.Body + +module IO = Cohttp_lwt_unix.IO +module Request = struct + include Cohttp.Request + include (Make(IO) : module type of Make(IO) with type t := t) +end + +let message = "Hello sanity!" + +let chunk_body = ["one"; ""; " "; "bar"; ""] + +let leak_repeat = 1024 + +let () = Logs.set_level (Some Info) +let () = Logs.set_reporter Logs.nop_reporter + +let check_logs test () = + let old = Logs.(warn_count () + err_count ()) in + test () >|= fun () -> + let new_errs = Logs.(warn_count () + err_count ()) - old in + if new_errs > 0 then + Fmt.failwith "Test produced %d log messages at level >= warn" new_errs + +let server_noisy = + List.map const [ + (* empty_chunk *) + Server.respond ~status:`OK ~body:(Body.of_string_list chunk_body) (); + (* not modified *) + Server.respond ~status:`Not_modified ~body:Body.empty (); + ] + @ + [fun _ body -> (* Returns 500 on bad file *) + Body.to_string body >>= fun fname -> + Server.respond_file ~fname () >|= fun rsp -> + `Response rsp + ] |> response_sequence + +let ts_noisy = + Cohttp_lwt_unix_test.test_server_s ~port:10193 server_noisy begin fun uri -> + let empty_chunk () = + Client.get uri >>= fun (_, body) -> + body |> Body.to_string >|= fun body -> + assert_equal body (String.concat "" chunk_body) in + let not_modified_has_no_body () = + Client.get uri >>= fun (resp, body) -> + assert_equal (Response.status resp) `Not_modified; + let headers = Response.headers resp in + assert_equal ~printer:Transfer.string_of_encoding + Transfer.Unknown (Header.get_transfer_encoding headers); + body |> Body.is_empty >|= fun is_empty -> + assert_bool "No body returned when not modified" is_empty in + let unreadable_file_500 () = + let fname = "unreadable500" in + Lwt.finalize (fun () -> + Lwt_io.open_file ~flags:[Lwt_unix.O_CREAT] ~perm:0o006 + ~mode:Lwt_io.Output fname >>= fun oc -> + Lwt_io.write_line oc "never read" >>= fun () -> + Lwt_io.close oc >>= fun () -> + Client.post uri ~body:(Body.of_string fname) + >>= begin fun (resp, body) -> + assert_equal ~printer:Code.string_of_status + (Response.status resp) `Internal_server_error; + Body.to_string body + end >|= fun body -> + assert_equal ~printer:(fun x -> "'" ^ x ^ "'") + body "Error: Internal Server Error" + ) (fun () -> Lwt_unix.unlink fname) + in + [ "empty chunk test", check_logs empty_chunk + ; "no body when response is not modified", check_logs not_modified_has_no_body + ; "unreadable file returns 500", unreadable_file_500 + ] + end + +let _ = ts_noisy |> run_async_tests |> Lwt_main.run \ No newline at end of file diff --git a/cohttp/test/test_header.ml b/cohttp/test/test_header.ml index b1c930076b..0eb0ab77fd 100644 --- a/cohttp/test/test_header.ml +++ b/cohttp/test/test_header.ml @@ -536,7 +536,7 @@ Alcotest.run "test_header" [ "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; - "large header", `Slow, large_header; "many headers", `Slow, many_headers; - ]; + ] + @ if Sys.word_size = 64 then ["large header", `Slow, large_header] else [] ] diff --git a/cohttp_async_test/src/cohttp_async_test.ml b/cohttp_async_test/src/cohttp_async_test.ml index b40fe0e628..463b26446c 100644 --- a/cohttp_async_test/src/cohttp_async_test.ml +++ b/cohttp_async_test/src/cohttp_async_test.ml @@ -23,9 +23,13 @@ let const rsp _req _body = rsp >>| response let response_sequence = Cohttp_test.response_sequence failwith +let get_port = + let port = ref 8080 in + (fun () -> let v = !port in Int.incr port ; v ) + let temp_server ?port spec callback = let port = match port with - | None -> Cohttp_test.next_port () + | None -> get_port () | Some p -> p in let uri = Uri.of_string ("http://0.0.0.0:" ^ (Int.to_string port)) in let server = Server.create_expert ~on_handler_error:`Raise