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 <e...@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 <e...@cmu.edu> +# Copyright (C) 2015 Eric C. Cooper <e...@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 <e...@cmu.edu> + Copyright (C) 2014 Eric C. Cooper <e...@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 <e...@cmu.edu> + Copyright (C) 2014 Eric C. Cooper <e...@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 <e...@cmu.edu> + Copyright (C) 2014 Eric C. Cooper <e...@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 <e...@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 <e...@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 <e...@cmu.edu> + Copyright (C) 2014 Eric C. Cooper <e...@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 <e...@cmu.edu> + Copyright (C) 2015 Eric C. Cooper <e...@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 <e...@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 <e...@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 <e...@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 <e...@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 <e...@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 <e...@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 <e...@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 _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits