commit
a689081550
138
bin/main.ml
138
bin/main.ml
|
@ -659,75 +659,89 @@ let check_path contexts =
|
||||||
name
|
name
|
||||||
(hint name (String.Set.to_list contexts))
|
(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
|
match user_targets with
|
||||||
| [] -> []
|
| [] -> []
|
||||||
| _ ->
|
| _ ->
|
||||||
let check_path = check_path setup.contexts in
|
|
||||||
let targets =
|
let targets =
|
||||||
List.map user_targets ~f:(fun s ->
|
List.map user_targets ~f:(function
|
||||||
if String.is_prefix s ~prefix:"@" then begin
|
| String s -> resolve_target common ~setup s
|
||||||
let pos, is_rec =
|
| Path p -> resolve_path p ~setup) in
|
||||||
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
|
|
||||||
if common.config.display = Verbose then begin
|
if common.config.display = Verbose then begin
|
||||||
Log.info log "Actual targets:";
|
Log.info log "Actual targets:";
|
||||||
let targets =
|
List.concat_map targets ~f:(function
|
||||||
List.concat_map targets ~f:(function
|
| Ok targets -> targets
|
||||||
| Ok targets -> targets
|
| Error _ -> [])
|
||||||
| Error _ -> []) in
|
|> log_targets ~log
|
||||||
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;
|
|
||||||
end;
|
end;
|
||||||
targets
|
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 =
|
let resolve_targets_exn ~log common setup user_targets =
|
||||||
resolve_targets ~log common setup user_targets
|
resolve_targets ~log common setup user_targets
|
||||||
|> List.concat_map ~f:(function
|
|> List.concat_map ~f:(function
|
||||||
|
@ -1230,8 +1244,8 @@ let exec =
|
||||||
[p]
|
[p]
|
||||||
| `This_abs _ ->
|
| `This_abs _ ->
|
||||||
[])
|
[])
|
||||||
|> List.map ~f:Path.to_string
|
|> List.map ~f:(fun p -> Path p)
|
||||||
|> resolve_targets ~log common setup
|
|> resolve_targets_mixed ~log common setup
|
||||||
|> List.concat_map ~f:(function
|
|> List.concat_map ~f:(function
|
||||||
| Ok targets -> targets
|
| Ok targets -> targets
|
||||||
| Error _ -> [])
|
| Error _ -> [])
|
||||||
|
|
|
@ -103,6 +103,14 @@
|
||||||
test-cases/dev-flag-1103
|
test-cases/dev-flag-1103
|
||||||
(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 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
|
(alias
|
||||||
(name dune-jbuild-var-case)
|
(name dune-jbuild-var-case)
|
||||||
(deps (package dune) (source_tree test-cases/dune-jbuild-var-case))
|
(deps (package dune) (source_tree test-cases/dune-jbuild-var-case))
|
||||||
|
@ -764,6 +772,7 @@
|
||||||
(alias dep-vars)
|
(alias dep-vars)
|
||||||
(alias depend-on-the-universe)
|
(alias depend-on-the-universe)
|
||||||
(alias dev-flag-1103)
|
(alias dev-flag-1103)
|
||||||
|
(alias dune-build-dir-exec-1101)
|
||||||
(alias dune-jbuild-var-case)
|
(alias dune-jbuild-var-case)
|
||||||
(alias dune-ppx-driver-system)
|
(alias dune-ppx-driver-system)
|
||||||
(alias dune-project-edition)
|
(alias dune-project-edition)
|
||||||
|
@ -858,6 +867,7 @@
|
||||||
(alias dep-vars)
|
(alias dep-vars)
|
||||||
(alias depend-on-the-universe)
|
(alias depend-on-the-universe)
|
||||||
(alias dev-flag-1103)
|
(alias dev-flag-1103)
|
||||||
|
(alias dune-build-dir-exec-1101)
|
||||||
(alias dune-jbuild-var-case)
|
(alias dune-jbuild-var-case)
|
||||||
(alias dune-ppx-driver-system)
|
(alias dune-ppx-driver-system)
|
||||||
(alias dune-project-edition)
|
(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