Merge pull request #746 from rgrinberg/alias0-build-dir
Alias0.dir is always in build_dir
This commit is contained in:
commit
5112c23e3f
|
@ -212,29 +212,47 @@ module File_spec = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Alias0 = struct
|
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 pp fmt t = Path.pp fmt (Path.relative t.dir t.name)
|
||||||
|
|
||||||
let suffix = "-" ^ String.make 32 '0'
|
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 name t = t.name
|
||||||
let dir t = t.dir
|
let dir t = t.dir
|
||||||
|
|
||||||
let fully_qualified_name t = Path.relative t.dir t.name
|
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 =
|
let stamp_file t =
|
||||||
Path.relative (Path.insert_after_build_dir_exn t.dir ".aliases") (t.name ^ suffix)
|
Path.relative (Path.insert_after_build_dir_exn t.dir ".aliases") (t.name ^ suffix)
|
||||||
|
|
||||||
|
|
|
@ -99,7 +99,7 @@ module Alias : sig
|
||||||
|
|
||||||
val make : string -> dir:Path.t -> t
|
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:
|
(** The following always holds:
|
||||||
|
|
||||||
|
|
|
@ -457,7 +457,9 @@ module Deps = struct
|
||||||
open Dep_conf
|
open Dep_conf
|
||||||
|
|
||||||
let make_alias t ~scope ~dir s =
|
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
|
let dep t ~scope ~dir = function
|
||||||
| File s ->
|
| File s ->
|
||||||
|
|
|
@ -6,6 +6,14 @@
|
||||||
test-cases/aliases
|
test-cases/aliases
|
||||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
|
(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
|
(alias
|
||||||
((name byte-code-only)
|
((name byte-code-only)
|
||||||
(deps ((package dune) (files_recursively_in test-cases/byte-code-only)))
|
(deps ((package dune) (files_recursively_in test-cases/byte-code-only)))
|
||||||
|
@ -446,6 +454,7 @@
|
||||||
((name runtest)
|
((name runtest)
|
||||||
(deps
|
(deps
|
||||||
((alias aliases)
|
((alias aliases)
|
||||||
|
(alias bad-alias-error)
|
||||||
(alias byte-code-only)
|
(alias byte-code-only)
|
||||||
(alias c-stubs)
|
(alias c-stubs)
|
||||||
(alias configurator)
|
(alias configurator)
|
||||||
|
@ -499,6 +508,7 @@
|
||||||
((name runtest-no-deps)
|
((name runtest-no-deps)
|
||||||
(deps
|
(deps
|
||||||
((alias aliases)
|
((alias aliases)
|
||||||
|
(alias bad-alias-error)
|
||||||
(alias byte-code-only)
|
(alias byte-code-only)
|
||||||
(alias c-stubs)
|
(alias c-stubs)
|
||||||
(alias configurator)
|
(alias configurator)
|
||||||
|
|
|
@ -0,0 +1,3 @@
|
||||||
|
(alias
|
||||||
|
((name runtest)
|
||||||
|
(deps ((alias /foo/bar)))))
|
|
@ -0,0 +1,4 @@
|
||||||
|
|
||||||
|
(alias
|
||||||
|
((name runtest)
|
||||||
|
(deps ((alias ${ROOT}/../../../foobar)))))
|
|
@ -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
|
Loading…
Reference in New Issue