Merge pull request #746 from rgrinberg/alias0-build-dir

Alias0.dir is always in build_dir

src/build_system.ml

@@ -212,29 +212,47 @@ module File_spec = struct
 end
 
 module Alias0 = struct
-  type t = { dir : Path.t; name : string }
+  module T : sig
+    type t = private
+      { dir : Path.t
+      ; name : string
+      }
+    val make : string -> dir:Path.t -> t
+    val of_user_written_path : loc:Loc.t -> Path.t -> t
+  end = struct
+    type t =
+      { dir : Path.t
+      ; name : string
+      }
+
+    let make name ~dir =
+      if not (Path.is_in_build_dir dir) || String.contains name '/' then
+        Exn.code_error "Alias0.make: Invalid alias"
+          [ "name", Sexp.To_sexp.string name
+          ; "dir", Path.sexp_of_t dir
+          ];
+      { dir; name }
+
+    let of_user_written_path ~loc path =
+      if not (Path.is_in_build_dir path) then
+        Loc.fail loc "Invalid alias!\n\
+                      Tried to reference path outside build dir: %S"
+          (Path.to_string_maybe_quoted path);
+      { dir = Path.parent path
+      ; name = Path.basename path
+      }
+  end
+  include T
 
   let pp fmt t = Path.pp fmt (Path.relative t.dir t.name)
 
   let suffix = "-" ^ String.make 32 '0'
 
-  let of_path path =
-    if not (Path.is_in_build_dir path) then
-      die "Invalid alias!\nTried to reference alias %S"
-        (Path.to_string_maybe_quoted path);
-    { dir  = Path.parent path
-    ; name = Path.basename path
-    }
-
   let name t = t.name
   let dir  t = t.dir
 
   let fully_qualified_name t = Path.relative t.dir t.name
 
-  let make name ~dir =
-    assert (not (String.contains name '/'));
-    { dir; name }
-
   let stamp_file t =
     Path.relative (Path.insert_after_build_dir_exn t.dir ".aliases") (t.name ^ suffix)
 

src/build_system.mli

@@ -99,7 +99,7 @@ module Alias : sig
 
   val make : string -> dir:Path.t -> t
 
-  val of_path : Path.t -> t
+  val of_user_written_path : loc:Loc.t -> Path.t -> t
 
   (** The following always holds:
 

src/super_context.ml

@@ -457,7 +457,9 @@ module Deps = struct
   open Dep_conf
 
   let make_alias t ~scope ~dir s =
-    Alias.of_path (Path.relative dir (expand_vars t ~scope ~dir s))
+    let loc = String_with_vars.loc s in
+    Alias.of_user_written_path ~loc
+      (Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s))
 
   let dep t ~scope ~dir = function
     | File  s ->

test/blackbox-tests/dune.inc

@@ -6,6 +6,14 @@
     test-cases/aliases
     (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
 
+(alias
+ ((name bad-alias-error)
+  (deps ((package dune) (files_recursively_in test-cases/bad-alias-error)))
+  (action
+   (chdir
+    test-cases/bad-alias-error
+    (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
+
 (alias
  ((name byte-code-only)
   (deps ((package dune) (files_recursively_in test-cases/byte-code-only)))
@@ -446,6 +454,7 @@
  ((name runtest)
   (deps
    ((alias aliases)
+    (alias bad-alias-error)
     (alias byte-code-only)
     (alias c-stubs)
     (alias configurator)
@@ -499,6 +508,7 @@
  ((name runtest-no-deps)
   (deps
    ((alias aliases)
+    (alias bad-alias-error)
     (alias byte-code-only)
     (alias c-stubs)
     (alias configurator)

test/blackbox-tests/test-cases/bad-alias-error/absolute-path/jbuild

@@ -0,0 +1,3 @@
+(alias
+ ((name runtest)
+  (deps ((alias /foo/bar)))))

test/blackbox-tests/test-cases/bad-alias-error/outside-workspace/jbuild

@@ -0,0 +1,4 @@
+
+(alias
+ ((name runtest)
+  (deps ((alias ${ROOT}/../../../foobar)))))

test/blackbox-tests/test-cases/bad-alias-error/run.t

@@ -0,0 +1,7 @@
+  $ dune runtest --root absolute-path 2>&1 | grep -v Entering
+  File "jbuild", line 3, characters 16-24:
+  Error: Invalid alias!
+  Tried to reference path outside build dir: "/foo/bar"
+  $ dune runtest --root outside-workspace 2>&1 | grep -v Entering
+  File "jbuild", line 4, characters 16-39:
+  Error: path outside the workspace: ./../../../foobar from _build/default