Merge pull request #2426 from nojb/explicit_context

Add (paths ...) field to (context ...) definition

CHANGES.md

@@ -40,6 +40,9 @@
 - Stub names are no longer allowed relative paths. This was previously a warning
   and is now an error (#2443, @rgrinberg).
 
+- Define (paths ...) fields in (context ...) definitions in order to set or
+  extend any PATH-like variable in the context environment. (#2426, @nojb)
+
 1.11.0 (23/07/2019)
 -------------------
 

doc/usage.rst

@@ -500,6 +500,15 @@ context or can be the description of an opam switch, as follows:
 - ``(host <host_context>)`` choose a different context to build binaries that
   are meant to be executed on the host machine, such as preprocessors.
 
+- ``(paths (<var1> <val1>) .. (<varN> <valN>))`` allows to set the value of any
+  ``PATH``-like variables in this context. If ``PATH`` itself is modified in
+  this way, its value will be used to resolve binaries in the workspace,
+  including finding the compiler and related tools. These variables will also be
+  passed as part of the environment to any program launched by ``dune``. For
+  each variable, the value is specified using the :ref:`ordered-set-language`.
+  Relative paths are interpreted with respect to the workspace root, see
+  :ref:`finding-root`.
+
 Both ``(default ...)`` and ``(opam ...)`` accept a ``targets`` field in order to
 setup cross compilation. See :ref:`advanced-cross-compilation` for more
 information.

src/context.ml

@@ -540,11 +540,38 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
   in
   native :: List.filter_opt others
 
+let extend_paths t ~env =
+  let module Eval =
+    Ordered_set_lang.Make(String)
+      (struct
+        type t = string
+        type key = string
+        let key x = x
+      end)
+  in
+  let t =
+    let f (var, t) =
+      let parse ~loc:_ s = s in
+      let standard = Env.path env |> List.map ~f:Path.to_string in
+      var, Eval.eval t ~parse ~standard
+    in
+    List.map ~f t
+  in
+  let vars =
+    let to_absolute_filename s =
+      Path.of_string s |> Path.to_absolute_filename in
+    let sep = String.make 1 Bin.path_sep in
+    let env = Env.Map.of_list_exn t in
+    let f l = String.concat ~sep (List.map ~f:to_absolute_filename l) in
+    Env.Map.map ~f env
+  in
+  Env.extend ~vars env
+
 let opam_config_var t var =
   opam_config_var ~env:t.env ~cache:t.opam_var_cache var
 
 let default ~merlin ~env_nodes ~env ~targets =
-  let path = Env.path Env.initial in
+  let path = Env.path env in
   create ~kind:Default ~path ~env ~env_nodes ~merlin ~targets
 
 let opam_version =
@@ -611,7 +638,7 @@ let create_for_opam ~root ~env ~env_nodes ~targets ~profile
   in
   let path =
     match Env.Map.find vars "PATH" with
-    | None   -> Env.path Env.initial
+    | None   -> Env.path env
     | Some s -> Bin.parse_path s
   in
   let env = Env.extend env ~vars in
@@ -629,7 +656,7 @@ let instantiate_context env (workspace : Workspace.t)
   in
   match context with
   | Default { targets; name; host_context = _; profile; env = _
-            ; toolchain ; loc = _ } ->
+            ; toolchain ; paths; loc = _ } ->
     let merlin =
       workspace.merlin_context = Some (Workspace.Context.name context)
     in
@@ -638,11 +665,13 @@ let instantiate_context env (workspace : Workspace.t)
       | Some _ -> toolchain
       | None -> Env.get env "OCAMLFIND_TOOLCHAIN"
     in
+    let env = extend_paths ~env paths in
     default ~env ~env_nodes ~profile ~targets ~name ~merlin ~host_context
       ~host_toolchain
   | Opam { base = { targets; name; host_context = _; profile; env = _
-                  ; toolchain; loc = _ }
+                  ; toolchain; paths; loc = _ }
          ; switch; root; merlin } ->
+    let env = extend_paths ~env paths in
     create_for_opam ~root ~env_nodes ~env ~profile ~switch ~name ~merlin
       ~targets ~host_context ~host_toolchain:toolchain
 

src/workspace.ml

@@ -54,6 +54,7 @@ module Context = struct
       ; toolchain    : string option
       ; name         : string
       ; host_context : string option
+      ; paths        : (string * Ordered_set_lang.t) list
       }
 
     let t ~profile =
