tests -> alcotest; more tests; fix big writes

.gitignore

@@ -14,3 +14,4 @@ setup.log
 _build
 *.native
 .*.swp
+_tests/*

.merlin

@@ -0,0 +1,5 @@
+PKG lwt alcotest cstruct tuntap io-page
+S lib/
+S lib_test/
+B _build/lib/
+B _build/

.travis.yml

@@ -2,5 +2,8 @@ language: c
 install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh
 script: bash -ex .travis-opam.sh
 env:
-  - OCAML_VERSION=4.01
+  global:
+  - PACKAGE=mirage-net-unix
+  matrix:
   - OCAML_VERSION=4.02
+  - OCAML_VERSION=4.03

Makefile

@@ -12,7 +12,7 @@ setup.bin: setup.ml
 	@rm -f setup.cmx setup.cmi setup.o setup.cmo
 
 setup.data: setup.bin
-	@./setup.bin -configure --enable-tests
+	@./setup.bin -configure $(CONFIGUREFLAGS)
 
 build: setup.data setup.bin
 	@./setup.bin -build -j $(J)
@@ -26,7 +26,9 @@ install: setup.bin
 uninstall:
 	@ocamlfind remove $(NAME) || true
 
-test: setup.bin build
+test: setup.bin
+	@./setup.bin -configure --enable-tests
+	@./setup.bin -build -j $(J)
 	@./setup.bin -test
 
 reinstall: setup.bin

_oasis

@@ -21,7 +21,7 @@ Executable test
   MainIs:             test.ml
   Custom:             true
   Install:            false
-  BuildDepends:       lwt, lwt.unix, mirage-net-unix, cstruct, oUnit, io-page.unix, io-page
+  BuildDepends:       lwt, lwt.unix, mirage-net-unix, cstruct, alcotest, io-page.unix, io-page
 
 Test test
   Run$:             flag(tests)

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 7adba8fcc5769d2c5df14f6fc4a2c06a)
+# DO NOT EDIT (digest: e2a972a46ecf908b3818d7dca4061cda)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -23,24 +23,24 @@ true: annot, bin_annot
 <lib/*.ml{,i,y}>: pkg_mirage-types
 <lib/*.ml{,i,y}>: pkg_tuntap
 # Executable test
+<lib_test/test.{native,byte}>: pkg_alcotest
 <lib_test/test.{native,byte}>: pkg_cstruct
 <lib_test/test.{native,byte}>: pkg_cstruct.lwt
 <lib_test/test.{native,byte}>: pkg_io-page
 <lib_test/test.{native,byte}>: pkg_io-page.unix
 <lib_test/test.{native,byte}>: pkg_lwt
 <lib_test/test.{native,byte}>: pkg_lwt.unix
 <lib_test/test.{native,byte}>: pkg_mirage-types
-<lib_test/test.{native,byte}>: pkg_oUnit
 <lib_test/test.{native,byte}>: pkg_tuntap
 <lib_test/test.{native,byte}>: use_mirage-net-unix
+<lib_test/*.ml{,i,y}>: pkg_alcotest
 <lib_test/*.ml{,i,y}>: pkg_cstruct
 <lib_test/*.ml{,i,y}>: pkg_cstruct.lwt
 <lib_test/*.ml{,i,y}>: pkg_io-page
 <lib_test/*.ml{,i,y}>: pkg_io-page.unix
 <lib_test/*.ml{,i,y}>: pkg_lwt
 <lib_test/*.ml{,i,y}>: pkg_lwt.unix
 <lib_test/*.ml{,i,y}>: pkg_mirage-types
-<lib_test/*.ml{,i,y}>: pkg_oUnit
 <lib_test/*.ml{,i,y}>: pkg_tuntap
 <lib_test/*.ml{,i,y}>: use_mirage-net-unix
 <lib_test/test.{native,byte}>: custom

lib/netif.ml

@@ -64,7 +64,6 @@ let err_permission_denied devname =
 let err_partial_write len' page =
   fail "tap: partial write (%d, expected %d)" len' page.Cstruct.len
 
-
 let connect devname =
   try
     Random.self_init ();
@@ -87,7 +86,9 @@ let connect devname =
 
 let disconnect t =
   log "disconnect %s" t.id;
-  Tuntap.closetun t.id;
+  t.active <- false;
+  Lwt_unix.close t.dev >>= fun () ->
+  Tuntap.closetap t.id;
   Lwt.return_unit
 
 type macaddr = Macaddr.t
@@ -152,30 +153,21 @@ let rec listen t fn =
     listen t fn
   | false -> Lwt.return_unit
 
-(* Transmit a packet from an Io_page *)
-let write t page =
+(* Transmit a packet from a Cstruct.t *)
+let write t buffer =
   let open Cstruct in
   (* Unfortunately we peek inside the cstruct type here: *)
-  Lwt_bytes.write t.dev page.buffer page.off page.len >>= fun len' ->
+  Lwt_bytes.write t.dev buffer.buffer buffer.off buffer.len >>= fun len' ->
   t.stats.tx_pkts <- Int32.succ t.stats.tx_pkts;
-  t.stats.tx_bytes <- Int64.add t.stats.tx_bytes (Int64.of_int page.len);
-  if len' <> page.len then err_partial_write len' page
+  t.stats.tx_bytes <- Int64.add t.stats.tx_bytes (Int64.of_int buffer.len);
+  if len' <> buffer.len then err_partial_write len' buffer
   else Lwt.return_unit
 
-(* TODO use writev: but do a copy for now *)
 let writev t = function
   | []     -> Lwt.return_unit
   | [page] -> write t page
   | pages  ->
-    let page = Io_page.(to_cstruct (get 1)) in
-    let off = ref 0 in
-    List.iter (fun p ->
-        let len = Cstruct.len p in
-        Cstruct.blit p 0 page !off len;
-        off := !off + len;
-      ) pages;
-    let v = Cstruct.sub page 0 !off in
-    write t v
+    write t @@ Cstruct.concat pages
 
 let mac t = t.mac
 

lib_test/test.ml

@@ -15,36 +15,47 @@
  *)
 
 open Lwt
-open OUnit
 open Printf
 
+let run test =
+  Lwt_main.run (test ())
+
 let err_connect e =
   let buf = Buffer.create 10 in
   let fmt = Format.formatter_of_buffer buf in
   Format.fprintf fmt "didnt connect: %a" Netif.pp_error e;
   failwith (Buffer.contents buf)
 
 let test_open () =
-  let thread =
-    Netif.connect "tap0" >>= function
-    | `Error e -> err_connect e
-    | `Ok t    ->
-      printf "connected\n%!";
-      Netif.listen t (fun buf ->
-          printf "got packet of len %d\n%!" (Cstruct.len buf);
-          Lwt.return_unit
-        )
-  in
-  Lwt_main.run thread
+  Netif.connect "tap0" >>= function
+  | `Error e -> err_connect e
+  | `Ok _t    ->
+    printf "connected\n%!";
+    Lwt.return_unit
+
+let test_close () =
+  Netif.connect "tap1" >>= function
+  | `Error e -> err_connect e
+  | `Ok t    ->
+    printf "connected\n%!";
+    Netif.disconnect t >>= function () ->
+    printf "disconnected\n%!";
+    Lwt.return_unit
+
+let test_write () =
+  Netif.connect "tap2" >>= function
+  | `Error e -> err_connect e
+  | `Ok t    ->
+    let data = Cstruct.create 4096 in
+    Netif.writev t [ data ] >>= fun () ->
+    Netif.writev t [ data ; (Cstruct.create 14) ] >>= fun () ->
+    Lwt.return_unit
+
+let suite : Alcotest.test_case list = [
+  "connect", `Quick, (fun () -> run test_open) ;
+  "disconnect", `Quick, (fun () -> run test_close);
+  "write", `Quick, (fun () -> run test_write);
+]
 
 let _ =
-  let verbose = ref false in
-  Arg.parse [
-    "-verbose", Arg.Unit (fun _ -> verbose := true), "Run in verbose mode";
-  ] (fun x -> Printf.fprintf stderr "Ignoring argument: %s" x)
-    "Test unix net driver";
-
-  let suite = "net" >::: [
-      "test open" >:: test_open;
-    ] in
-  run_test_tt ~verbose:!verbose suite
+  Alcotest.run "mirage-net-unix" [ "tests", suite ]