Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Alias0.dir is always in build_dir #746

Merged
merged 5 commits into from
May 9, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
44 changes: 31 additions & 13 deletions src/build_system.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
2 changes: 1 addition & 1 deletion src/build_system.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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:

Expand Down
4 changes: 3 additions & 1 deletion src/super_context.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down
10 changes: 10 additions & 0 deletions test/blackbox-tests/dune.inc
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand Down Expand Up @@ -446,6 +454,7 @@
((name runtest)
(deps
((alias aliases)
(alias bad-alias-error)
(alias byte-code-only)
(alias c-stubs)
(alias configurator)
Expand Down Expand Up @@ -499,6 +508,7 @@
((name runtest-no-deps)
(deps
((alias aliases)
(alias bad-alias-error)
(alias byte-code-only)
(alias c-stubs)
(alias configurator)
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
(alias
((name runtest)
(deps ((alias /foo/bar)))))
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@

(alias
((name runtest)
(deps ((alias ${ROOT}/../../../foobar)))))
7 changes: 7 additions & 0 deletions test/blackbox-tests/test-cases/bad-alias-error/run.t
Original file line number Diff line number Diff line change
@@ -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