Portable sed-like functionality (#13008)

Using `sed` is somewhat temperamental: despite POSIX, the CLI is notably
different between BSD and GNU systems making it tedious to use as other
systems don't support the options, the regular expression support is
dependant on arguments, `sed` scripts are fairly difficult to read (with
`/` and `#` separators for paths instead of just command line arguments)
and mostly only used to do simple replacements (so often just overkill).

This PR adds a few new commands to `dune_cmd` to implement `sed`-like
functionality but in a way that is consistent between GNU/Linux, BSDs,
macOS and potentially Windows. It supports in-place replacement, since
this is what we usually wants in our cram tests as well as interactions
via stdio.

Other `sed` functionality could be added, it's implemented in somewhat
extensible way by parsing into a `Sed.t` action and evaluating that.

I've changed some of the helpers from the `dune pkg` tests to use it.

Signed-off-by: Marek Kubica <marek@tarides.com>

Author: Leonidas-from-XIV

test/blackbox-tests/test-cases/pkg/helpers.sh

@@ -41,16 +41,16 @@ build_pkg() {
 
 show_pkg() {
   prefix="$(get_build_pkg_dir $1)"
-  find "$prefix" | sort | sed "s#$prefix##"
+  find "$prefix" | sort | dune_cmd subst "$prefix" ""
 }
 
 strip_sandbox() {
-  sed -E 's#[^ ]*.sandbox/[^/]+#$SANDBOX#g'
+  dune_cmd subst '[^ ]*.sandbox/[^/]+' '$SANDBOX'
 }
 
 show_pkg_targets() {
   prefix="$(get_build_pkg_dir $1)/target"
-  find "$prefix" | sort | sed "s#$prefix##"
+  find "$prefix" | sort | dune_cmd subst "$prefix" ""
 }
 
 show_pkg_cookie() {
@@ -117,7 +117,7 @@ EOF
 set_pkg_to () {
   local value="${1}"
   if grep "(pkg .*)" dune-workspace > /dev/null; then
-    sed -i.bak "s/(pkg .*)/(pkg ${value})/" dune-workspace
+    dune_cmd substitute "(pkg .*)" "(pkg ${value})" dune-workspace
   else
     echo "(pkg ${value})" >> dune-workspace
   fi
@@ -132,7 +132,7 @@ disable_pkg() {
 }
 
 unset_pkg() {
-  sed -i.bak "/(pkg/d" dune-workspace
+  dune_cmd delete "\(pkg" dune-workspace
 }
 
 add_mock_repo_if_needed() {
@@ -210,7 +210,7 @@ dune_pkg_lock_normalized() {
     else
       cat solve-stderr.txt \
         | awk '/Solution/{printf"%s:\n",$0;f=0};f{print};/Dependencies.*:/{f=1}' \
-        | sed 's/(none)/(no dependencies to lock)/'
+        | dune_cmd subst '\(none\)' '(no dependencies to lock)'
     fi
   else
     cat solve-stderr.txt | sed '/The dependency solver failed to find a solution for the following platforms:/,/\.\.\.with this error:/d'
@@ -243,7 +243,7 @@ EOF
 }
 
 print_source() {
-  cat "${default_lock_dir}"/"$1".pkg | sed -n "/source/,//p" | sed "s#$PWD#PWD#g" | tr '\n' ' '| tr -s " "
+  cat "${default_lock_dir}"/"$1".pkg | sed -n "/source/,//p" | dune_cmd subst "$PWD" "PWD" | tr '\n' ' '| tr -s " "
 }
 
 solve() {
@@ -256,6 +256,6 @@ solve() {
 # on different machines, such as lockfiles generated by expanding the "$PWD"
 # variable.
 sanitize_pkg_digest() {
-    local pkg_name_and_version="${1}"
-    sed "s#$pkg_name_and_version-[0-9a-f]*#$pkg_name_and_version-DIGEST_HASH#"
+  local pkg_name_and_version="${1}"
+  dune_cmd subst "$pkg_name_and_version-[0-9a-f]*" "$pkg_name_and_version-DIGEST_HASH"
 }

test/blackbox-tests/utils/dune_cmd.ml

@@ -322,7 +322,7 @@ module Wait_for_file_to_appear = struct
     | [ file ] ->
       let file = Path.of_filename_relative_to_initial_cwd file in
       { file }
-    | _ -> raise (Arg.Bad (sprintf "1 argument must be provided"))
+    | _ -> raise (Arg.Bad "1 argument must be provided")
   ;;
 
   let run { file } =
@@ -357,6 +357,115 @@ module Exec_a = struct
   let () = register name of_args run
 end
 
+module Sed = struct
+  type io =
+    | Inplace of Path.t
+    | Stdio
+
+  type action =
+    | Subst of
+        { rex : Re.re
+        ; replacement : string
+        }
+    | Delete of Re.re
+
+  type t =
+    { io : io
+    ; action : action
+    }
+
+  let io = function
+    | Some p -> Inplace p
+    | None -> Stdio
+  ;;
+
+  let subst ?file ~rex ~replacement () =
+    let io = io file in
+    let action = Subst { rex; replacement } in
+    { io; action }
+  ;;
+
+  let delete ?file ~rex () =
+    let io = io file in
+    let action = Delete rex in
+    { io; action }
+  ;;
+
+  let run_action inputs = function
+    | Subst { rex; replacement } ->
+      List.map inputs ~f:(fun line ->
+        Re.Pcre.substitute ~rex ~subst:(fun _ -> replacement) line)
+    | Delete rex -> List.filter inputs ~f:(fun line -> not @@ Re.Pcre.pmatch ~rex line)
+  ;;
+
+  let run { io; action } =
+    let inputs, output =
+      match io with
+      | Inplace p ->
+        let inputs = p |> Io.read_file |> String.split_on_char ~sep:'\n' in
+        let output outputs =
+          let temp = p |> Path.to_string |> sprintf "%s.tmp" |> Path.of_string in
+          Io.write_lines temp outputs;
+          Unix.rename (Path.to_string temp) (Path.to_string p)
+        in
+        inputs, output
+      | Stdio ->
+        let inputs = Io.input_lines stdin in
+        let output outputs =
+          List.iter outputs ~f:(fun line ->
+            output_string stdout line;
+            output_char stdout '\n')
+        in
+        inputs, output
+    in
+    let outputs = run_action inputs action in
+    output outputs
+  ;;
+end
+
+module Run_sed (C : sig
+    val name : string
+    val of_args : string list -> Sed.t
+  end) =
+struct
+  let () = register C.name C.of_args Sed.run
+end
+
+module Subst = Run_sed (struct
+    let name = "subst"
+
+    let of_args = function
+      | pattern :: replacement :: optional ->
+        let rex = Re.Pcre.regexp pattern in
+        let file =
+          match optional with
+          | [] -> None
+          | [ filename ] -> Some (Path.of_filename_relative_to_initial_cwd filename)
+          | _ :: _ :: _ -> raise (Arg.Bad "Too many arguments")
+        in
+        Sed.subst ?file ~rex ~replacement ()
+      | _ -> raise (Arg.Bad "Required arguments are <pattern> <replacement> [file]")
+    ;;
+  end)
+
+module Delete = Run_sed (struct
+    let name = "delete"
+
+    let of_args = function
+      | pattern :: optional ->
+        let rex = Re.Pcre.regexp pattern in
+        Printexc.record_backtrace true;
+        let file =
+          match optional with
+          | [] -> None
+          | [ filename ] -> Some (Path.of_filename_relative_to_initial_cwd filename)
+          | _ :: _ :: _ -> raise (Arg.Bad "Too many arguments")
+        in
+        Sed.delete ?file ~rex ()
+      | _ -> raise (Arg.Bad "Required arguments are <pattern> [file]")
+    ;;
+  end)
+
 let () =
   let name, args =
     match Array.to_list Sys.argv with
@@ -368,7 +477,7 @@ let () =
   in
   match Table.find commands name with
   | None ->
-    Format.eprintf "No command %S name found" name;
+    Format.eprintf "No command named %S found" name;
     exit 1
   | Some run -> run args
 ;;