@@ -64,6 +65,20 @@ module Context = struct
         field_o "host" (Syntax.since syntax (1, 10) >>> string)
       and+ toolchain =
         field_o "toolchain" (Syntax.since syntax (1, 5) >>> string)
+      and+ paths =
+        let f l =
+          match Env.Map.of_list (List.map ~f:(fun ((loc, s), _) -> s, loc) l) with
+          | Ok _ ->
+            List.map ~f:(fun ((_, s), x) -> s, x) l
+          | Error (var, _, loc) ->
+            User_error.raise ~loc
+              [ Pp.textf "the variable %S can appear at most once \
+                          in this stanza." var
+              ]
+        in
+        field "paths" ~default:[]
+          (Syntax.since Stanza.syntax (1, 12) >>>
+           map ~f (list (pair (located string) Ordered_set_lang.decode)))
       and+ loc = loc
       in
       Option.iter
@@ -81,6 +96,7 @@ module Context = struct
       ; name = "default"
       ; host_context
       ; toolchain
+      ; paths
       }
   end
 
@@ -178,6 +194,7 @@ module Context = struct
       ; host_context = None
       ; env = None
       ; toolchain = None
+      ; paths = []
       }
 end
 

src/workspace.mli

@@ -18,6 +18,7 @@ module Context : sig
       ; toolchain    : string option
       ; name         : string
       ; host_context : string option
+      ; paths        : (string * Ordered_set_lang.t) list
       }
   end
   module Opam : sig

test/blackbox-tests/dune.inc

@@ -1614,6 +1614,14 @@
    test-cases/windows-diff
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name workspace-paths)
+ (deps (package dune) (source_tree test-cases/workspace-paths))
+ (action
+  (chdir
+   test-cases/workspace-paths
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name workspaces)
  (deps (package dune) (source_tree test-cases/workspaces))
@@ -1835,6 +1843,7 @@
   (alias vlib-default-impl)
   (alias vlib-wrong-default-impl)
   (alias windows-diff)
+  (alias workspace-paths)
   (alias workspaces)
   (alias wrapped-false-main-module-name)
   (alias wrapped-transition)))
@@ -2009,6 +2018,7 @@
   (alias vlib-default-impl)
   (alias vlib-wrong-default-impl)
   (alias windows-diff)
+  (alias workspace-paths)
   (alias workspaces)
   (alias wrapped-false-main-module-name)
   (alias wrapped-transition)))

test/blackbox-tests/test-cases/workspace-paths/bin/dune

@@ -0,0 +1,3 @@
+(executable
+ (name hello)
+ (promote (until-clean)))

test/blackbox-tests/test-cases/workspace-paths/bin/hello.ml

@@ -0,0 +1,2 @@
+let () =
+  Printf.printf "Hello: %s\n%!" (Sys.getenv "FOO")

test/blackbox-tests/test-cases/workspace-paths/dune

@@ -0,0 +1,8 @@
+(alias
+ (name default)
+ (deps bin/hello.exe)
+ (action (run hello.exe)))
+
+;; Note that if you try the above on Windows it will fail because the program in
+;; the (run ...)  action is supposed to **not** contain the .exe extension, but
+;; if we remove it then it will fail on Unix systems.

test/blackbox-tests/test-cases/workspace-paths/dune-project

@@ -0,0 +1 @@
+(lang dune 1.12)

test/blackbox-tests/test-cases/workspace-paths/dune-workspace

@@ -0,0 +1,5 @@
+(lang dune 1.12)
+
+(context
+ (default
+   (paths (PATH bin :standard) (FOO a b /c \ b))))

test/blackbox-tests/test-cases/workspace-paths/run.t

@@ -0,0 +1,21 @@
+  $ dune build
+         hello alias default
+  Hello: $TESTCASE_ROOT/a:/c
+
+  $ mkdir sub
+  $ cat > sub/dune-workspace <<EOF
+  > (lang dune 1.12)
+  > (context
+  >  (default
+  >    (paths (FOO a) (FOO b))))
+  > EOF
+  $ cat > sub/dune-project <<EOF
+  > (lang dune 1.12)
+  > EOF
+  $ dune build --root sub
+  Entering directory 'sub'
+  File "dune-workspace", line 4, characters 19-22:
+  4 |    (paths (FOO a) (FOO b))))
+                         ^^^
+  Error: the variable "FOO" can appear at most once in this stanza.
+  [1]