Move tests

.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:

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)))

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

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

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 []
 ]

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