commit
a689081550
138
bin/main.ml
138
bin/main.ml
|
@ -659,75 +659,89 @@ let check_path contexts =
|
|||
name
|
||||
(hint name (String.Set.to_list contexts))
|
||||
|
||||
let resolve_targets ~log common (setup : Main.setup) user_targets =
|
||||
type resolve_input =
|
||||
| Path of Path.t
|
||||
| String of string
|
||||
|
||||
let resolve_path path ~(setup : Main.setup) =
|
||||
check_path setup.contexts path;
|
||||
let can't_build path =
|
||||
Error (path, target_hint setup path);
|
||||
in
|
||||
if not (Path.is_managed path) then
|
||||
Ok [File path]
|
||||
else if Path.is_in_build_dir path then begin
|
||||
if Build_system.is_target setup.build_system path then
|
||||
Ok [File path]
|
||||
else
|
||||
can't_build path
|
||||
end else
|
||||
match
|
||||
List.filter_map setup.contexts ~f:(fun ctx ->
|
||||
let path = Path.append ctx.Context.build_dir path in
|
||||
if Build_system.is_target setup.build_system path then
|
||||
Some (File path)
|
||||
else
|
||||
None)
|
||||
with
|
||||
| [] -> can't_build path
|
||||
| l -> Ok l
|
||||
|
||||
let resolve_target common ~(setup : Main.setup) s =
|
||||
if String.is_prefix s ~prefix:"@" then begin
|
||||
let pos, is_rec =
|
||||
if String.length s >= 2 && s.[1] = '@' then
|
||||
(2, false)
|
||||
else
|
||||
(1, true)
|
||||
in
|
||||
let s = String.sub s ~pos ~len:(String.length s - pos) in
|
||||
let path = Path.relative Path.root (prefix_target common s) in
|
||||
check_path setup.contexts path;
|
||||
if Path.is_root path then
|
||||
die "@@ on the command line must be followed by a valid alias name"
|
||||
else if not (Path.is_managed path) then
|
||||
die "@@ on the command line must be followed by a relative path"
|
||||
else
|
||||
Ok [if is_rec then Alias_rec path else Alias path]
|
||||
end else begin
|
||||
let path = Path.relative Path.root (prefix_target common s) in
|
||||
resolve_path path ~setup
|
||||
end
|
||||
|
||||
let log_targets ~log targets =
|
||||
List.iter targets ~f:(function
|
||||
| File path ->
|
||||
Log.info log @@ "- " ^ (Path.to_string path)
|
||||
| Alias path ->
|
||||
Log.info log @@ "- alias " ^
|
||||
(Path.to_string_maybe_quoted path)
|
||||
| Alias_rec path ->
|
||||
Log.info log @@ "- recursive alias " ^
|
||||
(Path.to_string_maybe_quoted path));
|
||||
flush stdout
|
||||
|
||||
let resolve_targets_mixed ~log common (setup : Main.setup) user_targets =
|
||||
match user_targets with
|
||||
| [] -> []
|
||||
| _ ->
|
||||
let check_path = check_path setup.contexts in
|
||||
let targets =
|
||||
List.map user_targets ~f:(fun s ->
|
||||
if String.is_prefix s ~prefix:"@" then begin
|
||||
let pos, is_rec =
|
||||
if String.length s >= 2 && s.[1] = '@' then
|
||||
(2, false)
|
||||
else
|
||||
(1, true)
|
||||
in
|
||||
let s = String.sub s ~pos ~len:(String.length s - pos) in
|
||||
let path = Path.relative Path.root (prefix_target common s) in
|
||||
check_path path;
|
||||
if Path.is_root path then
|
||||
die "@@ on the command line must be followed by a valid alias name"
|
||||
else if not (Path.is_managed path) then
|
||||
die "@@ on the command line must be followed by a relative path"
|
||||
else
|
||||
Ok [if is_rec then Alias_rec path else Alias path]
|
||||
end else begin
|
||||
let path = Path.relative Path.root (prefix_target common s) in
|
||||
check_path path;
|
||||
let can't_build path =
|
||||
Error (path, target_hint setup path);
|
||||
in
|
||||
if not (Path.is_managed path) then
|
||||
Ok [File path]
|
||||
else if Path.is_in_build_dir path then begin
|
||||
if Build_system.is_target setup.build_system path then
|
||||
Ok [File path]
|
||||
else
|
||||
can't_build path
|
||||
end else
|
||||
match
|
||||
List.filter_map setup.contexts ~f:(fun ctx ->
|
||||
let path = Path.append ctx.Context.build_dir path in
|
||||
if Build_system.is_target setup.build_system path then
|
||||
Some (File path)
|
||||
else
|
||||
None)
|
||||
with
|
||||
| [] -> can't_build path
|
||||
| l -> Ok l
|
||||
end
|
||||
)
|
||||
in
|
||||
List.map user_targets ~f:(function
|
||||
| String s -> resolve_target common ~setup s
|
||||
| Path p -> resolve_path p ~setup) in
|
||||
if common.config.display = Verbose then begin
|
||||
Log.info log "Actual targets:";
|
||||
let targets =
|
||||
List.concat_map targets ~f:(function
|
||||
| Ok targets -> targets
|
||||
| Error _ -> []) in
|
||||
List.iter targets ~f:(function
|
||||
| File path ->
|
||||
Log.info log @@ "- " ^ (Path.to_string path)
|
||||
| Alias path ->
|
||||
Log.info log @@ "- alias " ^
|
||||
(Path.to_string_maybe_quoted path)
|
||||
| Alias_rec path ->
|
||||
Log.info log @@ "- recursive alias " ^
|
||||
(Path.to_string_maybe_quoted path));
|
||||
flush stdout;
|
||||
List.concat_map targets ~f:(function
|
||||
| Ok targets -> targets
|
||||
| Error _ -> [])
|
||||
|> log_targets ~log
|
||||
end;
|
||||
targets
|
||||
|
||||
let resolve_targets ~log common (setup : Main.setup) user_targets =
|
||||
List.map ~f:(fun s -> String s) user_targets
|
||||
|> resolve_targets_mixed ~log common setup
|
||||
|
||||
let resolve_targets_exn ~log common setup user_targets =
|
||||
resolve_targets ~log common setup user_targets
|
||||
|> List.concat_map ~f:(function
|
||||
|
@ -1230,8 +1244,8 @@ let exec =
|
|||
[p]
|
||||
| `This_abs _ ->
|
||||
[])
|
||||
|> List.map ~f:Path.to_string
|
||||
|> resolve_targets ~log common setup
|
||||
|> List.map ~f:(fun p -> Path p)
|
||||
|> resolve_targets_mixed ~log common setup
|
||||
|> List.concat_map ~f:(function
|
||||
| Ok targets -> targets
|
||||
| Error _ -> [])
|
||||
|
|
|
@ -103,6 +103,14 @@
|
|||
test-cases/dev-flag-1103
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name dune-build-dir-exec-1101)
|
||||
(deps (package dune) (source_tree test-cases/dune-build-dir-exec-1101))
|
||||
(action
|
||||
(chdir
|
||||
test-cases/dune-build-dir-exec-1101
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name dune-jbuild-var-case)
|
||||
(deps (package dune) (source_tree test-cases/dune-jbuild-var-case))
|
||||
|
@ -764,6 +772,7 @@
|
|||
(alias dep-vars)
|
||||
(alias depend-on-the-universe)
|
||||
(alias dev-flag-1103)
|
||||
(alias dune-build-dir-exec-1101)
|
||||
(alias dune-jbuild-var-case)
|
||||
(alias dune-ppx-driver-system)
|
||||
(alias dune-project-edition)
|
||||
|
@ -858,6 +867,7 @@
|
|||
(alias dep-vars)
|
||||
(alias depend-on-the-universe)
|
||||
(alias dev-flag-1103)
|
||||
(alias dune-build-dir-exec-1101)
|
||||
(alias dune-jbuild-var-case)
|
||||
(alias dune-ppx-driver-system)
|
||||
(alias dune-project-edition)
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
(executable (name main))
|
|
@ -0,0 +1 @@
|
|||
(lang dune 1.1)
|
|
@ -0,0 +1 @@
|
|||
print_endline "foobar";;
|
|
@ -0,0 +1,2 @@
|
|||
$ DUNE_BUILD_DIR="$PWD/_custom" dune exec ./main.exe
|
||||
foobar
|
Loading…
Reference in New Issue