From 2f7dca46f8eba60c779d9bee9ae6e539f3ebe7e1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= <francois.bobot@cea.fr>
Date: Wed, 31 Jul 2019 16:33:16 +0200
Subject: [PATCH] Add workspace-paths variable expansion in paths field

---
 src/context.ml                                | 52 ++++++++++++-------
 src/workspace.ml                              |  4 +-
 src/workspace.mli                             |  4 +-
 .../test-cases/workspace-paths/dune-workspace |  2 +-
 .../test-cases/workspace-paths/run.t          |  2 +-
 5 files changed, 40 insertions(+), 24 deletions(-)

diff --git a/src/context.ml b/src/context.ml
index 1cd73ffe696e..d9492acaa63f 100644
--- a/src/context.ml
+++ b/src/context.ml
@@ -530,22 +530,40 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
   in
   native :: List.filter_opt others
 
-let extend_paths t ~env ~build_dir =
-  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
+let extend_paths ~env ~context =
+  let t = Workspace.Context.paths context in
+  let expand (var,t) =
+    let _, _ =
+      Ordered_set_lang.Unexpanded.files t
+        ~f:(fun incl ->
+          User_error.raise ~loc:(String_with_vars.loc incl)
+            [ Pp.text "The :include are not accepted in workspace file"]
+        )
+    in
+    let t =
+      Ordered_set_lang.Unexpanded.expand t
+        ~dir:Path.root
+        ~files_contents:Path.Map.empty
+        ~f:(fun s ->
+          String_with_vars.expand s
+            ~mode:String_with_vars.Mode.Many
+            ~dir:Path.root
+            ~f:(fun var _ ->
+              match String_with_vars.Var.name var with
+              | "workspace_root" ->
+                (* We use String otherwise it doesn't stay absolute *)
+                Some [Value.String (Path.to_absolute_filename Path.root)]
+              | _ -> None
+            )
+           )
     in
-    List.map ~f t
+    let parse ~loc:_ s = s in
+    let standard = Env.path env |> List.map ~f:Path.to_string in
+    var, Ordered_set_lang.String.eval t ~parse ~standard
+  in
+  let t = List.map ~f:expand t in
+  let build_dir =
+    Path.Build.relative Path.Build.root (Workspace.Context.name context)
   in
   let vars =
     let to_absolute_filename s =
@@ -656,9 +674,7 @@ let instantiate_context env (workspace : Workspace.t)
       (Env_nodes.extra_env
          ~profile:(Workspace.Context.profile context) env_nodes)
   in
-  let build_dir =
-    Path.Build.relative Path.Build.root (Workspace.Context.name context) in
-  let env = extend_paths ~env ~build_dir (Workspace.Context.paths context) in
+  let env = extend_paths ~env ~context in
   match context with
   | Default { targets; name; host_context = _; profile; env = _
             ; toolchain ; paths = _; loc = _ } ->
diff --git a/src/workspace.ml b/src/workspace.ml
index 0e18fa815cd1..9bda716f8b01 100644
--- a/src/workspace.ml
+++ b/src/workspace.ml
@@ -54,7 +54,7 @@ module Context = struct
       ; toolchain    : string option
       ; name         : string
       ; host_context : string option
-      ; paths        : (string * Ordered_set_lang.t) list
+      ; paths        : (string * Ordered_set_lang.Unexpanded.t) list
       }
 
     let t ~profile =
@@ -78,7 +78,7 @@ module Context = struct
         in
         field "paths" ~default:[]
           (Syntax.since Stanza.syntax (1, 12) >>>
-           map ~f (repeat (pair (located string) Ordered_set_lang.decode)))
+           map ~f (repeat (pair (located string) Ordered_set_lang.Unexpanded.decode)))
       and+ loc = loc
       in
       Option.iter
diff --git a/src/workspace.mli b/src/workspace.mli
index 79916e955db0..81f7976a1d5d 100644
--- a/src/workspace.mli
+++ b/src/workspace.mli
@@ -18,7 +18,7 @@ module Context : sig
       ; toolchain    : string option
       ; name         : string
       ; host_context : string option
-      ; paths        : (string * Ordered_set_lang.t) list
+      ; paths        : (string * Ordered_set_lang.Unexpanded.t) list
       }
   end
   module Opam : sig
@@ -43,7 +43,7 @@ module Context : sig
   val env : t -> Dune_env.Stanza.t
 
   val profile : t -> string
-  val paths : t -> (string * Ordered_set_lang.t) list
+  val paths : t -> (string * Ordered_set_lang.Unexpanded.t) list
 
   val host_context : t -> string option
 end
diff --git a/test/blackbox-tests/test-cases/workspace-paths/dune-workspace b/test/blackbox-tests/test-cases/workspace-paths/dune-workspace
index 1c6616576dd6..9b48d96a31b7 100644
--- a/test/blackbox-tests/test-cases/workspace-paths/dune-workspace
+++ b/test/blackbox-tests/test-cases/workspace-paths/dune-workspace
@@ -2,4 +2,4 @@
 
 (context
  (default
-   (paths (PATH bin :standard) (FOO a b /c \ b))))
+   (paths (PATH bin :standard) (FOO a b /c %{workspace_root}/d \ b))))
diff --git a/test/blackbox-tests/test-cases/workspace-paths/run.t b/test/blackbox-tests/test-cases/workspace-paths/run.t
index 933ab89b08ec..3d838d449478 100644
--- a/test/blackbox-tests/test-cases/workspace-paths/run.t
+++ b/test/blackbox-tests/test-cases/workspace-paths/run.t
@@ -2,7 +2,7 @@
 
   $ dune build @default
          hello alias default
-  Hello: $TESTCASE_ROOT/_build/default/a:/c
+  Hello: $TESTCASE_ROOT/_build/default/a:/c:$TESTCASE_ROOT/d
 
   $ mkdir sub
   $ cat > sub/dune-workspace <<EOF