diff --git a/ocamltest/main.ml b/ocamltest/main.ml index 12b0c06c0..9197ce325 100644 --- a/ocamltest/main.ml +++ b/ocamltest/main.ml @@ -152,9 +152,9 @@ let test_file test_filename = let test_build_directory_prefix = get_test_build_directory_prefix test_directory in let clean_test_build_directory () = - ignore - (Sys.command - (Filename.quote_command "rm" ["-rf"; test_build_directory_prefix])) + try + Sys.rm_rf test_build_directory_prefix + with Sys_error _ -> () in clean_test_build_directory (); Sys.make_directory test_build_directory_prefix; diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index a95dd3dc5..07d69889a 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -86,6 +86,25 @@ end module Sys = struct include Sys + let erase_file path = + try Sys.remove path + with Sys_error _ when Sys.win32 && Ocamltest_config.libunix <> None -> + (* Deal with read-only attribute on Windows. Ignore any error from chmod + so that the message always come from Sys.remove *) + let () = try Unix.chmod path 0o666 with Sys_error _ -> () in + Sys.remove path + + let rm_rf path = + let rec erase path = + if Sys.is_directory path + then Array.iter (fun entry -> erase (Filename.concat path entry)) + (Sys.readdir path) + else erase_file path + in + try if Sys.file_exists path then erase path + with Sys_error err -> + raise (Sys_error (Printf.sprintf "Failed to remove %S (%s)" path err)) + let run_system_command prog args = let command = Filename.quote_command prog args in match Sys.command command with diff --git a/ocamltest/ocamltest_stdlib.mli b/ocamltest/ocamltest_stdlib.mli index 8ab88d663..d19147f9b 100644 --- a/ocamltest/ocamltest_stdlib.mli +++ b/ocamltest/ocamltest_stdlib.mli @@ -48,6 +48,7 @@ module Sys : sig val file_is_empty : string -> bool val run_system_command : string -> string list -> unit val make_directory : string -> unit + val rm_rf : string -> unit val string_of_file : string -> string val iter_lines_of_file : (string -> unit) -> string -> unit val dump_file : out_channel -> ?prefix:string -> string -> unit diff --git a/ocamltest/ocamltest_unix.mli b/ocamltest/ocamltest_unix.mli index ed952213f..38d1883eb 100644 --- a/ocamltest/ocamltest_unix.mli +++ b/ocamltest/ocamltest_unix.mli @@ -16,3 +16,4 @@ temptation to use the Unix module directly in ocamltest. *) val has_symlink : unit -> bool +val chmod : string -> int -> unit diff --git a/ocamltest/ocamltest_unix_dummy.ml b/ocamltest/ocamltest_unix_dummy.ml index 1a079cf7b..207cc716d 100644 --- a/ocamltest/ocamltest_unix_dummy.ml +++ b/ocamltest/ocamltest_unix_dummy.ml @@ -14,3 +14,4 @@ (* Dummy implementations for when the Unix library isn't built *) let has_symlink () = false +let chmod _ _ = invalid_arg "chmod not available" diff --git a/ocamltest/ocamltest_unix_real.ml b/ocamltest/ocamltest_unix_real.ml index 68cfbb2e0..2a63e8bbb 100644 --- a/ocamltest/ocamltest_unix_real.ml +++ b/ocamltest/ocamltest_unix_real.ml @@ -12,6 +12,17 @@ (* *) (**************************************************************************) -(* It's tempting just to have include Unix, but the binary is then quite a bit - bigger. *) +(* Unix.has_symlink never raises *) let has_symlink = Unix.has_symlink + +(* Convert Unix_error to Sys_error *) +let wrap f x = + try f x + with Unix.Unix_error(err, fn_name, arg) -> + let msg = + Printf.sprintf "%s failed on %S with %s" + fn_name arg (Unix.error_message err) + in + raise (Sys_error msg) + +let chmod file = wrap (Unix.chmod file)