Add SCOPE_ROOT

While analysing packages using jbuilder, I found that some packages
use ${ROOT} to refer to the root of the project. However, this doesn't
work as ${ROOT} depends on the workspace configuration.

Add ${SCOPE_ROOT} to make this easier for projects with a lot of
nested sub-directories.

CHANGES.md

@@ -8,6 +8,9 @@
   toplevel module depends on the toplevel module. This doesn't make as
   such a module would in theory be inaccessible from the outside
 
+- Add `${SCOPE_ROOT}` pointing to the root of the current scope, to
+  fix some misuses of `${ROOT}`
+
 1.0+beta10 (08/06/2017)
 -----------------------
 

doc/jbuild.rst

@@ -533,7 +533,14 @@ expanded by Jbuilder.
 
 Jbuilder supports the following variables:
 
--  ``ROOT`` is the relative path to the root of the build context
+-  ``ROOT`` is the relative path to the root of the build
+   context. Note that ``ROOT`` depends on the worksace
+   configuration. As such you shouldn't use ``ROOT`` to denote the
+   root of your project. Use ``SCOPE_ROOT`` instead for this purpose
+-  ``SCOPE_ROOT`` is the root of the current scope. It is typically
+   the toplevel directory of your project and as long as you have at
+   least one ``<package>.opam`` file there, ``SCOPE_ROOT`` is
+   independant of the workspace configuration
 -  ``CC`` is the C compiler command line being used in the current
    build context
 -  ``CXX`` is the C++ compiler command line being used in the

src/gen_rules.ml

@@ -66,7 +66,7 @@ module Gen(P : Params) = struct
     in
     List.map cclibs ~f
 
-  let build_lib (lib : Library.t) ~flags ~dir ~mode ~modules ~dep_graph =
+  let build_lib (lib : Library.t) ~scope ~flags ~dir ~mode ~modules ~dep_graph =
     Option.iter (Context.compiler ctx mode) ~f:(fun compiler ->
       let target = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext mode) in
       let dep_graph = Ml_kind.Dict.get dep_graph Impl in
@@ -107,7 +107,7 @@ module Gen(P : Params) = struct
            ; A "-a"; A "-o"; Target target
            ; As stubs_flags
            ; Dyn (fun (_, cclibs) -> Arg_spec.quote_args "-cclib" (map_cclibs cclibs))
-           ; As (List.map lib.library_flags ~f:(SC.expand_vars sctx ~dir))
+           ; As (List.map lib.library_flags ~f:(SC.expand_vars sctx ~scope ~dir))
            ; As (match lib.kind with
                | Normal -> []
                | Ppx_deriver | Ppx_rewriter -> ["-linkall"])
