Fix expansion of user actions

src/action.ml

@@ -29,6 +29,29 @@ let expand_path ~dir ~f template =
       |> String.concat ~sep:" "
       |> Path.relative dir
 
+let expand_prog ctx ~dir ~f template =
+  let resolve s =
+    if String.contains s '/' then
+      Path.relative dir s
+    else
+      match Context.which ctx s with
+      | Some p -> p
+      | None ->
+        die "@{<error>Error@}: Program %s not found in PATH (context: %s)" s ctx.name
+  in
+  match String_with_vars.just_a_var template with
+  | None -> resolve (expand_str ~dir ~f template)
+  | Some v ->
+    match f v with
+    | Not_found -> resolve (expand_str ~dir ~f template)
+    | Path p
+    | Paths [p] -> p
+    | Str s -> resolve s
+    | Paths l ->
+      List.map l ~f:(Path.reach ~from:dir)
+      |> String.concat ~sep:" "
+      |> resolve
+
 module Mini_shexp = struct
   module Ast = struct
     type ('a, 'path) t =
@@ -126,20 +149,20 @@ module Mini_shexp = struct
       Ast.fold t ~init ~f:(fun acc pat ->
         String_with_vars.fold ~init:acc pat ~f)
 
-    let rec expand dir t ~f : (string, Path.t) Ast.t =
+    let rec expand ctx dir t ~f : (string, Path.t) Ast.t =
       match t with
       | Run (prog, args) ->
-        Run (expand_path ~dir ~f prog,
+        Run (expand_prog ctx ~dir ~f prog,
              List.map args ~f:(fun arg -> expand_str ~dir ~f arg))
       | Chdir (fn, t) ->
         let fn = expand_path ~dir ~f fn in
-        Chdir (fn, expand fn t ~f)
+        Chdir (fn, expand ctx fn t ~f)
       | Setenv (var, value, t) ->
         Setenv (expand_str ~dir ~f var, expand_str ~dir ~f value,
-                expand dir t ~f)
+                expand ctx dir t ~f)
       | With_stdout_to (fn, t) ->
-        With_stdout_to (expand_path ~dir ~f fn, expand dir t ~f)
-      | Progn l -> Progn (List.map l ~f:(fun t -> expand dir t ~f))
+        With_stdout_to (expand_path ~dir ~f fn, expand ctx dir t ~f)
+      | Progn l -> Progn (List.map l ~f:(fun t -> expand ctx dir t ~f))
       | Echo x -> Echo (expand_str ~dir ~f x)
       | Cat x -> Cat (expand_path ~dir ~f x)
       | Create_file x -> Create_file (expand_path ~dir ~f x)

src/action.mli

@@ -37,7 +37,7 @@ module Mini_shexp : sig
     val t : t Sexp.Of_sexp.t
     val sexp_of_t : t Sexp.To_sexp.t
     val fold_vars : t -> init:'a -> f:('a -> string -> 'a) -> 'a
-    val expand : Path.t -> t -> f:(string -> var_expansion) -> desc
+    val expand : Context.t -> Path.t -> t -> f:(string -> var_expansion) -> desc
   end with type desc := t
 end
 

src/build.ml

@@ -34,7 +34,7 @@ module Repr = struct
     | Vpath : 'a Vspec.t -> (unit, 'a) t
     | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
     | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
-    | Fail : fail -> ('a, 'a) t
+    | Fail : fail -> (_, _) t
 end
 include Repr
 let repr t = t

src/build.mli

@@ -47,7 +47,7 @@ val lines_of : Path.t -> ('a, string list) t
 
 (** Always fail when executed. We pass a function rather than an exception to get a proper
     backtrace *)
-val fail : fail -> ('a, 'a) t
+val fail : fail -> (_, _) t
 
 module Prog_spec : sig
   type 'a t =
@@ -116,7 +116,7 @@ module Repr : sig
     | Vpath : 'a Vspec.t -> (unit, 'a) t
     | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
     | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
-    | Fail : fail -> ('a, 'a) t
+    | Fail : fail -> (_, _) t
 end
 
 val repr : ('a, 'b) t -> ('a, 'b) Repr.t

src/gen_rules.ml

@@ -1483,18 +1483,24 @@ module Gen(P : Params) = struct
             ~f:(Path.relative dir))
       in
       let forms = extract_artifacts ~dir t in
-      let t =
-        U.expand dir t
-          ~f:(expand_var ~artifacts:forms.artifacts ~targets ~deps)
+      let build =
+        match
+          U.expand ctx dir t
+            ~f:(expand_var ~artifacts:forms.artifacts ~targets ~deps)
+        with
+        | t ->
+          Build.paths (String_map.values forms.artifacts)
+          >>>
+          Build.action t ~dir ~targets
+        | exception e ->
+          Build.fail { fail = fun () -> raise e }
       in
       let build =
         Build.record_lib_deps ~dir ~kind:dep_kind
           (String_set.elements forms.lib_deps
            |> List.map ~f:(fun s -> Lib_dep.Direct s))
         >>>
-        Build.paths (String_map.values forms.artifacts)
-        >>>
-        Build.action t ~dir ~targets
+        build
       in
       match forms.failures with
       | [] -> build