From a834e6f6ba51f5f2fadef04616d087a81a8492a0 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 17 May 2018 12:56:35 +0700 Subject: [PATCH 1/5] Add tests for reach_for_running --- test/unit-tests/path.mlt | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/test/unit-tests/path.mlt b/test/unit-tests/path.mlt index 3f01e31b..9eb77b9c 100644 --- a/test/unit-tests/path.mlt +++ b/test/unit-tests/path.mlt @@ -284,3 +284,31 @@ Path.is_in_build_dir Path.build_dir [%%expect{| - : bool = false |}] + +Path.reach_for_running Path.build_dir ~from:Path.root +[%%expect{| +- : Stdune.Path.t = ./_build +|}] + +Path.(reach_for_running (relative build_dir "foo/baz") + ~from:(relative build_dir "foo/bar/baz")) +[%%expect{| +- : Stdune.Path.t = ../../baz +|}] + +Path.(reach_for_running (Path.absolute "/fake/path") + ~from:(relative build_dir "foo/bar/baz")) +[%%expect{| +- : Stdune.Path.t = /fake/path +|}] + +Path.(reach_for_running (relative build_dir "foo/baz") + ~from:(Path.absolute "/fake/path")) +[%%expect{| +Exception: Stdune__Exn.Code_error . +|}] + +Path.(reach_for_running (relative root "foo") ~from:(Path.relative root "foo")) +[%%expect{| +- : Stdune.Path.t = ./. +|}] From 8cea102d3cc37930d84f8dd1dc1b89925a841d9a Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 17 May 2018 20:23:48 +0700 Subject: [PATCH 2/5] Fix type of Path.reach_for_running It should return a string rather than a path. Also, make Process.run use it rather than relying on the caller to do it. --- src/action.ml | 2 +- src/process.ml | 10 +++++----- src/stdune/path.mli | 2 +- test/blackbox-tests/test-cases/inline_tests/run.t | 2 +- test/unit-tests/path.mlt | 8 ++++---- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/action.ml b/src/action.ml index 67295852..f6083123 100644 --- a/src/action.ml +++ b/src/action.ml @@ -741,7 +741,7 @@ let exec_run_direct ~ectx ~dir ~env ~stdout_to ~stderr_to prog args = Process.run Strict ~dir ~env ~stdout_to ~stderr_to ~purpose:ectx.purpose - (Path.reach_for_running ~from:dir prog) args + prog args let exec_run ~stdout_to ~stderr_to = let stdout_to = get_std_output stdout_to in diff --git a/src/process.ml b/src/process.ml index f1d8bace..bc9668c5 100644 --- a/src/process.ml +++ b/src/process.ml @@ -232,7 +232,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose if display = Verbose then Format.eprintf "@{Running@}[@{%d@}]: %s@." id (Colors.strip_colors_for_stderr command_line); - let prog = Path.to_string prog in + let prog = Path.reach_for_running prog ~from:(Option.value ~default:Path.build_dir dir) in let argv = Array.of_list (prog :: args) in let output_filename, stdout_fd, stderr_fd, to_close = match stdout_to, stderr_to with @@ -347,11 +347,11 @@ let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args = | [x] -> x | l -> let cmdline = - let prog = Path.to_string prog in - let s = String.concat (prog :: args) ~sep:" " in + let prog_display p = String.concat (p :: args) ~sep:" " in match dir with - | None -> s - | Some dir -> sprintf "cd %s && %s" (Path.to_string dir) s + | None -> prog_display (Path.to_string prog) + | Some dir -> sprintf "cd %s && %s" (Path.to_string dir) + (prog_display (Path.reach_for_running prog ~from:dir)) in match l with | [] -> diff --git a/src/stdune/path.mli b/src/stdune/path.mli index 44663266..b1777d9a 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -70,7 +70,7 @@ val absolute : string -> t val to_absolute_filename : t -> root:string -> string val reach : t -> from:t -> string -val reach_for_running : t -> from:t -> t +val reach_for_running : t -> from:t -> string val descendant : t -> of_:t -> t option val is_descendant : t -> of_:t -> bool diff --git a/test/blackbox-tests/test-cases/inline_tests/run.t b/test/blackbox-tests/test-cases/inline_tests/run.t index cc478036..76dd7362 100644 --- a/test/blackbox-tests/test-cases/inline_tests/run.t +++ b/test/blackbox-tests/test-cases/inline_tests/run.t @@ -1,6 +1,6 @@ $ env -u OCAMLRUNPARAM jbuilder runtest simple run alias simple/runtest (exit 2) - (cd _build/default/simple && ./.foo_simple.inline-tests/run.exe) + (cd _build/default/simple && _build/default/simple/.foo_simple.inline-tests/run.exe) Fatal error: exception File "simple/.foo_simple.inline-tests/run.ml", line 1, characters 10-16: Assertion failed [1] diff --git a/test/unit-tests/path.mlt b/test/unit-tests/path.mlt index 9eb77b9c..dfcb4fed 100644 --- a/test/unit-tests/path.mlt +++ b/test/unit-tests/path.mlt @@ -287,19 +287,19 @@ Path.is_in_build_dir Path.build_dir Path.reach_for_running Path.build_dir ~from:Path.root [%%expect{| -- : Stdune.Path.t = ./_build +- : string = "./_build" |}] Path.(reach_for_running (relative build_dir "foo/baz") ~from:(relative build_dir "foo/bar/baz")) [%%expect{| -- : Stdune.Path.t = ../../baz +- : string = "../../baz" |}] Path.(reach_for_running (Path.absolute "/fake/path") ~from:(relative build_dir "foo/bar/baz")) [%%expect{| -- : Stdune.Path.t = /fake/path +- : string = "/fake/path" |}] Path.(reach_for_running (relative build_dir "foo/baz") @@ -310,5 +310,5 @@ Exception: Stdune__Exn.Code_error . Path.(reach_for_running (relative root "foo") ~from:(Path.relative root "foo")) [%%expect{| -- : Stdune.Path.t = ./. +- : string = "./." |}] From 8e72a3a951504b72b32943ce2cd801eb12d299b8 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 17 May 2018 22:58:21 +0700 Subject: [PATCH 3/5] Use Path.root as the default --- src/process.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/process.ml b/src/process.ml index bc9668c5..b82ba99a 100644 --- a/src/process.ml +++ b/src/process.ml @@ -232,7 +232,8 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose if display = Verbose then Format.eprintf "@{Running@}[@{%d@}]: %s@." id (Colors.strip_colors_for_stderr command_line); - let prog = Path.reach_for_running prog ~from:(Option.value ~default:Path.build_dir dir) in + let prog = Path.reach_for_running prog + ~from:(Option.value ~default:Path.root dir) in let argv = Array.of_list (prog :: args) in let output_filename, stdout_fd, stderr_fd, to_close = match stdout_to, stderr_to with From 9a62e70471825e03b30f791576438229c19bf997 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 19 May 2018 18:11:31 +0700 Subject: [PATCH 4/5] Fix command line printing for errors --- src/process.ml | 6 +++++- test/blackbox-tests/test-cases/inline_tests/run.t | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/process.ml b/src/process.ml index b82ba99a..1ec74a5b 100644 --- a/src/process.ml +++ b/src/process.ml @@ -112,7 +112,11 @@ module Fancy = struct | x :: rest -> x :: colorize_args rest let command_line ~prog ~args ~dir ~stdout_to ~stderr_to = - let prog = Path.to_string prog in + let prog = + match dir with + | None -> Path.to_string prog + | Some from -> Path.reach_for_running prog ~from + in let quote = quote_for_shell in let prog = colorize_prog (quote prog) in let s = diff --git a/test/blackbox-tests/test-cases/inline_tests/run.t b/test/blackbox-tests/test-cases/inline_tests/run.t index 76dd7362..cc478036 100644 --- a/test/blackbox-tests/test-cases/inline_tests/run.t +++ b/test/blackbox-tests/test-cases/inline_tests/run.t @@ -1,6 +1,6 @@ $ env -u OCAMLRUNPARAM jbuilder runtest simple run alias simple/runtest (exit 2) - (cd _build/default/simple && _build/default/simple/.foo_simple.inline-tests/run.exe) + (cd _build/default/simple && ./.foo_simple.inline-tests/run.exe) Fatal error: exception File "simple/.foo_simple.inline-tests/run.ml", line 1, characters 10-16: Assertion failed [1] From fc7d2fef211c0eaed5d475f40858c62d87fef58a Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 20 May 2018 20:48:32 +0700 Subject: [PATCH 5/5] Use reach_for_running consistently Also change the default from to Path.root --- src/process.ml | 17 ++++++----------- src/stdune/path.ml | 2 +- src/stdune/path.mli | 4 +++- 3 files changed, 10 insertions(+), 13 deletions(-) diff --git a/src/process.ml b/src/process.ml index 1ec74a5b..000d8364 100644 --- a/src/process.ml +++ b/src/process.ml @@ -112,11 +112,7 @@ module Fancy = struct | x :: rest -> x :: colorize_args rest let command_line ~prog ~args ~dir ~stdout_to ~stderr_to = - let prog = - match dir with - | None -> Path.to_string prog - | Some from -> Path.reach_for_running prog ~from - in + let prog = Path.reach_for_running ?from:dir prog in let quote = quote_for_shell in let prog = colorize_prog (quote prog) in let s = @@ -236,8 +232,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose if display = Verbose then Format.eprintf "@{Running@}[@{%d@}]: %s@." id (Colors.strip_colors_for_stderr command_line); - let prog = Path.reach_for_running prog - ~from:(Option.value ~default:Path.root dir) in + let prog = Path.reach_for_running ?from:dir prog in let argv = Array.of_list (prog :: args) in let output_filename, stdout_fd, stderr_fd, to_close = match stdout_to, stderr_to with @@ -352,11 +347,11 @@ let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args = | [x] -> x | l -> let cmdline = - let prog_display p = String.concat (p :: args) ~sep:" " in + let prog = Path.reach_for_running ?from:dir prog in + let prog_display = String.concat (prog :: args) ~sep:" " in match dir with - | None -> prog_display (Path.to_string prog) - | Some dir -> sprintf "cd %s && %s" (Path.to_string dir) - (prog_display (Path.reach_for_running prog ~from:dir)) + | None -> prog_display + | Some dir -> sprintf "cd %s && %s" (Path.to_string dir) prog_display in match l with | [] -> diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 22c8a334..02d8429c 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -302,7 +302,7 @@ let reach t ~from = | Local t, Local from -> Local.reach t ~from -let reach_for_running t ~from = +let reach_for_running ?(from=root) t = match kind t, kind from with | External _, _ -> t | Local _, External _ -> diff --git a/src/stdune/path.mli b/src/stdune/path.mli index b1777d9a..7936ed11 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -70,7 +70,9 @@ val absolute : string -> t val to_absolute_filename : t -> root:string -> string val reach : t -> from:t -> string -val reach_for_running : t -> from:t -> string + +(** [from] defaults to [Path.root] *) +val reach_for_running : ?from:t -> t -> string val descendant : t -> of_:t -> t option val is_descendant : t -> of_:t -> bool