From 9cc77e2a4814841f025111cae902af605a0c10d8 Mon Sep 17 00:00:00 2001
From: Etienne Millon <me@emillon.org>
Date: Tue, 2 Aug 2022 17:08:36 +0200
Subject: [PATCH] Add dune exec --prefix

This adds a prefix that is executed instead of the command itself.
This is useful to run a command under tools like time or perf.

Closes #2691

Signed-off-by: Etienne Millon <me@emillon.org>
---
 CHANGES.md                                   |  3 +
 bin/exec.ml                                  | 11 ++-
 test/blackbox-tests/test-cases/exec-prefix.t | 81 ++++++++++++++++++++
 3 files changed, 93 insertions(+), 2 deletions(-)
 create mode 100644 test/blackbox-tests/test-cases/exec-prefix.t

diff --git a/CHANGES.md b/CHANGES.md
index b24e81084102..d940ad7c7723 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -4,6 +4,9 @@
 - Do not ignore rules marked `(promote (until-clean))` when
   `--ignore-promoted-rules` (or `-p`) is passed. (#6010, fixes #4401, @emillon)
 
+- Add `dune exec --prefix` to run a command through a wrapper like `time` or
+  `perf`. (#...., fixes #2691, @emillon)
+
 3.4.1 (26-07-2022)
 ------------------
 
diff --git a/bin/exec.ml b/bin/exec.ml
index b596a74956e4..9986c8f79fb4 100644
--- a/bin/exec.ml
+++ b/bin/exec.ml
@@ -42,7 +42,13 @@ let term =
     Arg.(
       value & flag
       & info [ "no-build" ] ~doc:"don't rebuild target before executing")
-  and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in
+  and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS"))
+  and+ prefix =
+    Arg.(
+      value
+      & opt (list ~sep:' ' string) []
+      & info [ "prefix" ] ~doc:"run <prefix cmd> instead of <cmd>")
+  in
   let config = Common.init common in
   let prog, argv, env =
     Scheduler.go ~common ~config (fun () ->
@@ -126,8 +132,9 @@ let term =
                 | None -> not_found ()))
         in
         let prog = Path.to_string prog in
-        let argv = prog :: args in
+        let argv = prefix @ (prog :: args) in
         let env = Super_context.context_env sctx in
+        let prog = List.hd argv in
         Fiber.return (prog, argv, env))
   in
   restore_cwd_and_execve common prog argv env
diff --git a/test/blackbox-tests/test-cases/exec-prefix.t b/test/blackbox-tests/test-cases/exec-prefix.t
new file mode 100644
index 000000000000..6874642c836b
--- /dev/null
+++ b/test/blackbox-tests/test-cases/exec-prefix.t
@@ -0,0 +1,81 @@
+"dune exec --prefix wrap ./e.exe args" behaves like "dune exec ./e.exe args"
+except that it executes "wrap" with the rest passed as arguments instead.
+
+This is useful for "adverbial" commands like time or perf.
+
+  $ cat > dune-project << EOF
+  > (lang dune 1.0)
+  > EOF
+  $ cat > dune << EOF
+  > (executable
+  >  (name e))
+  > EOF
+
+The executable just displays "Hello" and its arguments.
+
+  $ cat > e.ml << EOF
+  > let () =
+  >   print_endline "Hello";
+  >   Array.iteri (fun i s ->
+  >     Printf.printf "argv[%d] = %s\n" i s
+  >     ) Sys.argv
+  > EOF
+
+The wrapper parses its own arguments and executes the rest.
+
+  $ cat > wrap.sh << 'EOF'
+  > #!/bin/sh
+  > while getopts "xy" o; do
+  >   echo "Got option: $o"
+  >   shift $((OPTIND-1))
+  > done
+  > echo Before
+  > "$@"
+  > echo After
+  > EOF
+  $ chmod +x wrap.sh
+
+With no wrapper, e is executed with the program name and arguments in argv.
+
+  $ dune exec ./e.exe a b c
+  Hello
+  argv[0] = _build/default/e.exe
+  argv[1] = a
+  argv[2] = b
+  argv[3] = c
+
+With just a string as prefix, the wrapper sees no arguments and executes the
+program with its arguments.
+
+  $ dune exec --prefix ./wrap.sh ./e.exe a b c
+  Before
+  Hello
+  argv[0] = _build/default/e.exe
+  argv[1] = a
+  argv[2] = b
+  argv[3] = c
+  After
+
+--prefix is actually space-separated: the wrapper gets the ones passed in
+--prefix, and the executable gets the rest (this is up to the wrapper, but most
+work this way).
+
+  $ dune exec --prefix './wrap.sh -x -y' ./e.exe a b c
+  Got option: x
+  Got option: y
+  Before
+  Hello
+  argv[0] = _build/default/e.exe
+  argv[1] = a
+  argv[2] = b
+  argv[3] = c
+  After
+
+When the prefix is empty, this is equivalent to when no prefix is passed.
+
+  $ dune exec --prefix '' ./e.exe a b c
+  Hello
+  argv[0] = _build/default/e.exe
+  argv[1] = a
+  argv[2] = b
+  argv[3] = c