[Pkg-ocaml-maint-commits] [approx] 03/08: use OUnit for tests
Eric Cooper
ecc at cmu.edu
Sat Jun 20 17:51:26 UTC 2015
This is an automated email from the git hooks/post-receive script.
ecc-guest pushed a commit to branch upstream
in repository approx.
commit 3dafd6d70d6a066d81dc341b2c760ca810746173
Author: Eric Cooper <ecc at cmu.edu>
Date: Fri Jun 19 19:18:27 2015 -0400
use OUnit for tests
---
Makefile | 9 +-
_tags | 2 +
config.ml | 27 ++++--
config.mli | 4 +-
config_file.ml | 4 +-
config_file.mli | 6 +-
tests/_tags | 5 -
tests/config_file_test.ml | 89 ++++++++++++++++++
tests/config_test.ml | 52 +++++++++--
tests/control_file_test.ml | 180 ++++++++++++++++++++++++++++--------
tests/dir_test.ml | 28 ------
tests/metadata_test.ml | 33 -------
tests/patch_test.ml | 21 -----
tests/runtests.ml | 13 +++
tests/sha1_test.ml | 18 ----
tests/testlib.ml | 18 ++++
tests/util_test.ml | 226 +++++++++++++++++++++++++++++++++++++++++++++
util.ml | 34 ++++---
util.mli | 17 ++++
19 files changed, 606 insertions(+), 180 deletions(-)
diff --git a/Makefile b/Makefile
index 2aa1454..46e3816 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
# approx: proxy server for Debian archive files
-# Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
+# Copyright (C) 2015 Eric C. Cooper <ecc at cmu.edu>
# Released under the GNU General Public License
OCAMLBUILD := ocamlbuild
@@ -29,11 +29,10 @@ clean:
$(OCAMLBUILD) $(OCAMLBUILD_OPTS) -clean
rm -f $(programs)
-.PHONY: tests
+test: tests/runtests
+ ./$(<F).$(TARGET)
-tests: $(subst .ml,,$(wildcard tests/*.ml))
-
-%_test:
+tests/runtests::
$(OCAMLBUILD) $(OCAMLBUILD_OPTS) $@.$(TARGET)
version := $(shell sed -n 's/^let version = "\(.*\)"$$/\1/p' config.ml)
diff --git a/_tags b/_tags
index 1402352..d58b999 100644
--- a/_tags
+++ b/_tags
@@ -13,3 +13,5 @@
<**/*.{byte,native}>: package(netsys), package(pcre), package(sha)
<approx.{byte,native}>: package(nethttpd)
+
+<tests/*>: package(oUnit)
diff --git a/config.ml b/config.ml
index d83acf6..2681dd0 100644
--- a/config.ml
+++ b/config.ml
@@ -31,21 +31,34 @@ let () =
let params = []
-let cache_dir = get "$cache" ~default: "/var/cache/approx"
+let cache_dir =
+ let dir = remove_trailing '/' (get "$cache" ~default: "/var/cache/approx") in
+ let n = String.length dir in
+ if n > 0 && dir.[0] = '/' then dir
+ else invalid_arg "$cache"
+
let params = ("$cache", cache_dir) :: params
let split_cache_path path =
let err () = invalid_string_arg "split_cache_path" path in
- if is_prefix cache_dir path then
- let i = String.length cache_dir + 1 in
- let j = try String.index_from path i '/' with Not_found -> err () in
- substring path ~from: i ~until: j, substring path ~from: (j + 1)
+ let dir = cache_dir ^ "/" in
+ if is_prefix dir path then
+ let i = String.length dir in
+ let rest = remove_leading '/' (substring path ~from: i) in
+ let j = try String.index rest '/' with Not_found -> err () in
+ match (substring rest ~until: j,
+ remove_leading '/' (substring rest ~from: (j + 1))) with
+ | ("", _) | (_, "") -> err ()
+ | pair -> pair
else
err ()
let shorten path =
- if is_prefix cache_dir path then
- substring path ~from: (String.length cache_dir + 1)
+ let dir = cache_dir ^ "/" in
+ if is_prefix dir path then
+ match remove_leading '/' (substring path ~from: (String.length dir)) with
+ | "" -> path
+ | str -> str
else
path
diff --git a/config.mli b/config.mli
index 783e2b0..7a66efd 100644
--- a/config.mli
+++ b/config.mli
@@ -1,5 +1,5 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2011 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
val version : string
@@ -23,7 +23,7 @@ val index : string (* simple HTML index for the server *)
(* Extract the distribution and relative filename
from the absolute pathname of a file in the cache.
- Example: split_pathname "/var/cache/approx/debian/pool/main/..."
+ Example: split_cache_path "/var/cache/approx/debian/pool/main/..."
returns ("debian", "pool/main/...") *)
val split_cache_path : string -> string * string
diff --git a/config_file.ml b/config_file.ml
index 388f235..6acfeb0 100644
--- a/config_file.ml
+++ b/config_file.ml
@@ -1,5 +1,5 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2009 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
open Util
@@ -24,6 +24,8 @@ let words_of_line line = Pcre.split (remove_comment line)
let map = ref []
+let reset () = map := []
+
let mem k = List.mem_assoc k !map
let get_generic convert ?default k =
diff --git a/config_file.mli b/config_file.mli
index 53f8cac..6e36143 100644
--- a/config_file.mli
+++ b/config_file.mli
@@ -1,5 +1,5 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2011 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
val read : string -> unit
@@ -11,3 +11,7 @@ val get_bool : ?default:bool -> string -> bool
val fold : (string -> string -> 'a -> 'a) -> 'a -> 'a
val iter : (string -> string -> unit) -> unit
+
+(* For use by unit tests: remove all bindings *)
+
+val reset : unit -> unit
diff --git a/tests/_tags b/tests/_tags
deleted file mode 100644
index cd83ace..0000000
--- a/tests/_tags
+++ /dev/null
@@ -1,5 +0,0 @@
-# approx: proxy server for Debian archive files
-# Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
-# Released under the GNU General Public License
-
-<sha1_test.ml>: package(sha)
diff --git a/tests/config_file_test.ml b/tests/config_file_test.ml
new file mode 100644
index 0000000..5f43e7d
--- /dev/null
+++ b/tests/config_file_test.ml
@@ -0,0 +1,89 @@
+(* approx: proxy server for Debian archive files
+ Copyright (C) 2015 Eric C. Cooper <ecc at cmu.edu>
+ Released under the GNU General Public License *)
+
+open OUnit2
+open List
+open Printf
+open Testlib
+
+let bad_line = "one two three"
+
+let create_bad ctx =
+ let file, chan = bracket_tmpfile ctx in
+ output_string chan (bad_line ^ "\n");
+ close_out chan;
+ file
+
+let test_bindings =
+ ["$debug", "true";
+ "$interval", "120";
+ "$user", "approx"]
+
+let create_good ctx =
+ let file, chan = bracket_tmpfile ctx in
+ let print_binding (k, v) =
+ output_string chan "\n";
+ output_string chan ("# binding " ^ k ^ " = " ^ v ^ "\n");
+ output_string chan (k ^ " " ^ v ^ "\n")
+ in
+ iter print_binding test_bindings;
+ close_out chan;
+ file
+
+let cleanup () ctx = Config_file.reset ()
+
+let read_good ctx =
+ bracket
+ (fun ctx ->
+ Config_file.read (create_good ctx))
+ cleanup ctx
+
+let suite = [
+
+ "read_tests" >:::
+ ["(read \"good\")" >::
+ (fun ctx ->
+ let file = bracket create_good tear_down ctx in
+ assert_equal () (Config_file.read file));
+ "(read \"bad\")" >::
+ (fun ctx ->
+ let file = bracket create_bad tear_down ctx in
+ assert_raises (Failure ("malformed line in " ^ file ^ ": " ^ bad_line))
+ (fun () -> Config_file.read file))];
+
+ "get_tests" >:::
+ map (fun (key, default, res) ->
+ sprintf "(get %s %s)" (p_str key) (p_opt p_str default) >::
+ (fun ctx ->
+ read_good ctx;
+ assert_equal ~printer: p_str res (Config_file.get key ?default)))
+ ["$user", None, "approx";
+ "$syslog", Some "daemon", "daemon"];
+
+ "get_bool_tests" >:::
+ map (fun (key, default, res) ->
+ sprintf "(get_bool %s %s)" (p_str key) (p_opt p_bool default) >::
+ (fun ctx ->
+ read_good ctx;
+ assert_equal ~printer: p_bool res (Config_file.get_bool key ?default)))
+ ["$debug", None, true;
+ "$verbose", Some false, false];
+
+ "get_int_tests" >:::
+ map (fun (key, default, res) ->
+ sprintf "(get_int %s %s)" (p_str key) (p_opt p_int default) >::
+ (fun ctx ->
+ read_good ctx;
+ assert_equal ~printer: p_int res (Config_file.get_int key ?default)))
+ ["$interval", None, 120;
+ "$percent", Some 50, 50];
+
+ "fold_test" >::
+ (fun ctx ->
+ read_good ctx;
+ let collect_binding key value acc = (key, value) :: acc in
+ assert_equal ~printer: (p_list p_str2) test_bindings
+ (Config_file.fold collect_binding []));
+
+]
diff --git a/tests/config_test.ml b/tests/config_test.ml
index 621695d..b56a2a9 100644
--- a/tests/config_test.ml
+++ b/tests/config_test.ml
@@ -1,14 +1,50 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2007 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
+open OUnit2
+open List
open Printf
+open Testlib
-let file =
- match Array.length Sys.argv with
- | 2 -> Sys.argv.(1)
- | _ -> eprintf "Usage: %s config-file\n" Sys.argv.(0); exit 1
+let suite = [
-let () =
- Config_file.read file;
- Config_file.iter (fun k v -> printf "%s: %s\n" k v)
+ "cache_dir_test" >::
+ (fun _ -> assert_equal ~printer: p_str "/var/cache/approx" Config.cache_dir);
+
+ "split_cache_path_tests" >:::
+ map (fun (str, res) ->
+ sprintf "(split_cache_path %s)" (p_str str) >::
+ (fun _ -> assert_equal ~printer: p_str2 res (Config.split_cache_path str)))
+ ["/var/cache/approx/abc/def/ghi", ("abc", "def/ghi");
+ "/var/cache/approx//abc/def/ghi", ("abc", "def/ghi");
+ "/var/cache/approx///abc/def/ghi", ("abc", "def/ghi")]
+ @
+ (let bad s = (s, Invalid_argument ("split_cache_path: " ^ s)) in
+ map (fun (str, e) ->
+ sprintf "(split_cache_path %s)" (p_str str) >::
+ (fun _ -> assert_raises e (fun () -> Config.split_cache_path str)))
+ [bad "abc";
+ bad "/abc/def/ghi/jkl";
+ bad "/var/cache/approx";
+ bad "/var/cache/approx/";
+ bad "/var/cache/approx/abc";
+ bad "/var/cache/approx/abc/";
+ bad "/var/cache/approximately/abc/def/ghi"]);
+
+ "shorten_tests" >:::
+ map (fun (str, res) ->
+ sprintf "(shorten %s)" (p_str str) >::
+ (fun _ -> assert_equal ~printer: p_str res (Config.shorten str)))
+ ["/var/cache/approx/abc/def/ghi", "abc/def/ghi";
+ "/var/cache/approx//abc/def/ghi", "abc/def/ghi";
+ "/var/cache/approx///abc/def/ghi", "abc/def/ghi";
+ "abc", "abc";
+ "/abc/def/ghi/jkl", "/abc/def/ghi/jkl";
+ "/var/cache/approx", "/var/cache/approx";
+ "/var/cache/approx/", "/var/cache/approx/";
+ "/var/cache/approx/abc", "abc";
+ "/var/cache/approx/abc/", "abc/";
+ "/var/cache/approximately/abc/def/ghi", "/var/cache/approximately/abc/def/ghi"]
+
+]
diff --git a/tests/control_file_test.ml b/tests/control_file_test.ml
index d9a0046..283631e 100644
--- a/tests/control_file_test.ml
+++ b/tests/control_file_test.ml
@@ -1,43 +1,145 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2010 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2015 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
+open OUnit2
open Printf
-open Util
-
-let verbose = ref false
-
-let file =
- match Sys.argv with
- | [| _; file |] -> file
- | [| _; "-v"; file |] | [| _; "--verbose"; file |] ->
- verbose := true;
- file
- | _ ->
- eprintf "Usage: %s [-v] control-file\n" Sys.argv.(0);
- exit 1
-
-let capitalize_parts str =
- join '-' (List.map String.capitalize (split '-' str))
-
-let print_line = function
- | "" -> printf " .\n"
- | line -> printf " %s\n" line
-
-let print_pair (field, value) =
- printf "%s:" (capitalize_parts field);
- match split_lines value with
- | [] -> print_newline ()
- | "" :: rest ->
- print_newline ();
- List.iter print_line rest
- | lines ->
- List.iter print_line lines
-
-let print_paragraph p =
- if !verbose then printf "[%d]\n" (Control_file.line_number p);
- Control_file.iter_fields print_pair p;
- print_newline ()
-
-let () =
- Control_file.iter print_paragraph file
+open Testlib
+
+let bad_line = "one two three"
+
+let create_bad ctx =
+ let file, chan = bracket_tmpfile ctx in
+ output_string chan (bad_line ^ "\n");
+ close_out chan;
+ file
+
+let test_contents =
+ "Origin: Debian
+Label: Debian
+Suite: stable
+Version: 8.1
+Codename: jessie
+Date: Sat, 06 Jun 2015 11:09:34 UTC
+Description: Debian 8.1 Released 06 June 2015
+MD5Sum:
+ a2ff86b08a2f114d6f0594ff69ef5c4d 14019410 main/binary-all/Packages
+ 9539760c49756bcaaf8640fd903ccbcf 92 main/binary-all/Release
+SHA1:
+ 6b8b6dde32d863a7cde06b0c457b7ee4fb36bdbf 14019410 main/binary-all/Packages
+ 98fcd7b597b05f3f86acb0ec07c4d11ddcb670c4 92 main/binary-all/Release
+SHA256:
+ 299181e362caae665aa68399bacde59f439a41b900e903c7104feea7a8377af1 14019410 main/binary-all/Packages
+ 84caeff910de244e607524c9b5fd370f064cbb849d3e67a8dac658cc21bba35c 92 main/binary-all/Release
+"
+
+let test_paragraph =
+ ["origin", "Debian";
+ "label", "Debian";
+ "suite", "stable";
+ "version", "8.1";
+ "codename", "jessie";
+ "date", "Sat, 06 Jun 2015 11:09:34 UTC";
+ "description", "Debian 8.1 Released 06 June 2015";
+ "md5sum", "\n\
+ a2ff86b08a2f114d6f0594ff69ef5c4d 14019410 main/binary-all/Packages\n\
+ 9539760c49756bcaaf8640fd903ccbcf 92 main/binary-all/Release";
+ "sha1", "\n\
+ 6b8b6dde32d863a7cde06b0c457b7ee4fb36bdbf 14019410 main/binary-all/Packages\n\
+ 98fcd7b597b05f3f86acb0ec07c4d11ddcb670c4 92 main/binary-all/Release";
+ "sha256", "\n\
+ 299181e362caae665aa68399bacde59f439a41b900e903c7104feea7a8377af1 14019410 main/binary-all/Packages\n\
+ 84caeff910de244e607524c9b5fd370f064cbb849d3e67a8dac658cc21bba35c 92 main/binary-all/Release"]
+
+let test_info_list =
+ [("299181e362caae665aa68399bacde59f439a41b900e903c7104feea7a8377af1", 14019410L), "main/binary-all/Packages";
+ ("84caeff910de244e607524c9b5fd370f064cbb849d3e67a8dac658cc21bba35c", 92L), "main/binary-all/Release"]
+
+let p_info = p_pair (p_pair p_str p_int64) p_str
+
+let create_good ctx =
+ let file, chan = bracket_tmpfile ctx in
+ output_string chan test_contents;
+ close_out chan;
+ file
+
+let read_good ctx =
+ bracket
+ (fun ctx ->
+ let file = create_good ctx in
+ let p = Control_file.read file in
+ p, file)
+ tear_down ctx
+
+let read_info ctx =
+ bracket
+ (fun ctx -> Control_file.read_checksum_info (create_good ctx))
+ tear_down ctx
+
+let suite = [
+
+ "read_tests" >:::
+ ["(read \"good\")" >::
+ (fun ctx ->
+ let file = bracket create_good tear_down ctx in
+ ignore (Control_file.read file));
+ "(read \"bad\")" >::
+ (fun ctx ->
+ let file = bracket create_bad tear_down ctx in
+ assert_raises (Failure ("malformed line: " ^ bad_line))
+ (fun () -> (Control_file.read file)))];
+
+ "file_name_test" >::
+ (fun ctx ->
+ let p, file = read_good ctx in
+ assert_equal ~printer: p_str file (Control_file.file_name p));
+
+ "line_number_test" >::
+ (fun ctx ->
+ let p, _ = read_good ctx in
+ assert_equal ~printer: p_int 1 (Control_file.line_number p));
+
+ "iter_fields_test" >::
+ (fun ctx ->
+ let p, _ = read_good ctx in
+ let fields_read = ref [] in
+ let collect_field pair =
+ fields_read := pair :: !fields_read
+ in
+ Control_file.iter_fields collect_field p;
+ let fields = List.rev !fields_read in
+ assert_equal ~printer: (p_list p_str2) test_paragraph fields);
+
+ "defined_test" >::
+ (fun ctx ->
+ let p, _ = read_good ctx in
+ assert_equal ~printer: p_bool false (Control_file.defined "unknown" p));
+
+ "missing_test" >::
+ (fun ctx ->
+ let p, _ = read_good ctx in
+ assert_raises (Control_file.Missing (p, "unknown"))
+ (fun () -> Control_file.lookup "unknown" p));
+
+ "lookup_test" >::
+ (fun ctx ->
+ let p, _ = read_good ctx in
+ assert_equal ~printer: p_str "jessie" (Control_file.lookup "codename" p));
+
+ "get_checksum_test" >::
+ (fun ctx ->
+ let p, _ = read_good ctx in
+ let info = List.assoc "sha256" test_paragraph in
+ assert_equal ~printer: p_str info (fst (Control_file.get_checksum p)));
+
+ "lookup_info_test" >::
+ (fun ctx ->
+ let p, _ = read_good ctx in
+ assert_equal ~printer: (p_list p_info) test_info_list (Control_file.lookup_info "sha256" p));
+
+ "read_checksum_info_test" >::
+ (fun ctx ->
+ let info, _ = read_info ctx in
+ assert_equal ~printer: (p_list p_info) test_info_list info);
+
+]
diff --git a/tests/dir_test.ml b/tests/dir_test.ml
deleted file mode 100644
index 285ca06..0000000
--- a/tests/dir_test.ml
+++ /dev/null
@@ -1,28 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2011 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License *)
-
-open Printf
-open Unix
-open Util
-
-let non_dirs, path =
- match Sys.argv with
- | [| _ |] -> false, "."
- | [| _; "-n" |] -> true, "."
- | [| _; dir |] -> false, dir
- | [| _; "-n"; dir |] -> true, dir
- | _ -> eprintf "Usage: %s [-n] [path]\n" Sys.argv.(0); exit 1
-
-let foldf, metric =
- if non_dirs then fold_non_dirs, file_size
- else fold_dirs, fun f -> Int64.of_int (stat f).st_nlink
-
-let bigger (path, n as orig) path' =
- let n' = metric path' in
- print_endline path';
- if n >= n' then orig else (path', n')
-
-let () =
- let biggest, n = foldf bigger ("", 0L) path in
- printf "\n%Ld\t%s\n" n biggest
diff --git a/tests/metadata_test.ml b/tests/metadata_test.ml
deleted file mode 100644
index 177310a..0000000
--- a/tests/metadata_test.ml
+++ /dev/null
@@ -1,33 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2011 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License *)
-
-open Config
-open Program
-open Util
-
-let cache_relative path =
- if is_prefix cache_dir path then
- substring path ~from: (String.length cache_dir + 1)
- else
- path
-
-let check show_immutable path =
- let file = cache_relative path in
- let pr = file_message file in
- let pv msg =
- pr ((if Release.valid file then "valid" else "invalid") ^ " " ^ msg)
- in
- if not (Sys.file_exists file) then pr "not found"
- else if is_cached_nak file then pr "cached NAK"
- else if Release.immutable file then (if show_immutable then pr "immutable")
- else if Release.is_release file then pr "release"
- else if Release.is_index file then pv "index"
- else if Release.is_diff_index file then pv "diff_index"
- else if Release.is_i18n_index file then pv "i18n_index"
- else pr "unknown"
-
-let () =
- Sys.chdir cache_dir;
- if arguments = [] then iter_non_dirs (check false) cache_dir
- else List.iter (check true) arguments
diff --git a/tests/patch_test.ml b/tests/patch_test.ml
deleted file mode 100644
index 1e26904..0000000
--- a/tests/patch_test.ml
+++ /dev/null
@@ -1,21 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License *)
-
-open Printf
-open Util
-
-let diff_file, file_to_patch =
- match Array.length Sys.argv with
- | 2 -> Sys.argv.(1), None
- | 3 -> Sys.argv.(1), Some Sys.argv.(2)
- | _ -> eprintf "Usage: %s pdiff [file]\n" Sys.argv.(0); exit 1
-
-let cmds = with_in_channel open_file diff_file Patch.parse
-
-let () =
- match file_to_patch with
- | Some file ->
- with_in_channel open_file file (fun chan -> Patch.apply cmds chan stdout)
- | None ->
- printf "Parsed %s\n" diff_file
diff --git a/tests/runtests.ml b/tests/runtests.ml
new file mode 100644
index 0000000..34e007c
--- /dev/null
+++ b/tests/runtests.ml
@@ -0,0 +1,13 @@
+(* approx: proxy server for Debian archive files
+ Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
+ Released under the GNU General Public License *)
+
+open OUnit2
+
+let tests = List.concat
+ [Util_test.suite;
+ Config_file_test.suite;
+ Config_test.suite;
+ Control_file_test.suite]
+
+let () = run_test_tt_main (test_list tests)
diff --git a/tests/sha1_test.ml b/tests/sha1_test.ml
deleted file mode 100644
index 4eb9836..0000000
--- a/tests/sha1_test.ml
+++ /dev/null
@@ -1,18 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2007 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License *)
-
-open Printf
-open Util
-
-let file =
- match Array.length Sys.argv with
- | 2 -> Sys.argv.(1)
- | _ -> eprintf "Usage: %s file\n" Sys.argv.(0); exit 1
-
-let get_info chan =
- let size = LargeFile.in_channel_length chan in
- let checksum = Sha1.to_hex (Sha1.channel chan (-1)) in
- printf "%s %Ld\n" checksum size
-
-let () = with_in_channel open_file file get_info
diff --git a/tests/testlib.ml b/tests/testlib.ml
new file mode 100644
index 0000000..0649f3e
--- /dev/null
+++ b/tests/testlib.ml
@@ -0,0 +1,18 @@
+(* approx: proxy server for Debian archive files
+ Copyright (C) 2015 Eric C. Cooper <ecc at cmu.edu>
+ Released under the GNU General Public License *)
+
+open Printf
+
+let p_bool = sprintf "%b"
+let p_chr = sprintf "%C"
+let p_str = sprintf "%S"
+let p_pair pf1 pf2 (x, y) = sprintf "(%s, %s)" (pf1 x) (pf2 y)
+let p_str2 = p_pair p_str p_str
+let p_list pf x = "[" ^ String.concat "; " (List.map pf x) ^ "]"
+let p_int = sprintf "%d"
+let p_int64 = sprintf "%Ld"
+let p_opt pf = function | Some x -> pf x | None -> "-"
+let p_exn = Printexc.to_string
+
+let tear_down _ _ = ()
diff --git a/tests/util_test.ml b/tests/util_test.ml
new file mode 100644
index 0000000..363c802
--- /dev/null
+++ b/tests/util_test.ml
@@ -0,0 +1,226 @@
+(* approx: proxy server for Debian archive files
+ Copyright (C) 2015 Eric C. Cooper <ecc at cmu.edu>
+ Released under the GNU General Public License *)
+
+open OUnit2
+open List
+open Printf
+open Testlib
+
+let create_empty_file ctx =
+ bracket
+ (fun ctx ->
+ let file, chan = bracket_tmpfile ctx in
+ close_out chan;
+ file)
+ tear_down ctx
+
+let create_non_empty_file ctx =
+ bracket
+ (fun ctx ->
+ let file, chan = bracket_tmpfile ctx in
+ for i = 1 to 100 do
+ output_string chan "All work and no play makes Jack a dull boy\n"
+ done;
+ close_out chan;
+ file)
+ tear_down ctx
+
+let create_tree ctx =
+ bracket
+ (fun ctx ->
+ let root = bracket_tmpdir ctx in
+ with_bracket_chdir ctx root
+ (fun ctx ->
+ close_out (open_out "a");
+ Unix.mkdir "b" 0o755;
+ Unix.mkdir "c" 0o755;
+ close_out (open_out "c/d"));
+ root)
+ tear_down ctx
+
+let cons lst x = x :: lst
+
+let suite = [
+
+ "is_prefix_tests" >:::
+ map (fun (x, y, res) ->
+ sprintf "(is_prefix %s %s)" (p_str x) (p_str y) >::
+ (fun _ -> assert_equal ~printer: p_bool res (Util.is_prefix x y)))
+ ["ban", "banana", true;
+ "bar", "banana", false;
+ "", "", true;
+ "", "abc", true;
+ "abc", "", false];
+
+ "substring_tests" >:::
+ map (fun (from, until, str, res) ->
+ sprintf "(substring %s %s %s)"
+ (p_opt p_int from) (p_opt p_int until) (p_str str) >::
+ (fun _ -> assert_equal ~printer: p_str res (Util.substring ?from ?until str)))
+ [None, None, "", "";
+ None, None, "abcdef", "abcdef";
+ Some 0, None, "abcdef", "abcdef";
+ None, Some 6, "abcdef", "abcdef";
+ Some 0, Some 6, "abcdef", "abcdef";
+ Some 1, None, "abcdef", "bcdef";
+ Some 1, Some 6, "abcdef", "bcdef";
+ None, Some 5, "abcdef", "abcde";
+ Some 0, Some 5, "abcdef", "abcde";
+ Some 1, Some 5, "abcdef", "bcde";
+ Some 2, Some 4, "abcdef", "cd";
+ Some 3, Some 3, "abcdef", "";
+ Some 6, None, "abcdef", "";
+ Some 6, Some 6, "abcdef", ""]
+ @
+ map (fun (from, until, str, e) ->
+ sprintf "(substring %s %s %s)"
+ (p_opt p_int from) (p_opt p_int until) (p_str str) >::
+ (fun _ -> assert_raises e (fun () -> Util.substring ?from ?until str)))
+ [None, Some 7, "abcdef", Invalid_argument "String.sub";
+ Some 0, Some 7, "abcdef", Invalid_argument "String.sub";
+ Some 1, None, "", Invalid_argument "String.sub";
+ Some 7, None, "abcdef", Invalid_argument "String.sub";
+ Some 4, Some 3, "abcdef", Invalid_argument "String.sub"];
+
+ "split_tests" >:::
+ map (fun (c, str, res) ->
+ sprintf "(split %s %s)" (p_chr c) (p_str str) >::
+ (fun _ -> assert_equal ~printer: (p_list p_str) res (Util.split c str)))
+ ['/', "abc", ["abc"];
+ '/', "/a/b/c", [""; "a"; "b"; "c"];
+ '/', "a/b/c/", ["a"; "b"; "c"; ""];
+ '/', "/", [""; ""]];
+
+ "join_tests" >:::
+ map (fun (c, strs, res) ->
+ sprintf "(join %s %s)" (p_chr c) (p_list p_str strs) >::
+ (fun _ -> assert_equal ~printer: p_str res (Util.join c strs)))
+ ['/', ["abc"], "abc";
+ '/', [""; "a"; "b"; "c"], "/a/b/c";
+ '/', ["a"; "b"; "c"; ""], "a/b/c/";
+ '/', [""; ""], "/"];
+
+ "relative_path_tests" >:::
+ map (fun (str, res) ->
+ sprintf "(relative_path %s)" (p_str str) >::
+ (fun _ -> assert_equal ~printer: p_str res (Util.relative_path str)))
+ ["/a/b/c", "a/b/c";
+ "/abc", "abc";
+ "/abc/", "abc/";
+ "/", ".";
+ "//", ".";
+ "", "."];
+
+ "relative_url_tests" >:::
+ map (fun (str, res) ->
+ sprintf "(relative_url %s)" (p_str str) >::
+ (fun _ -> assert_equal ~printer: p_str res (Util.relative_url str)))
+ ["http://x.y.z/a/b/c", "a/b/c";
+ "http://x.y.z/a/b/c/", "a/b/c/";
+ "http://x.y.z/", "."]
+ @
+ map (fun (str, e) ->
+ sprintf "(relative_url %s)" (p_str str) >::
+ (fun _ -> assert_raises e (fun () -> (Util.relative_url str))))
+ ["http://x.y.z", Failure "malformed URL: http://x.y.z";
+ "http:/x.y.z/a/b/c", Failure "malformed URL: http:/x.y.z/a/b/c"];
+
+ "split_extension_tests" >:::
+ map (fun (str, res) ->
+ sprintf "(split_extension %s)" (p_str str) >::
+ (fun _ -> assert_equal ~printer: p_str2 res (Util.split_extension str)))
+ ["abc.def", ("abc", ".def");
+ "abc.def.ghi", ("abc.def", ".ghi");
+ "abc.", ("abc", ".");
+ ".abc", ("", ".abc");
+ "abc", ("abc", "");
+ "", ("", "");
+ "/abc.def/ghi.jkl", ("/abc.def/ghi", ".jkl");
+ "/abc.def/ghi.", ("/abc.def/ghi", ".");
+ "/abc.def/.ghi", ("/abc.def/", ".ghi");
+ "/abc.def/ghi", ("/abc.def/ghi", "");
+ "/abc.def/.", ("/abc.def/", ".");
+ "/abc.def/", ("/abc.def/", "");
+ "/.", ("/", ".");
+ "/", ("/", "")];
+
+ "remove_leading_tests" >:::
+ map (fun (c, str, res) ->
+ sprintf "(remove_leading %s %s)" (p_chr c) (p_str str) >::
+ (fun _ -> assert_equal ~printer: p_str res (Util.remove_leading c str)))
+ ['/', "abc", "abc";
+ '/', "/abc", "abc";
+ '/', "///abc", "abc";
+ '/', "abc/", "abc/";
+ '/', "/abc/", "abc/";
+ '/', "///abc/", "abc/";
+ '/', "/", "";
+ '/', "///", "";
+ '/', "", ""];
+
+ "remove_trailing_tests" >:::
+ map (fun (c, str, res) ->
+ sprintf "(remove_trailing %s %s)" (p_chr c) (p_str str) >::
+ (fun _ -> assert_equal ~printer: p_str res (Util.remove_trailing c str)))
+ ['/', "abc", "abc";
+ '/', "abc/", "abc";
+ '/', "abc///", "abc";
+ '/', "/abc", "/abc";
+ '/', "/abc/", "/abc";
+ '/', "/abc///", "/abc";
+ '/', "/", "";
+ '/', "///", "";
+ '/', "", ""];
+
+ "file_size_tests" >:::
+ map (fun (name, creator, size) ->
+ sprintf "(file_size %s)" (p_str name) >::
+ (fun ctx ->
+ let file = creator ctx in
+ assert_equal ~printer: p_int64 size (Util.file_size file)))
+ ["empty", create_empty_file, 0L;
+ "non-empty", create_non_empty_file, 4300L];
+
+ "file_md5sum_tests" >:::
+ map (fun (name, creator, md5sum) ->
+ sprintf "(file_md5sum %s)" (p_str name) >::
+ (fun ctx ->
+ let file = creator ctx in
+ assert_equal ~printer: p_str md5sum (Util.file_md5sum file)))
+ ["empty", create_empty_file, "d41d8cd98f00b204e9800998ecf8427e";
+ "non-empty", create_non_empty_file, "e273eb02272f516abfad1bfdfb51caf0"];
+
+ "file_sha1sum_tests" >:::
+ map (fun (name, creator, sha1sum) ->
+ sprintf "(file_sha1sum %s)" (p_str name) >::
+ (fun ctx ->
+ let file = creator ctx in
+ assert_equal ~printer: p_str sha1sum (Util.file_sha1sum file)))
+ ["empty", create_empty_file, "da39a3ee5e6b4b0d3255bfef95601890afd80709";
+ "non-empty", create_non_empty_file, "adf46c7e67d75cc73a5b99d7838b3b18f9a4f66d"];
+
+ "file_sha256sum_tests" >:::
+ map (fun (name, creator, sha256sum) ->
+ sprintf "(file_sha256sum %s)" (p_str name) >::
+ (fun ctx ->
+ let file = creator ctx in
+ assert_equal ~printer: p_str sha256sum (Util.file_sha256sum file)))
+ ["empty", create_empty_file, "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855";
+ "non-empty", create_non_empty_file, "0d43abb19c4f6fa228c0e577568a99cc6b3768d3ca0f0700e75377d0e08e8793"];
+
+ "fold_dirs_test" >::
+ (fun ctx ->
+ let root = create_tree ctx in
+ let expected = root :: map (Filename.concat root) ["b"; "c"] in
+ let got = sort String.compare (Util.fold_dirs cons [] root) in
+ assert_equal ~printer: (p_list p_str) expected got);
+
+ "fold_non_dirs_test" >::
+ (fun ctx ->
+ let root = create_tree ctx in
+ let expected = map (Filename.concat root) ["a"; "c/d"] in
+ let got = sort String.compare (Util.fold_non_dirs cons [] root) in
+ assert_equal ~printer: (p_list p_str) expected got);
+
+]
diff --git a/util.ml b/util.ml
index 400e4d1..e4b8096 100644
--- a/util.ml
+++ b/util.ml
@@ -47,6 +47,23 @@ let implode_path = join '/'
let (^/) = Filename.concat
+let remove_leading c str =
+ let n = String.length str in
+ let rec loop i =
+ if i = n then ""
+ else if str.[i] <> c then substring str ~from: i
+ else loop (i + 1)
+ in
+ loop 0
+
+let remove_trailing c str =
+ let rec loop i =
+ if i < 0 then ""
+ else if str.[i] <> c then substring str ~until: (i + 1)
+ else loop (i - 1)
+ in
+ loop (String.length str - 1)
+
let make_directory path =
(* Create a directory component in the path. Since it might be
created concurrently, we have to ignore the Unix EEXIST error:
@@ -70,8 +87,6 @@ let make_directory path =
let quoted_string = sprintf "%S"
-(* Return the relative portion of a pathname *)
-
let relative_path path =
let n = String.length path in
let rec loop i =
@@ -94,18 +109,13 @@ let relative_url path =
with _ ->
failwith ("malformed URL: " ^ path)
-(* Split a filename into the leading portion without an extension
- and the extension, if any, beginning with '.' *)
-
let split_extension file =
- let base = Filename.basename file in
(* look for '.' in basename only, not parent directories *)
+ let left = try String.rindex file '/' with Not_found -> -1 in
try
- let i = String.rindex base '.' in
- let dir = Filename.dirname file in
- let name = substring base ~until: i in
- let ext = substring base ~from: i in
- (if dir = "." then name else dir ^/ name), ext
+ let i = String.rindex file '.' in
+ if i > left then (substring file ~until: i, substring file ~from: i)
+ else (file, "")
with Not_found -> (file, "")
(* Return a filename with its extension, if any, removed *)
@@ -155,7 +165,7 @@ let tmp_dir () =
| None ->
let dir =
try
- let dir = Filename.temp_dir_name in
+ let dir = Filename.get_temp_dir_name () in
access dir [R_OK; W_OK; X_OK];
dir
with Unix_error _ -> "/tmp"
diff --git a/util.mli b/util.mli
index 2575f41..a72dafb 100644
--- a/util.mli
+++ b/util.mli
@@ -38,6 +38,14 @@ val implode_path : string list -> string
val (^/) : string -> string -> string
+(* Remove leading occurrences of the given char from a string *)
+
+val remove_leading : char -> string -> string
+
+(* Remove trailing occurrences of the given char from a string *)
+
+val remove_trailing : char -> string -> string
+
(* Create a directory, including any intermediate directories
along the specified path (like "mkdir --parents") *)
@@ -47,10 +55,19 @@ val make_directory : string -> unit
val quoted_string : string -> string
+(* Return the relative portion of a pathname *)
+
+val relative_path : string -> string
+
(* Return the relative portion of a URL *)
val relative_url : string -> string
+(* Split a filename into the leading portion without an extension
+ and the extension, if any, beginning with '.' *)
+
+val split_extension : string -> (string * string)
+
(* Return the extension of a filename, including the initial '.' *)
val extension : string -> string
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/approx.git
More information about the Pkg-ocaml-maint-commits
mailing list