From ab6bb0d5f75e08ef7293f4c4fe5cf51bb713db76 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 10 Jul 2018 17:23:56 +0700 Subject: [PATCH 1/7] Fix workspace lookup in cojnuction with --root The workspace is specified to the initial CWD hence we must convert it a path relative to it Signed-off-by: Rudi Grinberg --- bin/main.ml | 3 ++- test/blackbox-tests/test-cases/workspaces/run.t | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 9e0add6241b..29c0336010e 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -84,7 +84,8 @@ module Main = struct setup ~log ?workspace_file:( - Option.map common.workspace_file ~f:Path.of_string) + Option.map common.workspace_file + ~f:Path.of_filename_relative_to_initial_cwd) ?only_packages:common.only_packages ?external_lib_deps_mode ?x:common.x diff --git a/test/blackbox-tests/test-cases/workspaces/run.t b/test/blackbox-tests/test-cases/workspaces/run.t index 5ca2dd04a67..dc2f12a9675 100644 --- a/test/blackbox-tests/test-cases/workspaces/run.t +++ b/test/blackbox-tests/test-cases/workspaces/run.t @@ -25,7 +25,8 @@ analogously, jbuilder will ignore it specifying the workspace file is possible: $ dune build --root custom-workspace --workspace custom-workspace/dune-workspace.dev - Error: workspace file custom-workspace/dune-workspace.dev does not exist + File "/Users/rgrinberg/reps/dune/_build/default/test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev", line 2, characters 10-24: + Error: Unknown constructor does-not-exist [1] Workspaces let you set custom profiles From 93fb319150604f1388b63b3c3c4d0da323fe48f0 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 11 Jul 2018 10:30:15 +0200 Subject: [PATCH 2/7] Fix the workspace test not to leak absolute paths Signed-off-by: Rudi Grinberg --- .../test-cases/workspaces/custom-workspace/dune-workspace.dev | 2 +- test/blackbox-tests/test-cases/workspaces/run.t | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev b/test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev index a27d9ccd794..a72cdd61458 100644 --- a/test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev +++ b/test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev @@ -1,3 +1,3 @@ (lang dune 1.0) -(context (does-not-exist)) \ No newline at end of file +(context (default)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/run.t b/test/blackbox-tests/test-cases/workspaces/run.t index dc2f12a9675..e33d288a067 100644 --- a/test/blackbox-tests/test-cases/workspaces/run.t +++ b/test/blackbox-tests/test-cases/workspaces/run.t @@ -25,9 +25,7 @@ analogously, jbuilder will ignore it specifying the workspace file is possible: $ dune build --root custom-workspace --workspace custom-workspace/dune-workspace.dev - File "/Users/rgrinberg/reps/dune/_build/default/test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev", line 2, characters 10-24: - Error: Unknown constructor does-not-exist - [1] + Entering directory 'custom-workspace' Workspaces let you set custom profiles From 02beadb85648d1df8f60aac1e12d240aadda1da4 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 11 Jul 2018 10:53:19 +0200 Subject: [PATCH 3/7] Use path argument for workspace and config file This path argument will take paths relatively to the initial CWD Signed-off-by: Rudi Grinberg --- bin/main.ml | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 29c0336010e..94c54660f6a 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -12,7 +12,7 @@ type common = ; debug_findlib : bool ; debug_backtraces : bool ; profile : string option - ; workspace_file : string option + ; workspace_file : Path.t option ; root : string ; target_prefix : string ; only_packages : Package.Name.Set.t option @@ -83,9 +83,7 @@ module Main = struct let setup ~log ?external_lib_deps_mode common = setup ~log - ?workspace_file:( - Option.map common.workspace_file - ~f:Path.of_filename_relative_to_initial_cwd) + ?workspace_file:common.workspace_file ?only_packages:common.only_packages ?external_lib_deps_mode ?x:common.x @@ -190,6 +188,11 @@ let find_root () = let package_name = Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp) +let path_arg = + Arg.conv ((fun p -> Ok (Path.of_filename_relative_to_initial_cwd p)) + , Path.pp + ) + let common_footer = `Blocks [ `S "BUGS" @@ -256,7 +259,7 @@ let common = let orig_args = List.concat [ dump_opt "--profile" profile - ; dump_opt "--workspace" workspace_file + ; dump_opt "--workspace" (Option.map ~f:Path.to_string workspace_file) ; orig ] in @@ -433,7 +436,7 @@ let common = in let workspace_file = Arg.(value - & opt (some file) None + & opt (some path_arg) None & info ["workspace"] ~docs ~docv:"FILE" ~doc:"Use this specific workspace file instead of looking it up.") in @@ -470,7 +473,7 @@ let common = let config_file = let config_file = Arg.(value - & opt (some file) None + & opt (some path_arg) None & info ["config-file"] ~docs ~docv:"FILE" ~doc:"Load this configuration file instead of the default one.") in @@ -483,7 +486,7 @@ let common = let merge config_file no_config = match config_file, no_config with | None , false -> `Ok (None , Default) - | Some fn, false -> `Ok (Some "--config-file", This (Path.of_string fn)) + | Some fn, false -> `Ok (Some "--config-file", This fn) | None , true -> `Ok (Some "--no-config" , No_config) | Some _ , true -> incompatible "--no-config" "--config-file" in From ab85720a0631ee4830d6f6c83042cd33a4217d8c Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 11 Jul 2018 12:42:37 +0200 Subject: [PATCH 4/7] Move custom args to Arg submodule Signed-off-by: Rudi Grinberg --- bin/main.ml | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 94c54660f6a..8c0e6655105 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -185,13 +185,17 @@ let find_root () = in (dir, to_cwd) -let package_name = - Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp) +module Arg = struct + include Arg -let path_arg = - Arg.conv ((fun p -> Ok (Path.of_filename_relative_to_initial_cwd p)) - , Path.pp - ) + let package_name = + Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp) + + let path = + Arg.conv ((fun p -> Ok (Path.of_filename_relative_to_initial_cwd p)) + , Path.pp + ) +end let common_footer = `Blocks @@ -436,7 +440,7 @@ let common = in let workspace_file = Arg.(value - & opt (some path_arg) None + & opt (some path) None & info ["workspace"] ~docs ~docv:"FILE" ~doc:"Use this specific workspace file instead of looking it up.") in @@ -473,7 +477,7 @@ let common = let config_file = let config_file = Arg.(value - & opt (some path_arg) None + & opt (some path) None & info ["config-file"] ~docs ~docv:"FILE" ~doc:"Load this configuration file instead of the default one.") in From 630c10edafc7cdbbc7a85a997e16050b33c2be8a Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 11 Jul 2018 16:42:33 +0200 Subject: [PATCH 5/7] Update CHANGELOG Signed-off-by: Rudi Grinberg --- CHANGES.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 273124c3d36..c297290cbab 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,10 @@ +next +---- + +- Fix lookup of command line specified files when `--root` is given. Previously, + passing in `--root` in conjunction with `--workspace` or `--config` would not + work correctly (#997, @rgrinberg) + 1.0.0 (10/07/2018) ------------------ From f9c1d56f55aa264a65b08823f917bad48288855b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 11 Jul 2018 16:57:29 +0200 Subject: [PATCH 6/7] Improve the path custom conv to use original path when restoring args Signed-off-by: Rudi Grinberg --- bin/main.ml | 44 ++++++++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 16 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 8c0e6655105..fb9480c39ba 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -7,12 +7,36 @@ open Fiber.O bootstrap, so we set this reference here *) let () = suggest_function := Cmdliner_suggest.value +module Arg = struct + include Arg + + let package_name = + Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp) + + module Path : sig + type t + val path : t -> Path.t + val arg : t -> string + + val conv : t conv + end = struct + type t = string + + let path p = Path.of_filename_relative_to_initial_cwd p + let arg s = s + + let conv = Arg.conv ((fun p -> Ok p), Format.pp_print_string) + end + + let path = Path.conv +end + type common = { debug_dep_path : bool ; debug_findlib : bool ; debug_backtraces : bool ; profile : string option - ; workspace_file : Path.t option + ; workspace_file : Arg.Path.t option ; root : string ; target_prefix : string ; only_packages : Package.Name.Set.t option @@ -83,7 +107,7 @@ module Main = struct let setup ~log ?external_lib_deps_mode common = setup ~log - ?workspace_file:common.workspace_file + ?workspace_file:(Option.map ~f:Arg.Path.path common.workspace_file) ?only_packages:common.only_packages ?external_lib_deps_mode ?x:common.x @@ -185,18 +209,6 @@ let find_root () = in (dir, to_cwd) -module Arg = struct - include Arg - - let package_name = - Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp) - - let path = - Arg.conv ((fun p -> Ok (Path.of_filename_relative_to_initial_cwd p)) - , Path.pp - ) -end - let common_footer = `Blocks [ `S "BUGS" @@ -263,7 +275,7 @@ let common = let orig_args = List.concat [ dump_opt "--profile" profile - ; dump_opt "--workspace" (Option.map ~f:Path.to_string workspace_file) + ; dump_opt "--workspace" (Option.map ~f:Arg.Path.arg workspace_file) ; orig ] in @@ -490,7 +502,7 @@ let common = let merge config_file no_config = match config_file, no_config with | None , false -> `Ok (None , Default) - | Some fn, false -> `Ok (Some "--config-file", This fn) + | Some fn, false -> `Ok (Some "--config-file", This (Arg.Path.path fn)) | None , true -> `Ok (Some "--no-config" , No_config) | Some _ , true -> incompatible "--no-config" "--config-file" in From b4b7dde4f500fb16b933c4470b74712cca9e6386 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 11 Jul 2018 17:29:45 +0200 Subject: [PATCH 7/7] Add alias just to be sure Signed-off-by: Rudi Grinberg --- bin/main.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/bin/main.ml b/bin/main.ml index fb9480c39ba..dd48d6f0134 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -29,6 +29,9 @@ module Arg = struct end let path = Path.conv + + [@@@ocaml.warning "-32"] + let file = path end type common =