Commits

Sebastien Mondet committed d166b0b

test: add a test for the IO module

Comments (0)

Files changed (1)

+#! /bin/sh
+
+PACKAGES=pvem,core,sexplib.syntax,lwt.unix,lwt.preemptive
+
+MD5=`md5sum $0  | cut -d ' ' -f 1`
+BASE=/tmp/ocaml_script_$MD5/
+mkdir -p $BASE
+
+ML_FILE=${BASE}/source.ml
+EXEC=${BASE}/`basename $0`
+
+if test -f $BASE
+then
+  $EXEC $*
+  RETURN_CODE=$?
+else
+
+  SKIP=`awk '/^__OCAML_FOLLOWS__/ { print NR + 1; exit 0; }' $0`
+  echo "#$SKIP \"$0\"" > $ML_FILE
+  tail -n +$SKIP $0 >> $ML_FILE
+
+  ocamlfind ocamlopt  -I _build/ pvem_lwt_unix.cmxa -thread -package $PACKAGES \
+   -syntax camlp4o -linkpkg -o $EXEC $ML_FILE \
+    && $EXEC $*
+  RETURN_CODE=$?
+fi
+exit $RETURN_CODE
+
+__OCAML_FOLLOWS__
+
+(**************************************************************************)
+(*  Copyright (c) 2012, 2013,                                             *)
+(*                           Sebastien Mondet <seb@mondet.org>,           *)
+(*                           Ashish Agarwal <agarwal1975@gmail.com>.      *)
+(*                                                                        *)
+(*  Permission to use, copy, modify, and/or distribute this software for  *)
+(*  any purpose with or without fee is hereby granted, provided that the  *)
+(*  above  copyright notice  and this  permission notice  appear  in all  *)
+(*  copies.                                                               *)
+(*                                                                        *)
+(*  THE  SOFTWARE IS  PROVIDED  "AS  IS" AND  THE  AUTHOR DISCLAIMS  ALL  *)
+(*  WARRANTIES  WITH  REGARD  TO  THIS SOFTWARE  INCLUDING  ALL  IMPLIED  *)
+(*  WARRANTIES  OF MERCHANTABILITY AND  FITNESS. IN  NO EVENT  SHALL THE  *)
+(*  AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL  *)
+(*  DAMAGES OR ANY  DAMAGES WHATSOEVER RESULTING FROM LOSS  OF USE, DATA  *)
+(*  OR PROFITS,  WHETHER IN AN  ACTION OF CONTRACT, NEGLIGENCE  OR OTHER  *)
+(*  TORTIOUS ACTION,  ARISING OUT  OF OR IN  CONNECTION WITH THE  USE OR  *)
+(*  PERFORMANCE OF THIS SOFTWARE.                                         *)
+(**************************************************************************)
+
+open Core.Std
+open Pvem_lwt_unix
+open Deferred_result
+
+let say fmt =
+  ksprintf (fun s -> eprintf "%s\n%!" s) fmt
+
+let wrap_deferred_io f =
+  wrap_deferred (fun () -> f ()) ~on_exn:(fun e -> `io_test_exn e)
+
+let copy () =
+  let tmp = Filename.temp_file "io_test_copy" ".bin" in
+  IO.write_file tmp ~content:"foo!"
+  >>= fun () ->
+  IO.with_in_channel (`file tmp) ~buffer_size:42 ~f:(fun i ->
+    IO.read i
+    >>= fun content ->
+    IO.with_out_channel (`stdout) ~f:(fun o ->
+      ksprintf (IO.write o) "Content of %s is %S\n" tmp content))
+
+
+let fail_test fmt =
+  ksprintf (fun s -> fail (`test_failed s)) fmt
+
+let fail_test_if cond fmt =
+  ksprintf (fun s ->
+    if cond then fail (`test_failed s) else return ()) fmt
+
+let test_with_out_channel () =
+  let tmp = Filename.temp_file "io_test_with_out_channel" ".bin" in
+  IO.write_file tmp ~content:"A"
+  >>= fun () ->
+  IO.with_out_channel (`append_to_file tmp) ~f:(fun o ->
+    IO.write o "B")
+  >>= fun () ->
+  IO.read_file tmp
+  >>= fun content ->
+  fail_test_if (content <> "AB") "append_to_file"
+  >>= fun () ->
+  begin
+    IO.with_out_channel (`create_file tmp) ~f:(fun o ->
+      IO.write o "B")
+    >>< begin function
+    | `Ok () -> fail_test "test_with_out_channel.create: could write in %s" tmp
+    |`Error (`file_exists p) -> return ()
+    |`Error (`io_exn e) ->
+      eprintf "io_exn: %s\n%!" Exn.(to_string e);
+      fail (`io_exn e)
+    |`Error e -> fail e
+    end
+  end
+  >>= fun () ->
+  System.remove tmp >>= fun () ->
+
+  IO.with_out_channel (`create_file tmp) ~f:(fun o ->
+    IO.write o "AB")
+  >>= fun () ->
+
+  IO.read_file tmp >>= fun content ->
+  fail_test_if (content <> "AB") "effectively create"
+  >>= fun () ->
+
+  IO.with_out_channel (`overwrite_file tmp) ~f:(fun o ->
+    IO.write o "CD")
+  >>= fun () ->
+
+  IO.read_file tmp >>= fun content ->
+  fail_test_if (content <> "CD") "overwrite_file"
+  >>= fun () ->
+
+  say "test_with_out_channel: OK";
+  return ()
+
+
+let main () =
+  copy ()
+  >>= fun () ->
+  test_with_out_channel ()
+
+let () =
+  let module E = struct
+    type t = [
+    | `io_exn of exn
+    | `io_test_exn of exn
+    | `test_failed of string
+    | `read_file_error of string * exn
+    | `write_file_error of string * exn
+    | `file_exists of string
+    | `wrong_path of string
+    | `system of
+        [ `file_info of string
+        | `list_directory of string
+        | `remove of string ] *
+          [ `exn of exn ]
+    | `transform of
+        [ `io_exn of exn
+        | `stopped_before_end_of_stream
+        | `transform_error of unit ]
+    ] with sexp_of
+  end in
+  match Lwt_main.run (main ()) with
+  | `Ok () -> ()
+  | `Error e ->
+    eprintf "End with Error:\n%s\n%!" (E.sexp_of_t e |! Sexp.to_string_hum);
+    exit 1