(******************************************************************************)
(* ocaml-fileutils: files and filenames common operations *)
(* *)
(* Copyright (C) 2003-2014, Sylvain Le Gall *)
(* *)
(* This library is free software; you can redistribute it and/or modify it *)
(* under the terms of the GNU Lesser General Public License as published by *)
(* the Free Software Foundation; either version 2.1 of the License, or (at *)
(* your option) any later version, with the OCaml static compilation *)
(* exception. *)
(* *)
(* This library is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *)
(* COPYING for more details. *)
(* *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this library; if not, write to the Free Software Foundation, *)
(* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *)
(******************************************************************************)
open OUnit2
open FilePath
open FileUtil
exception ExpectedException
let test_umask = 0o0022
let umask_mutex = OUnitShared.Mutex.create OUnitShared.ScopeProcess
let bracket_umask umask =
bracket
(fun test_ctxt ->
OUnitShared.Mutex.lock test_ctxt.OUnitTest.shared umask_mutex;
Unix.umask umask)
(fun umask test_ctxt ->
let _i: int = Unix.umask umask in
OUnitShared.Mutex.unlock test_ctxt.OUnitTest.shared umask_mutex)
let with_bracket_umask test_ctxt umask f =
OUnitBracket.with_bracket test_ctxt (bracket_umask umask) f
module SetFilename = Set.Make (struct
type t = FilePath.DefaultPath.filename
let compare = FilePath.DefaultPath.compare
end)
let assert_equal_string ~msg =
assert_equal ~printer:(fun x -> x) ~msg:msg
module DiffSetFilename =
OUnitDiff.SetMake
(struct
type t = string
let compare = FilePath.DefaultPath.compare
let pp_printer = Format.pp_print_string
let pp_print_sep = OUnitDiff.pp_comma_separator
end)
(** Check that two set of file are equal *)
let assert_equal_set_filename ?msg st_ref st =
DiffSetFilename.assert_equal ?msg
(DiffSetFilename.of_list (SetFilename.elements st_ref))
(DiffSetFilename.of_list (SetFilename.elements st))
let assert_perm fn exp =
assert_equal
~msg:(Printf.sprintf "permission of '%s'" fn)
~printer:(Printf.sprintf "0o%04o")
exp (Unix.lstat fn).Unix.st_perm
let assert_error msg e f =
assert_raises
~msg
ExpectedException
(fun () ->
f (fun _ err -> if e err then raise ExpectedException))
(** Ensure that we are dealing with generated file (and not random
file on the filesystem).
*)
module SafeFS =
struct
module S =
Set.Make
(struct
type t = int * int
let compare = Pervasives.compare
end)
type t =
{
mutable files: SetFilename.t;
mutable dirs: SetFilename.t;
mutable markers: S.t;
}
let default () =
{
files = SetFilename.empty;
dirs = SetFilename.empty;
markers = S.empty;
}
let marker fn =
let st = Unix.lstat fn in
(st.Unix.st_dev, st.Unix.st_ino)
let mark t fn =
t.markers <- S.add (marker fn) t.markers
let touch t fn =
if Sys.file_exists fn then begin
failwith (Printf.sprintf "File %S already exists." fn)
end else begin
let chn = open_out fn in
close_out chn;
mark t fn;
t.files <- SetFilename.add fn t.files
end
let mkdir t dn =
if Sys.file_exists dn then begin
failwith (Printf.sprintf "Directory %S already exists." dn)
end else begin
Unix.mkdir dn 0o755;
mark t dn;
t.dirs <- SetFilename.add dn t.dirs
end
let auto_ask_user t =
Ask (fun fn -> S.mem (marker fn) t.markers)
let create dn dirs files =
let t = default () in
mark t dn;
t.dirs <- SetFilename.add dn t.dirs;
List.iter (fun fn -> mkdir t (Filename.concat dn fn)) dirs;
List.iter (fun fn -> touch t (Filename.concat dn fn)) files;
t
end
module Test =
functor (OsPath: PATH_STRING_SPECIFICATION) ->
struct
let os_string = ref ""
let test_label s value = (!os_string)^" : "^s^" \""^value^"\""
let test_label_list s lst = test_label s ("["^(String.concat ";" lst)^"]")
let test_label_pair s (a, b) = test_label s (a^"\" \""^b)
let test_name s = (s)
let reduce (exp, res) =
(test_name "reduce") >::
(fun _ ->
assert_equal_string
~msg:(test_label "reduce" exp)
res (OsPath.reduce ~no_symlink:true exp))
let make_path (exp, res) =
(test_name "make_path") >::
(fun _ ->
assert_equal_string ~msg:(test_label_list "make_path" exp)
res (OsPath.string_of_path exp))
let make_absolute (base, rela, res) =
(test_name "make_absolute") >::
(fun _ ->
assert_equal_string ~msg:(test_label_pair "make_absolute" (base, rela))
res (OsPath.reduce ~no_symlink:true (OsPath.make_absolute base rela)))
let make_relative (base, abs, res) =
(test_name "make_relative") >::
(fun _ ->
assert_equal_string ~msg:(test_label_pair "make_relative" (base, abs))
res (OsPath.make_relative base abs))
let valid exp =
(test_name "valid") >::
(fun _ ->
assert_bool (test_label "is_valid" exp)
(OsPath.is_valid exp))
let identity exp =
(test_name "identity") >::
(fun _ ->
assert_equal_string ~msg:(test_label "identity" exp)
exp (OsPath.identity exp))
let extension (filename, basename, extension) =
(test_name "extension") >::
(fun _ ->
assert_equal_string ~msg:(test_label "chop_extension" filename)
(OsPath.chop_extension filename) basename;
assert_equal_string ~msg:(test_label "get_extension" filename)
(OsPath.string_of_extension (OsPath.get_extension filename))
extension;
assert_bool (test_label "check_extension" filename)
(OsPath.check_extension filename
(OsPath.extension_of_string extension));
assert_bool (test_label "check_extension (false) " filename)
(not (OsPath.check_extension filename
(OsPath.extension_of_string "dummy"))))
let is_relative (filename, res) =
(test_name "is_relative") >::
(fun _ ->
assert_equal
res
(OsPath.is_relative filename))
end
module TestUnix = Test(UnixPath)
module TestMacOS = Test(MacOSPath)
module TestWin32 = Test(Win32Path)
let () =
TestUnix.os_string := "Unix";
TestMacOS.os_string := "MacOS";
TestWin32.os_string := "Win32"
(** Static test *)
let _ =
assert(UnixPath.get_extension "test.txt" = "txt");
assert(MacOSPath.get_extension "test.txt" = "txt");
assert(Win32Path.get_extension "test.txt" = "txt")
(*********************)
(* Unix FilePath test*)
(*********************)
let test_unix =
let test_path =
[
("/");
("/a/b");
("/a/b/c/");
("/a/../b/c");
("/a/../b/../c");
("a/b/c/");
("../a/b");
("");
(".");
("./");
("..");
("../")
]
in
"Unix FilePath" >::: (
(* Is_valid *)
(
List.map TestUnix.valid test_path
)
(* Identity *)
@ (
List.map TestUnix.identity test_path
)
(* Reduce path *)
@ (
List.map TestUnix.reduce
[
("/a/b/c", "/a/b/c");
("/a/b/c/", "/a/b/c");
("/a/b/c/d/..", "/a/b/c");
("/a/b/c/.", "/a/b/c");
("/a/d/../b/c", "/a/b/c");
("/a/./b/c", "/a/b/c");
("/a/b/c/d/./..", "/a/b/c");
("/a/b/c/d/../.", "/a/b/c");
("/a/b/d/./../c", "/a/b/c");
("/a/b/d/.././c", "/a/b/c");
("/a/b/../d/../b/c", "/a/b/c");
("/a/./././b/./c", "/a/b/c");
("/a/../a/./b/../c/../b/./c", "/a/b/c");
("/a/../..", "/");
("./d/../a/b/c", "a/b/c");
("a/b/c/../../../", "");
("", "");
(".", "");
("./", "");
("..", "..");
("../", "..");
]
)
(* Create path *)
@ (
List.map TestUnix.make_path
[
(["/a"; "b"; "/c/d"], "/a:b:/c/d");
([], "");
]
)
(* Convert to absolute *)
@ (
List.map TestUnix.make_absolute
[
("/a/b/c", ".", "/a/b/c");
("/a/b/c", "./d", "/a/b/c/d");
("/a/b/c", "../d", "/a/b/d");
("/a/b/c", "", "/a/b/c");
("/a/b/c", ".", "/a/b/c");
("/a/b/c", "./", "/a/b/c");
("/a/b/c", "..", "/a/b");
("/a/b/c", "../", "/a/b")
]
)
(* Convert to relative *)
@ (
List.map TestUnix.make_relative
[
("/a/b/c", "/a/b/c", "");
("/a/b/c", "/a/b/d", "../d")
]
)
(* Check extension *)
@ (
List.map TestUnix.extension
[
("/a/b/c.d", "/a/b/c", "d");
("/a/b.c/d.e", "/a/b.c/d", "e");
("a.", "a", "");
]
)
)
(**********************)
(* Win32 FilePath test*)
(**********************)
let test_win32 =
let test_path =
[
("c:\\");
("c:\\a\\b");
("c:\\a\\b\\c\\");
("c:\\a\\..\\b\\c");
("c:\\a\\..\\b\\..\\c");
("a\\b\\c\\");
("..\\a\\b");
("");
(".");
(".\\");
("..");
("..\\")
]
in
"Win32 FilePath" >:::
(
(* Is_valid *)
(List.map TestWin32.valid test_path)
(* Identity *)
@ (List.map TestWin32.identity test_path)
(* Reduce path *)
@ (List.map TestWin32.reduce
[("c:\\a\\b\\c", "c:\\a\\b\\c");
("c:\\a\\b\\c\\", "c:\\a\\b\\c");
("c:\\a\\b\\c\\d\\..", "c:\\a\\b\\c");
("c:\\a\\b\\c\\.", "c:\\a\\b\\c");
("c:\\a\\d\\..\\b\\c", "c:\\a\\b\\c");
("c:\\a\\.\\b\\c", "c:\\a\\b\\c");
("c:\\a\\b\\c\\d\\.\\..", "c:\\a\\b\\c");
("c:\\a\\b\\c\\d\\..\\.", "c:\\a\\b\\c");
("c:\\a\\b\\d\\.\\..\\c", "c:\\a\\b\\c");
("c:\\a\\b\\d\\..\\.\\c", "c:\\a\\b\\c");
("c:\\a\\b\\..\\d\\..\\b\\c", "c:\\a\\b\\c");
("c:\\a\\.\\.\\.\\b\\.\\c", "c:\\a\\b\\c");
("c:\\a\\..\\a\\.\\b\\..\\c\\..\\b\\.\\c", "c:\\a\\b\\c");
("a\\..\\b", "b");
("", "");
(".", "");
(".\\", "");
("..", "..");
("..\\", "..")])
(* Create path *)
@ (List.map TestWin32.make_path
[(["c:/a"; "b"; "c:/c\\d"], "c:\\a;b;c:\\c\\d");
([], "")])
(* Convert to absolute *)
@ (
List.map TestWin32.make_absolute
[
("c:\\a\\b\\c", ".", "c:\\a\\b\\c");
("c:\\a\\b\\c", ".\\d", "c:\\a\\b\\c\\d");
("c:\\a\\b\\c", "..\\d", "c:\\a\\b\\d");
("c:\\a\\b\\c", "", "c:\\a\\b\\c");
("c:\\a\\b\\c", ".", "c:\\a\\b\\c");
("c:\\a\\b\\c", ".\\", "c:\\a\\b\\c");
("c:\\a\\b\\c", "..", "c:\\a\\b");
("c:\\a\\b\\c", "..\\", "c:\\a\\b");
]
)
(* Convert to relative *)
@ (
List.map TestWin32.make_relative
[
("c:\\a\\b\\c", "c:/a\\b\\c", "");
("c:\\a\\b\\c", "c:/a\\b\\d", "..\\d")
]
)
(* Check extension *)
@ (
List.map TestWin32.extension
[
("c:\\a\\b\\c.d", "c:\\a\\b\\c", "d");
("c:\\a\\b.c\\d.e", "c:\\a\\b.c\\d", "e");
("a.", "a", "");
]
)
@ (
List.map TestWin32.is_relative
[
"c:/a", false;
"c:\\a", false;
"./a", true;
".\\a", true;
"../a", true;
"..\\a", true;
]
)
)
(**********************)
(* MacOS FilePath test*)
(**********************)
let test_macos =
let test_path =
[
("a:");
("a:::");
(":a:b:c");
("");
(":");
("::");
]
in
"MacOS FilePath" >:::
(
(* Is_valid *)
(
List.map TestMacOS.valid test_path
)
(* Identity *)
@ (
List.map TestMacOS.identity test_path
)
(* Reduce path *)
@ (
List.map TestMacOS.reduce
[
("root:a:b:c", "root:a:b:c");
("root:a:b:c:", "root:a:b:c");
("root:a:b:c:d::", "root:a:b:c");
("root:a:d::b:c", "root:a:b:c");
("root:a:b:c:d::", "root:a:b:c");
("root:a:b:d::c", "root:a:b:c");
("root:a:b::d::b:c", "root:a:b:c");
("", "");
(":", "");
("::", "::");
]
)
(* Create path *)
@ (
List.map TestMacOS.make_path
[
([":a"; "b"; ":c:d"], ":a;b;:c:d");
([], "");
]
)
(* Convert to absolute *)
@ (
List.map TestMacOS.make_absolute
[
("root:a:b:c", ":", "root:a:b:c");
("root:a:b:c", ":d", "root:a:b:c:d");
("root:a:b:c", "::d", "root:a:b:d");
("root:a:b:c", "", "root:a:b:c");
("root:a:b:c", ":", "root:a:b:c");
("root:a:b:c", "::", "root:a:b");
]
)
(* Convert to relative *)
@ (
List.map TestMacOS.make_relative
[
("root:a:b:c", "root:a:b:c", "");
("root:a:b:c", "root:a:b:d", "::d")
]
)
(* Check extension *)
@ (
List.map TestMacOS.extension
[
("root:a:b:c.d", "root:a:b:c", "d");
("root:a:b.c:d.e", "root:a:b.c:d", "e");
("a.", "a", "");
]
)
)
(*****************)
(* FileUtil test *)
(*****************)
(* Test to be performed *)
let test_fileutil =
"FileUtil" >:::
["Test" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let file_test =
let fn, chn = bracket_tmpfile test_ctxt in
output_string chn "foo";
close_out chn;
fn
in
let non_fatal_test file (stest, expr, res) =
non_fatal test_ctxt
(fun _ ->
assert_bool
("Test "^stest^" on "^file)
(res = (test expr file)))
in
non_fatal_test file_test ("Size_not_null", Size_not_null, true);
List.iter
(non_fatal_test tmp_dir)
[
"True", True, true;
"False", False, false;
"Is_dir", Is_dir, true;
"Not Is_dir", (Not Is_dir), false;
"Is_dev_block", Is_dev_block, false;
"Is_dev_char", Is_dev_char, false;
"Exists", Exists, true;
"Is_file", Is_file, false;
"Is_set_group_ID", Is_set_group_ID, false;
"Has_sticky_bit", Has_sticky_bit, false;
"Is_link", Is_link, false;
"Is_pipe", Is_pipe, false;
"Is_readable", Is_readable, true;
"Is_writeable", Is_writeable, true;
"Is_socket", Is_socket, false;
"Has_set_user_ID", Has_set_user_ID, false;
"Is_exec", Is_exec, true;
"Match", Match(tmp_dir), true;
"And of test_file * test_file", And(True, False), false;
"Or of test_file * test_file", Or(True, False), true;
"Is_newer_than", (Is_newer_than tmp_dir), false;
"Is_older_than", (Is_older_than tmp_dir), false;
];
if Sys.os_type <> "Win32" then begin
List.iter
(non_fatal_test tmp_dir)
[
"Is_owned_by_user_ID", Is_owned_by_user_ID, true;
"Is_owned_by_group_ID", Is_owned_by_group_ID, true;
]
end);
"Test with FileUtilStr.Match" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir ~prefix:"fileutil-foobar" test_ctxt in
assert_bool
"FileUtilStr.Match = true"
(FileUtilStr.test (Match ".*fileutil-") tmp_dir);
assert_bool
"FileUtilStr.Match = false"
(not (FileUtilStr.test (Match "fileutil") tmp_dir)));
"Mode" >:::
[
"to_string" >::
(fun _ ->
List.iter
(fun (str, mode) ->
assert_equal
~printer:(fun s -> s)
str
(FileUtilMode.to_string mode))
[
"u+r", [`User (`Add `Read)];
"u+rw", [`User (`Add (`List [`Read; `Write]))];
"+rw,u=rw,g=rwx",
[
`None (`Add (`List [`Read; `Write]));
`User (`Set (`List [`Read; `Write]));
`Group (`Set (`List [`Read; `Write; `Exec]));
];
]);
"apply" >::
(fun _ ->
List.iter
(fun (is_dir, umask, i, m, e) ->
assert_equal
~msg:(Printf.sprintf "0o%04o + %s" i (FileUtilMode.to_string m))
~printer:(Printf.sprintf "0o%04o")
e (FileUtilMode.apply ~is_dir ~umask i m))
[
false, 0o022, 0o0600,
[`Group (`Add `Read)], 0o0640;
false, 0o022, 0o0600,
[`Group (`Add (`List [`Read; `Write]))], 0o0660;
false, 0o022, 0o0600,
[`Other (`Add (`List [`Read; `Write]))], 0o0606;
false, 0o022, 0o0600,
[`User (`Set (`List [`Read; `Write; `Exec]))], 0o0700;
false, 0o022, 0o0600,
[`User (`Set (`List [`Read; `Write; `Exec]))], 0o0700;
false, 0o022, 0o0600,
[`None (`Add (`List [`Read; `Write; `Exec]))], 0o0755;
false, 0o022, 0o0600,
[`Group (`Add `ExecX)], 0o0600;
false, 0o022, 0o0700,
[`Group (`Add `ExecX)], 0o0710;
true, 0o022, 0o0600,
[`Group (`Add `ExecX)], 0o0610;
false, 0o022, 0o0600,
[`Group (`Set `User)], 0o0660;
false, 0o022, 0o0600,
[`Group (`Add `StickyO)], 0o0600;
false, 0o022, 0o0600,
[`Group (`Add `Sticky)], 0o2600;
false, 0o022, 0o0600,
[`Other (`Add `StickyO)], 0o1600;
false, 0o022, 0o0600,
[`Other (`Add `Sticky)], 0o0600;
]
)
];
"Touch in not existing subdir" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
try
let file = make_filename [tmp_dir; "doesntexist"; "essai0"] in
touch file;
assert_failure
"Touch should have failed, since intermediate directory is missing"
with _ ->
());
"Touch in existing dir v1" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let file = make_filename [tmp_dir; "essai0"] in
touch file;
assert_bool "touch" (test Exists file);
);
"Touch in existing dir with no create" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let file = make_filename [tmp_dir; "essai2"] in
touch ~create:false file;
assert_bool "touch" (not (test Exists file)));
"Touch in existing dir v2" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let file = make_filename [tmp_dir; "essai1"] in
touch file;
assert_bool "touch" (test Exists file));
"Touch precedence" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let time = Unix.gettimeofday () in
let fn1 = make_filename [tmp_dir; "essai1"] in
let fn2 = make_filename [tmp_dir; "essai0"] in
touch ~time:(Touch_timestamp time) fn1;
touch ~time:(Touch_timestamp (time +. 1.0)) fn2;
assert_bool "touch precedence 1"
(test (Is_newer_than fn1) fn2);
assert_bool
"touch precedence 2"
(test (Is_older_than fn2) fn1));
"Mkdir simple v1" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dir = make_filename [tmp_dir; "essai2"] in
mkdir dir;
assert_bool "mkdir" (test Is_dir dir));
"Mkdir simple && mode 700" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dir = make_filename [tmp_dir; "essai3"] in
mkdir ~mode:(`Octal 0o0700) dir;
assert_bool "mkdir" (test Is_dir dir));
"Mkdir recurse v2" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dir = make_filename [tmp_dir; "essai4"; "essai5"] in
assert_error
"missing component path"
(function
| `MissingComponentPath _ -> true
| _ -> false)
(fun error -> mkdir ~error dir));
"Mkdir && already exist v3" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dir = make_filename [tmp_dir; "essai0"] in
touch dir;
assert_error
"dirname already used"
(function
| `DirnameAlreadyUsed _ -> true
| _ -> false)
(fun error -> mkdir ~error dir));
"Mkdir recurse v4" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dir1 = (make_filename [tmp_dir; "essai4"]) in
let dir2 = (make_filename [dir1; "essai5"]) in
mkdir ~parent:true dir2;
assert_bool "mkdir" (test Is_dir dir2);
assert_perm dir1 0o0755;
assert_perm dir2 0o0755;
rm ~recurse:true [dir1];
assert_bool "no dir" (not (test Exists dir2));
mkdir
~parent:true
~mode:(`Symbolic [`Group (`Add `Write); `Other (`Set (`List []))])
dir2;
assert_bool "mkdir" (test Is_dir dir2);
assert_perm dir1 0o0755;
assert_perm dir2 0o0770;
rm ~recurse:true [dir1];
assert_bool "no dir" (not (test Exists dir2));
mkdir
~parent:true
~mode:(`Octal 0o0770)
dir2;
assert_bool "mkdir" (test Is_dir dir2);
assert_perm dir1 0o0755;
assert_perm dir2 0o0770;
rm ~recurse:true [dir1];
assert_bool "no dir" (not (test Exists dir2)));
"Find v0" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
with_bracket_chdir test_ctxt tmp_dir
(fun _ ->
let find_acc _ =
find True "." (fun acc x -> reduce x :: acc) []
in
let lst_dot =
find_acc "."
in
let lst_empty =
find_acc ""
in
assert_bool "find '.' is empty" (lst_dot <> []);
assert_bool "find '' is empty" (lst_empty <> []);
assert_bool "find '.' <> find ''" (lst_dot = lst_empty)));
"Find v1" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let sfs =
SafeFS.create tmp_dir
["essai_dir"]
["essai_file"]
in
let set =
find True tmp_dir (fun set fln -> SetFilename.add fln set)
SetFilename.empty
in
assert_equal_set_filename
(SetFilename.union sfs.SafeFS.dirs sfs.SafeFS.files)
set);
"Find v2" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let sfs =
SafeFS.create tmp_dir
["essai_dir"]
["essai_file"]
in
let set =
find Is_dir tmp_dir (fun set fln -> SetFilename.add fln set)
SetFilename.empty
in
assert_equal_set_filename sfs.SafeFS.dirs set);
"Find v3" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let sfs =
SafeFS.create tmp_dir
["essai_dir"]
["essai_file"]
in
let set =
find Is_file tmp_dir (fun set fln -> SetFilename.add fln set)
SetFilename.empty
in
assert_equal_set_filename sfs.SafeFS.files set);
"Find v4" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let sfs =
SafeFS.create tmp_dir
["essai_dir"]
["essai_file"]
in
let set =
find Is_file (Filename.concat tmp_dir "")
(fun set fln -> SetFilename.add fln set)
SetFilename.empty
in
assert_equal_set_filename sfs.SafeFS.files set);
"Unix specific" >:::
(
let mk_symlink test_ctxt =
let () =
skip_if (Sys.os_type <> "Unix") "Symlink only works on Unix."
in
let tmp_dir = bracket_tmpdir test_ctxt in
let symlink = make_filename [tmp_dir; "recurse"] in
let sfs =
SafeFS.create tmp_dir
["essai_dir"]
["essai_file"]
in
Unix.symlink current_dir symlink;
SafeFS.mark sfs symlink;
tmp_dir, symlink, sfs
in
let mk_filelink test_ctxt =
let () =
skip_if (Sys.os_type <> "Unix") "Symlink only works on Unix."
in
let tmp_dir = bracket_tmpdir test_ctxt in
let symlink = make_filename [tmp_dir; "recurse"] in
let source = make_filename [tmp_dir; "essai_file"] in
let sfs =
SafeFS.create tmp_dir
[]
["essai_file"]
in
Unix.symlink source symlink;
SafeFS.mark sfs symlink;
tmp_dir, symlink, sfs
in
let mk_deadlink test_ctxt =
let () =
skip_if (Sys.os_type <> "Unix") "Symlink only works on Unix."
in
let tmp_dir = bracket_tmpdir test_ctxt in
let dir = make_filename [tmp_dir; "dir1"] in
let symlink = make_filename [dir; "dead"] in
mkdir dir;
Unix.symlink "non_existing.txt" symlink;
tmp_dir, symlink, dir
in
[
"Unix symlink" >::
(fun test_ctxt ->
let _, symlink, _ = mk_symlink test_ctxt in
assert_bool "symlink is not a link" (test Is_link symlink);
assert_bool "symlink is not a dir" (test Is_dir symlink));
"Find v4 (link follow)" >::
(fun test_ctxt ->
let tmp_dir, _, _ = mk_symlink test_ctxt in
try
find ~follow:Follow Is_dir tmp_dir (fun () _ -> ()) ();
assert_failure
"find follow should have failed, since there is \
recursive symlink"
with RecursiveLink _ ->
());
"Find v5 (no link follow)" >::
(fun test_ctxt ->
let tmp_dir, fn, sfs = mk_symlink test_ctxt in
let set =
find ~follow:Skip Is_dir tmp_dir
(fun set fln -> SetFilename.add fln set)
SetFilename.empty
in
assert_bool "find symlink skip fails"
(SetFilename.equal set
(SetFilename.add fn sfs.SafeFS.dirs)));
"Unix delete symlink" >::
(fun test_ctxt ->
let _, symlink, _ = mk_symlink test_ctxt in
rm [symlink];
try
let _st: Unix.stats = Unix.lstat symlink in
assert_failure "rm symlink failed"
with Unix.Unix_error(Unix.ENOENT, _, _) ->
());
"Dead link + stat" >::
(fun test_ctxt ->
let _, symlink, _ = mk_deadlink test_ctxt in
let st = stat symlink in
assert_bool "is marked as a link" st.is_link;
assert_equal ~msg:"is a link" Symlink st.kind;
assert_raises
~msg:"cannot dereference"
(FileDoesntExist symlink)
(fun () -> stat ~dereference:true symlink));
"Dead link + test" >::
(fun test_ctxt ->
let _, symlink, _ = mk_deadlink test_ctxt in
assert_bool "dead link exists"
(test Is_link symlink));
"Dead symlink + rm" >::
(fun test_ctxt ->
let _, _, dir = mk_deadlink test_ctxt in
rm ~recurse:true [dir]);
"Dead symlink + cp -r" >::
(fun test_ctxt ->
let tmp_dir, _, dir1 = mk_deadlink test_ctxt in
let dir2 = make_filename [tmp_dir; "dir2"] in
cp ~recurse:true [dir1] dir2;
try
(* test Is_link *)
let _st: Unix.stats =
Unix.lstat (make_filename [dir2; "dead"])
in
()
with Unix.Unix_error(Unix.ENOENT, _, _) ->
assert_failure "dead link not copied.");
"Dead symlink + cp -r v2" >::
(fun test_ctxt ->
let tmp_dir, symlink, _ = mk_deadlink test_ctxt in
let dir2 = make_filename [tmp_dir; "dir2"] in
cp ~recurse:true [symlink] dir2;
try
(* test Is_link *)
let _st: Unix.stats = Unix.lstat dir2 in
()
with Unix.Unix_error(Unix.ENOENT, _, _) ->
assert_failure "dead link not copied.");
"Dead symlink + cp" >::
(fun test_ctxt ->
let tmp_dir, symlink, _ = mk_deadlink test_ctxt in
let dir2 = make_filename [tmp_dir; "dir2"] in
try
cp [symlink] dir2;
assert_failure "dead link should not copied."
with FileDoesntExist _ ->
());
"Live filelink + cp" >::
(fun test_ctxt ->
let tmp_dir, symlink, _ = mk_filelink test_ctxt in
let dest = make_filename [tmp_dir; "dest"] in
cp [symlink] dest;
assert_bool "regular" (not(test Is_link dest)));
"Readlink" >::
(fun test_ctxt ->
let tmp_dir, fn, _ = mk_symlink test_ctxt in
assert_equal
~printer:(Printf.sprintf "%S")
tmp_dir (readlink fn));
]
);
"Chmod" >::
(fun test_ctxt ->
let fn, chn = bracket_tmpfile test_ctxt in
let () = close_out chn in
let iter_chmod =
List.iter
(fun (ini, mode, exp) ->
Unix.chmod fn ini;
chmod mode [fn];
assert_perm fn exp)
in
let () =
if Sys.os_type = "Unix" then begin
iter_chmod
[
0o0000, `Symbolic [`User (`Add `Exec)], 0o0100;
0o0100, `Symbolic [`User (`Remove `Exec)], 0o0000;
0o0000, `Symbolic [`Group (`Add `Exec)], 0o0010;
0o0010, `Symbolic [`Group (`Remove `Exec)], 0o0000;
0o0000, `Symbolic [`Other (`Add `Exec)], 0o0001;
0o0001, `Symbolic [`Other (`Remove `Exec)], 0o0000;
0o0000, `Symbolic [`All (`Add `Exec)], 0o0111;
0o0111, `Symbolic [`All (`Remove `Exec)], 0o0000;
0o0000, `Symbolic [`User (`Add `ExecX)], 0o0000;
0o0010, `Symbolic [`User (`Add `ExecX)], 0o0110;
0o0001, `Symbolic [`User (`Add `ExecX)], 0o0101;
]
end;
iter_chmod
[
0o0200, `Symbolic [`User (`Add `Write)], 0o0200;
0o0000, `Symbolic [`User (`Add `Write)], 0o0200;
0o0200, `Symbolic [`User (`Remove `Write)], 0o0000;
0o0000, `Symbolic [`Group (`Add `Write)], 0o0020;
0o0020, `Symbolic [`Group (`Remove `Write)], 0o0000;
0o0000, `Symbolic [`Other (`Add `Write)], 0o0002;
0o0002, `Symbolic [`Other (`Remove `Write)], 0o0000;
0o0000, `Symbolic [`All (`Add `Write)], 0o0222;
0o0222, `Symbolic [`All (`Remove `Write)], 0o0000;
0o0000, `Symbolic [`User (`Add `Read)], 0o0400;
0o0400, `Symbolic [`User (`Remove `Read)], 0o0000;
0o0000, `Symbolic [`Group (`Add `Read)], 0o0040;
0o0040, `Symbolic [`Group (`Remove `Read)], 0o0000;
0o0000, `Symbolic [`Other (`Add `Read)], 0o0004;
0o0004, `Symbolic [`Other (`Remove `Read)], 0o0000;
0o0000, `Symbolic [`All (`Add `Read)], 0o0444;
0o0444, `Symbolic [`All (`Remove `Read)], 0o0000;
0o0000, `Octal 0o644, 0o0644;
0o0100,
(* u=r,g=u,u+w *)
`Symbolic [`User (`Set `Read);
`Group (`Set `User);
`User (`Add `Write)],
0o640;
]
in
let tmp_dir = bracket_tmpdir test_ctxt in
let fn = make_filename [tmp_dir; "essai6"] in
touch fn;
Unix.chmod fn 0o0000;
chmod ~recurse:true (`Symbolic [`User (`Add `Read)]) [tmp_dir];
assert_perm fn 0o0400);
"Cp v1" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let file = make_filename [tmp_dir; "essai6"] in
let fn0 = make_filename [tmp_dir; "essai0"] in
touch fn0;
cp [fn0] file;
assert_bool "cp" (test Exists file));
"Cp v2" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let file = make_filename [tmp_dir; "essai4"] in
let fn0 = make_filename [tmp_dir; "essai0"] in
touch fn0;
cp [fn0] file;
assert_bool "cp" (test Exists file));
"Cp with space" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dirspace = make_filename [tmp_dir; "essai 7"] in
let file = make_filename [dirspace; "essai0"] in
let fn0 = make_filename [tmp_dir; "essai0"] in
touch fn0;
mkdir dirspace;
cp [fn0] file;
assert_bool "cp" (test Exists file));
"Cp dir to dir" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dir1 = make_filename [tmp_dir; "dir1"] in
let dir2 = make_filename [tmp_dir; "dir2"] in
mkdir dir1;
touch (make_filename [dir1; "file.txt"]);
cp ~recurse:true [dir1] dir2;
assert_bool "cp" (test Exists (make_filename [dir2; "file.txt"]));
cp ~recurse:true [dir1] dir2;
assert_bool "cp dir" (test Is_dir (make_filename [dir2; "dir1"])));
"Cp ACL" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let fn1 = make_filename [tmp_dir; "foo1.txt"] in
let fn2 = make_filename [tmp_dir; "foo2.txt"] in
let fn3 = make_filename [tmp_dir; "foo3.txt"] in
touch fn1;
Unix.chmod fn1 0o444;
assert_perm fn1 0o444;
cp [fn1] fn2;
assert_perm fn2 0o444;
if Sys.os_type = "Unix" then begin
Unix.chmod fn1 0o555;
assert_perm fn1 0o555;
cp [fn1] fn3;
assert_perm fn3 0o555
end);
"Cp preserve" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dir1 = make_filename [tmp_dir; "dir1"] in
let fn1 = make_filename [dir1; "fn1.txt"] in
let dir2 = make_filename [tmp_dir; "dir2"] in
let fn2 = make_filename [dir2; "fn1.txt"] in
let assert_equal_time ?msg exp got =
assert_equal ?msg ~printer:string_of_float exp got
in
mkdir dir1;
touch ~time:(Touch_timestamp 1.0) ~mtime:true fn1;
touch ~time:(Touch_timestamp 2.0) ~atime:true fn1;
touch ~time:(Touch_timestamp 3.0) ~mtime:true dir1;
touch ~time:(Touch_timestamp 4.0) ~atime:true dir1;
assert_equal_time ~msg:"fn1 mtime" 1.0 (stat fn1).modification_time;
assert_equal_time ~msg:"fn1 atime" 2.0 (stat fn1).access_time;
assert_equal_time ~msg:"dir1 mtime" 3.0 (stat dir1).modification_time;
assert_equal_time ~msg:"dir1 atime" 4.0 (stat dir1).access_time;
cp ~recurse:true ~preserve:true [dir1] dir2;
assert_equal_time ~msg:"fn2 mtime" 1.0 (stat fn2).modification_time;
assert_equal_time ~msg:"fn2 atime" 2.0 (stat fn2).access_time;
assert_equal_time ~msg:"dir2 mtime" 3.0 (stat dir2).modification_time;
assert_equal_time ~msg:"dir2 atime" 4.0 (stat dir2).access_time);
"Cp POSIX" >::
(fun test_ctxt ->
let tmp_dir1 = bracket_tmpdir test_ctxt in
let tmp_dir2 = bracket_tmpdir test_ctxt in
touch (concat tmp_dir1 "foo.txt");
with_bracket_chdir test_ctxt tmp_dir1
(fun _ ->
cp ~recurse:true [current_dir] tmp_dir2);
assert_bool "file" (test Is_file (concat tmp_dir2 "foo.txt")));
"Mv simple" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let file0 = make_filename [tmp_dir; "essai0"] in
let file1 = make_filename [tmp_dir; "essai10"] in
let file2 = make_filename [tmp_dir; "essai9"] in
touch file0;
cp [file0] file1;
mv file1 file2;
cp [file0] file1;
mv file1 file2;
assert_bool "mv" (test Exists file2));
"Mv otherfs" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let file_test = make_filename [tmp_dir; "essai12"] in
let sfs = SafeFS.create tmp_dir [] ["essai12"] in
let file =
let fn = Filename.temp_file ~temp_dir:(pwd ()) "otherfs" ".txt" in
Sys.remove fn;
bracket ignore
(fun () _ ->
rm ~force:(SafeFS.auto_ask_user sfs) [fn])
test_ctxt;
fn
in
mv file_test file;
SafeFS.mark sfs file;
assert_bool "mv" (test Exists file));
"Rm simple" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let file = (make_filename [tmp_dir; "essai0"]) in
let sfs = SafeFS.create tmp_dir [] ["essai0"] in
rm ~force:(SafeFS.auto_ask_user sfs) [file];
assert_bool "rm" (test (Not Exists) file));
"Rm no recurse" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dir = (make_filename [tmp_dir; "essai4"]) in
let sfs = SafeFS.create tmp_dir ["essai4"] ["essai0"] in
mkdir dir;
assert_error
"rm should have failed trying to delete a directory"
(function
| `NoRecurse _ -> true
| _ -> false)
(fun error -> rm ~error ~force:(SafeFS.auto_ask_user sfs) [dir]));
"Rm ask duplicate" >::
(fun test_ctxt ->
let tmp_dir = bracket_tmpdir test_ctxt in
let dir = make_filename [tmp_dir; "ask-duplicate"] in
let sfs =
SafeFS.create tmp_dir
["ask-duplicate"]
[make_filename ["ask-duplicate"; "toto.txt"]]
in
let set_asked = ref SetFilename.empty in
let set_duplicated = ref SetFilename.empty in
let ask_register fn =
if SetFilename.mem fn !set_asked then
set_duplicated := SetFilename.add fn !set_duplicated;
set_asked := SetFilename.add fn !set_asked;
match SafeFS.auto_ask_user sfs with
| Ask f -> f fn
| _ -> false
in
rm ~force:(Ask ask_register) ~recurse:true [dir];
assert_equal
~msg:"duplicate file asked when removing"
SetFilename.empty
!set_duplicated);
"Which ocamlc" >::
(fun _ ->
try
let _str: string = which "ocamlc" in
()
with Not_found ->
assert_failure "Cannot find ocamlc");
"Umask" >::
(fun test_ctxt ->
assert_equal
~printer:(Printf.sprintf "0o%04o")
test_umask
(umask (`Octal (fun i -> i)));
assert_equal
~printer:FileUtilMode.to_string
[`User (`Set (`List [`Read; `Write; `Exec]));
`Group (`Set (`List [`Read; `Exec]));
`Other (`Set (`List [`Read; `Exec]))]
(umask (`Symbolic (fun s -> s)));
List.iter
(fun (i, e) ->
assert_equal
~printer:(Printf.sprintf "0o%04o")
e (umask_apply i))
[
0o777, 0o755;
0o1777, 0o1755
];
with_bracket_umask test_ctxt test_umask
(fun _ _ ->
umask ~mode:(`Octal 0o0222) (`Octal ignore);
assert_equal
~printer:(Printf.sprintf "0o%04o")
0o0222 (umask (`Octal (fun i -> i))));
with_bracket_umask test_ctxt test_umask
(fun _ _ ->
assert_raises
(UmaskError("Cannot set sticky bit in umask 0o1222"))
(fun () ->
umask ~mode:(`Octal 0o1222) (`Octal ignore)));
List.iter
(fun (s, e) ->
with_bracket_umask test_ctxt test_umask
(fun msk _ ->
assert_equal
~msg:(Printf.sprintf
"0o%04o + %s -> 0o%04o"
msk (FileUtilMode.to_string s) e)
~printer:(Printf.sprintf "0o%04o")
e (umask ~mode:(`Symbolic s) (`Octal (fun i -> i)))))
[
[`None (`Add `Read)], 0o0022;
[`None (`Add (`List [`Read; `Write]))], 0o0000;
[`All (`Remove `Read)], 0o0466;
[`Group (`Set (`List [`Read; `Write; `Exec]))], 0o0002;
];
()
);
"Size" >:::
[
"string_of_size" >:::
(
let i64_unit =
1025L
in
let i64_unit2 =
Int64.succ (Int64.mul 1024L 1024L)
in
let test_of_vector fuzzy (str, sz) =
test_case
(fun _ ->
assert_equal
~printer:(fun s -> s)
str
(string_of_size ~fuzzy:fuzzy sz))
in
[
"exact" >:::
(List.map
(test_of_vector false)
[
"0 TB", TB 0L;
"0 GB", GB 0L;
"0 MB", MB 0L;
"0 KB", KB 0L;
"0 B", B 0L;
"1 TB", TB 1L;
"1 GB", GB 1L;
"1 MB", MB 1L;
"1 KB", KB 1L;
"1 B", B 1L;
"1025 TB", TB i64_unit;
"1 TB 1 GB", GB i64_unit;
"1 GB 1 MB", MB i64_unit;
"1 MB 1 KB", KB i64_unit;
"1 KB 1 B", B i64_unit;
"1024 TB 1 GB", GB i64_unit2;
"1 TB 1 MB", MB i64_unit2;
"1 GB 1 KB", KB i64_unit2;
"1 MB 1 B", B i64_unit2;
"97 MB 728 KB 349 B", B 102457693L;
]);
"fuzzy" >:::
(List.map
(test_of_vector true)
[
"0.00 TB", TB 0L;
"0.00 GB", GB 0L;
"0.00 MB", MB 0L;
"0.00 KB", KB 0L;
"0.00 B", B 0L;
"1.00 TB", TB 1L;
"1.00 GB", GB 1L;
"1.00 MB", MB 1L;
"1.00 KB", KB 1L;
"1.00 B", B 1L;
"1025.00 TB", TB i64_unit;
"1.00 TB", GB i64_unit;
"1.00 GB", MB i64_unit;
"1.00 MB", KB i64_unit;
"1.00 KB", B i64_unit;
"1024.00 TB", GB i64_unit2;
"1.00 TB", MB i64_unit2;
"1.00 GB", KB i64_unit2;
"1.00 MB", B i64_unit2;
"97.71 MB", B 102457693L;
]);
]);
"size_add" >:::
(let test_of_vector (str, szs) =
test_case
(fun _ ->
assert_equal
~printer:(fun s -> s)
str
(string_of_size
(List.fold_left size_add (B 0L) szs)))
in
List.map
test_of_vector
[
"1 TB 10 MB 12 KB", [TB 1L; KB 12L; MB 10L];
"2 MB 976 KB", [KB 2000L; MB 1L]
]);
"size_compare" >:::
(
let test_of_vector (sz1, sz2, res) =
test_case
(fun _ ->
let cmp =
size_compare sz1 sz2
in
let norm i =
if i < 0 then
-1
else if i > 0 then
1
else
0
in
assert_equal
~printer:string_of_int
(norm res)
cmp)
in
List.map
test_of_vector
[
TB 1L, TB 1L, 0;
GB 1L, GB 1L, 0;
MB 1L, MB 1L, 0;
KB 1L, KB 1L, 0;
B 1L, B 1L, 0;
TB 1L, B 1L, 1;
GB 1L, B 1L, 1;
MB 1L, B 1L, 1;
KB 1L, B 1L, 1;
B 2L, B 1L, 1;
]);
];
]
let () =
let _i: int = Unix.umask test_umask in
run_test_tt_main
("ocaml-fileutils" >:::
[
"FilePath" >:::
[
test_unix;
test_win32;
test_macos;
];
test_fileutil;
])