@@ -362,7 +362,7 @@ module Gen(P : Params) = struct
          Path.relative dir (header ^ ".h")));
 
     List.iter Mode.all ~f:(fun mode ->
-      build_lib lib ~flags ~dir ~mode ~modules ~dep_graph);
+      build_lib lib ~scope ~flags ~dir ~mode ~modules ~dep_graph);
     (* Build *.cma.js *)
     SC.add_rules sctx (
       let src = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in
@@ -514,7 +514,7 @@ module Gen(P : Params) = struct
       | Static fns -> Static (List.map fns ~f:(Path.relative dir))
     in
     SC.add_rule sctx
-      (SC.Deps.interpret sctx ~dir rule.deps
+      (SC.Deps.interpret sctx ~scope ~dir rule.deps
        >>>
        SC.Action.run
          sctx
@@ -540,7 +540,7 @@ module Gen(P : Params) = struct
     let alias = Alias.make alias_conf.name ~dir in
     let digest_path = Alias.file_with_digest_suffix alias ~digest in
     Alias.add_deps (SC.aliases sctx) alias [digest_path];
-    let deps = SC.Deps.interpret sctx ~dir alias_conf.deps in
+    let deps = SC.Deps.interpret sctx ~scope ~dir alias_conf.deps in
     SC.add_rule sctx
       (match alias_conf.action with
        | None ->

src/jbuild.ml

@@ -67,11 +67,13 @@ module Scope = struct
   type t =
     { name     : string option
     ; packages : Package.t String_map.t
+    ; root     : Path.t
     }
 
   let empty =
     { name     = None
     ; packages = String_map.empty
+    ; root     = Path.root
     }
 
   let make = function
@@ -81,10 +83,13 @@ module Scope = struct
         List.fold_left rest ~init:pkg.Package.name ~f:(fun acc pkg ->
           min acc pkg.Package.name)
       in
+      let root = pkg.path in
+      List.iter rest ~f:(fun pkg -> assert (pkg.Package.path = root));
       { name = Some name
       ; packages =
           String_map.of_alist_exn (List.map pkgs ~f:(fun pkg ->
             pkg.Package.name, pkg))
+      ; root
       }
 
   let package_listing packages =

src/jbuild.mli

@@ -14,6 +14,7 @@ module Scope : sig
     { name     : string option (** First package name in alphabetical order.  [None] for
                                    the global scope. *)
     ; packages : Package.t String_map.t
+    ; root     : Path.t
     }
 
   val make : Package.t list -> t

src/super_context.ml

@@ -75,9 +75,11 @@ let get_external_dir t ~dir =
   Hashtbl.find_or_add t.external_dirs dir ~f:(fun dir ->
     External_dir.create ~dir)
 
-let expand_vars t ~dir s =
+let expand_vars t ~scope ~dir s =
   String_with_vars.expand s ~f:(fun _loc -> function
   | "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir)
+  | "SCOPE_ROOT" ->
+    Some (Path.reach ~from:dir (Path.append t.context.build_dir scope.Scope.root))
   | var -> String_map.find var t.vars)
 
 let resolve_program_internal t ?hint ?(in_the_tree=true) bin =
@@ -400,17 +402,17 @@ module Deps = struct
   open Build.O
   open Dep_conf
 
-  let dep t ~dir = function
+  let dep t ~scope ~dir = function
     | File  s ->
-      let path = Path.relative dir (expand_vars t ~dir s) in
+      let path = Path.relative dir (expand_vars t ~scope ~dir s) in
       Build.path path
       >>^ fun _ -> [path]
     | Alias s ->
-      let path = Alias.file (Alias.make ~dir (expand_vars t ~dir s)) in
+      let path = Alias.file (Alias.make ~dir (expand_vars t ~scope ~dir s)) in
       Build.path path
       >>^ fun _ -> []
     | Glob_files s -> begin
-        let path = Path.relative dir (expand_vars t ~dir s) in
+        let path = Path.relative dir (expand_vars t ~scope ~dir s) in
         let dir = Path.parent path in
         let s = Path.basename path in
         match Glob_lexer.parse_string s with
@@ -420,12 +422,12 @@ module Deps = struct
           die "invalid glob in %s/jbuild: %s" (Path.to_string dir) msg
       end
     | Files_recursively_in s ->
-      let path = Path.relative dir (expand_vars t ~dir s) in
+      let path = Path.relative dir (expand_vars t ~scope ~dir s) in
       Build.files_recursively_in ~dir:path ~file_tree:t.file_tree
       >>^ Pset.elements
 
-  let interpret t ~dir l =
-    Build.all (List.map l ~f:(dep t ~dir))
+  let interpret t ~scope ~dir l =
+    Build.all (List.map l ~f:(dep t ~scope ~dir))
     >>^ List.concat
 end
 
@@ -587,6 +589,7 @@ module Action = struct
         | _ ->
           match var with
           | "ROOT" -> Some (path_exp sctx.context.build_dir)
+          | "SCOPE_ROOT" -> Some (path_exp (Path.append sctx.context.build_dir scope.root))
           | "@" -> begin
               match targets_written_by_user with
               | Infer -> Loc.fail loc "You cannot use ${@} with inferred rules."
@@ -850,7 +853,7 @@ module PP = struct
         ~scope =
     let preprocessor_deps =
       Build.memoize "preprocessor deps"
-        (Deps.interpret sctx ~dir preprocessor_deps)
+        (Deps.interpret sctx ~scope ~dir preprocessor_deps)
     in
     String_map.map modules ~f:(fun (m : Module.t) ->
       let m = setup_reason_rules sctx ~dir m in

src/super_context.mli

@@ -39,7 +39,7 @@ val artifacts : t -> Artifacts.t
 val stanzas_to_consider_for_install : t -> (Path.t * Stanza.t) list
 val cxx_flags : t -> string list
 
-val expand_vars : t -> dir:Path.t -> String_with_vars.t -> string
+val expand_vars : t -> scope:Scope.t -> dir:Path.t -> String_with_vars.t -> string
 
 val add_rule : t -> ?sandbox:bool -> (unit, Action.t) Build.t -> unit
 val add_rules : t -> ?sandbox:bool -> (unit, Action.t) Build.t list -> unit
@@ -115,7 +115,12 @@ end
 (** Interpret dependencies written in jbuild files *)
 module Deps : sig
   (** Evaluates to the actual list of dependencies, ignoring aliases *)
-  val interpret : t -> dir:Path.t -> Dep_conf.t list -> (unit, Path.t list) Build.t
+  val interpret
+    :  t
+    -> scope:Scope.t
+    -> dir:Path.t
+    -> Dep_conf.t list
+    -> (unit, Path.t list) Build.t
 end
 
 (** Interpret action written in jbuild files *)

test/workspaces/misc/blah/jbuild

@@ -0,0 +1,5 @@
+(jbuild_version 1)
+
+(alias
+ ((name runtest)
+  (deps (${SCOPE_ROOT}/023e1a58-4d08-11e7-a041-aa000008c8a6))))

test/workspaces/misc/jbuild

@@ -1,3 +1,5 @@
+(jbuild_version 1)
+
 ;; Test for ${^} with globs in rules
 
 (rule
@@ -32,3 +34,7 @@
  ((name   runtest)
   (deps   (jbuild jbuild-plop))
   (action (run diff -u ${!^}))))
+
+;; For some tests in subdirs
+
+(rule (with-stdout-to 023e1a58-4d08-11e7-a041-aa000008c8a6 (echo "plop")))