From a3c6f417d0cedd89f6695b698d8c73918ff52948 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 7 Aug 2018 00:48:05 +0300 Subject: [PATCH 1/5] Add test case for 1101 Signed-off-by: Rudi Grinberg --- test/blackbox-tests/dune.inc | 10 ++++++++++ .../test-cases/dune-build-dir-exec-1101/dune | 1 + .../test-cases/dune-build-dir-exec-1101/dune-project | 1 + .../test-cases/dune-build-dir-exec-1101/main.ml | 1 + .../test-cases/dune-build-dir-exec-1101/run.t | 3 +++ 5 files changed, 16 insertions(+) create mode 100644 test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune create mode 100644 test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune-project create mode 100644 test/blackbox-tests/test-cases/dune-build-dir-exec-1101/main.ml create mode 100644 test/blackbox-tests/test-cases/dune-build-dir-exec-1101/run.t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index af7c5ab8..7295b221 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -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) diff --git a/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune new file mode 100644 index 00000000..8ac60cee --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune @@ -0,0 +1 @@ +(executable (name main)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune-project b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune-project new file mode 100644 index 00000000..6687faf2 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/main.ml b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/main.ml new file mode 100644 index 00000000..6bf92d61 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/main.ml @@ -0,0 +1 @@ +print_endline "foobar";; diff --git a/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/run.t b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/run.t new file mode 100644 index 00000000..18306e39 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/run.t @@ -0,0 +1,3 @@ + $ DUNE_BUILD_DIR="$PWD/_custom" dune exec ./main.exe + File unavailable: /Users/rgrinberg/reps/dune/_build/default/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/_custom/default/main.exe + [1] From 6197a49c41814f5581d8d619039346e7d717212b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 7 Aug 2018 01:02:01 +0300 Subject: [PATCH 2/5] Simplify target resolution code Split it into 3 functinos * Resolve 1 targets * Do logging * Resolve all targets Signed-off-by: Rudi Grinberg --- bin/main.ml | 120 ++++++++++++++++++++++++++-------------------------- 1 file changed, 61 insertions(+), 59 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index d9a8f494..43d9bb09 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -659,72 +659,74 @@ let check_path contexts = name (hint name (String.Set.to_list contexts)) +let resolve_target common (setup : Main.setup) s = + let check_path = check_path setup.contexts in + 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 + +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 ~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:(resolve_target common 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 From 264263c819f3f26e8d0affd7b235f2fd7106c27d Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 7 Aug 2018 01:04:18 +0300 Subject: [PATCH 3/5] Split target resolution from string -> path conversion Signed-off-by: Rudi Grinberg --- bin/main.ml | 48 ++++++++++++++++++++++++++---------------------- 1 file changed, 26 insertions(+), 22 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 43d9bb09..18c41f5d 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -659,6 +659,31 @@ let check_path contexts = name (hint name (String.Set.to_list contexts)) +let resolve_path path ~(setup : Main.setup) = + let check_path = check_path setup.contexts 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 + let resolve_target common (setup : Main.setup) s = let check_path = check_path setup.contexts in if String.is_prefix s ~prefix:"@" then begin @@ -679,28 +704,7 @@ let resolve_target common (setup : Main.setup) s = 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 + resolve_path path ~setup end let log_targets ~log targets = From 6dc6ac3668a7f95ea39c8fd86d88f168723e9239 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 7 Aug 2018 01:08:15 +0300 Subject: [PATCH 4/5] Fix #1101 Do not attempt to convert string -> path -> string as this loses information Signed-off-by: Rudi Grinberg --- bin/main.ml | 16 +++++++++++----- .../test-cases/dune-build-dir-exec-1101/run.t | 3 +-- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 18c41f5d..6cda7945 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -684,7 +684,7 @@ let resolve_path path ~(setup : Main.setup) = | [] -> can't_build path | l -> Ok l -let resolve_target common (setup : Main.setup) s = +let resolve_target common ~(setup : Main.setup) s = let check_path = check_path setup.contexts in if String.is_prefix s ~prefix:"@" then begin let pos, is_rec = @@ -719,12 +719,14 @@ let log_targets ~log targets = (Path.to_string_maybe_quoted path)); flush stdout -let resolve_targets ~log common (setup : Main.setup) user_targets = +let resolve_targets_mixed ~log common (setup : Main.setup) user_targets = match user_targets with | [] -> [] | _ -> let targets = - List.map user_targets ~f:(resolve_target common setup) 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:"; List.concat_map targets ~f:(function @@ -734,6 +736,10 @@ let resolve_targets ~log common (setup : Main.setup) user_targets = 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 @@ -1236,8 +1242,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 _ -> []) diff --git a/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/run.t b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/run.t index 18306e39..4598a1b9 100644 --- a/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/run.t +++ b/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/run.t @@ -1,3 +1,2 @@ $ DUNE_BUILD_DIR="$PWD/_custom" dune exec ./main.exe - File unavailable: /Users/rgrinberg/reps/dune/_build/default/test/blackbox-tests/test-cases/dune-build-dir-exec-1101/_custom/default/main.exe - [1] + foobar From 9a504bc86acd535ea3d59d9cbb66966955241b4f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 7 Aug 2018 11:40:45 +0300 Subject: [PATCH 5/5] Remove pointless polymorphic variant and check_path Signed-off-by: Rudi Grinberg --- bin/main.ml | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 6cda7945..21561f7e 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -659,9 +659,12 @@ let check_path contexts = name (hint name (String.Set.to_list contexts)) +type resolve_input = + | Path of Path.t + | String of string + let resolve_path path ~(setup : Main.setup) = - let check_path = check_path setup.contexts in - check_path path; + check_path setup.contexts path; let can't_build path = Error (path, target_hint setup path); in @@ -685,7 +688,6 @@ let resolve_path path ~(setup : Main.setup) = | l -> Ok l let resolve_target common ~(setup : Main.setup) s = - let check_path = check_path setup.contexts in if String.is_prefix s ~prefix:"@" then begin let pos, is_rec = if String.length s >= 2 && s.[1] = '@' then @@ -695,7 +697,7 @@ let resolve_target common ~(setup : Main.setup) s = 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; + 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 @@ -725,8 +727,8 @@ let resolve_targets_mixed ~log common (setup : Main.setup) user_targets = | _ -> let targets = List.map user_targets ~f:(function - | `String s -> resolve_target common ~setup s - | `Path p -> resolve_path p ~setup) in + | 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:"; List.concat_map targets ~f:(function @@ -737,7 +739,7 @@ let resolve_targets_mixed ~log common (setup : Main.setup) user_targets = targets let resolve_targets ~log common (setup : Main.setup) user_targets = - List.map ~f:(fun s -> `String s) 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 = @@ -1242,7 +1244,7 @@ let exec = [p] | `This_abs _ -> []) - |> List.map ~f:(fun p -> `Path p) + |> List.map ~f:(fun p -> Path p) |> resolve_targets_mixed ~log common setup |> List.concat_map ~f:(function | Ok targets -> targets