Remove use of ln -sf from ocamltest

Implemented ln -sfT exactly on Unix and almost exactly on Windows.

Changes

@@ -303,6 +303,12 @@ Working version
   attributes are present.
   (Matthew Ryan, review by Nicolás Ojeda Bär)
 
+- #9797: Eliminate the routine use of external commands in ocamltest. ocamltest
+  no longer calls the mkdir, rm and ln external commands (at present, the only
+  external command ocamltest uses is diff).
+  (David Allsopp, review by Nicolás Ojeda Bär, Sébastien Hinderer and
+   Xavier Leroy)
+
 ### Build system:
 
 - #7121, #9558: Always the autoconf-discovered ld in PACKLD. For

ocamltest/actions_helpers.ml

@@ -62,13 +62,25 @@ let files env = words_of_variable env Builtin_variables.files
 
 let setup_symlinks test_source_directory build_directory files =
   let symlink filename =
+    (* Emulate ln -sfT *)
     let src = Filename.concat test_source_directory filename in
-    Sys.run_system_command "ln" ["-sf"; src; build_directory] in
+    let dst = Filename.concat build_directory filename in
+    let () =
+      if Sys.file_exists dst then
+        if Sys.win32 && Sys.is_directory dst then
+          (* Native symbolic links to directories don't disappear with unlink;
+             doing rmdir here is technically slightly more than ln -sfT would
+             do *)
+          Sys.rmdir dst
+        else
+          Sys.remove dst
+    in
+      Unix.symlink src dst in
   let copy filename =
     let src = Filename.concat test_source_directory filename in
     let dst = Filename.concat build_directory filename in
     Sys.copy_file src dst in
-  let f = if Sys.win32 then copy else symlink in
+  let f = if Unix.has_symlink () then symlink else copy in
   Sys.make_directory build_directory;
   List.iter f files
 

ocamltest/ocamltest_stdlib.ml

@@ -105,15 +105,6 @@ module Sys = struct
       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
-    | 0 -> ()
-    | _ as exitcode ->
-      Printf.eprintf "System command %s failed with status %d\n%!"
-        command exitcode;
-      exit 3
-
   let rec make_directory dir =
     if Sys.file_exists dir then ()
     else let () = make_directory (Filename.dirname dir) in

ocamltest/ocamltest_stdlib.mli

@@ -46,7 +46,6 @@ end
 module Sys : sig
   include module type of Sys
   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

ocamltest/ocamltest_unix.mli

@@ -16,4 +16,5 @@
     temptation to use the Unix module directly in ocamltest. *)
 
 val has_symlink : unit -> bool
+val symlink : ?to_dir:bool -> string -> string -> unit
 val chmod : string -> int -> unit

ocamltest/ocamltest_unix_dummy.ml

@@ -14,4 +14,5 @@
 
 (* Dummy implementations for when the Unix library isn't built *)
 let has_symlink () = false
+let symlink ?to_dir:_ _ _ = invalid_arg "symlink not available"
 let chmod _ _ = invalid_arg "chmod not available"

ocamltest/ocamltest_unix_real.ml

@@ -25,4 +25,5 @@ let wrap f x =
     in
       raise (Sys_error msg)
 
+let symlink ?to_dir source = wrap (Unix.symlink ?to_dir source)
 let chmod file = wrap (Unix.chmod file)