Remove use of rm -rf from ocamltest
parent
9bc33d945a
commit
fc0abfaad8
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -16,3 +16,4 @@
|
|||
temptation to use the Unix module directly in ocamltest. *)
|
||||
|
||||
val has_symlink : unit -> bool
|
||||
val chmod : string -> int -> unit
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue