diff --git a/bin/common.ml b/bin/common.ml index 8d3e9f492f6..84bf05c03a7 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -58,7 +58,22 @@ open struct module Manpage = Manpage end -let default_trace_file = Path.Local.of_string "_build/trace.csexp" +let default_build_dir = "_build" +let trace_file_name = "trace.csexp" + +let find_default_trace_file () = + let trace_file = Filename.concat default_build_dir trace_file_name in + let cwd = Sys.getcwd () in + let rec loop dir = + let candidate = Filename.concat dir trace_file in + if Sys.file_exists candidate + then candidate + else ( + let parent = Filename.dirname dir in + if parent = dir then Filename.concat cwd trace_file else loop parent) + in + loop cwd +;; module Package = Dune_lang.Package open Let_syntax @@ -75,8 +90,6 @@ let debug_backtraces = ~doc:(Some "Always print exception backtraces.")) ;; -let default_build_dir = "_build" - let one_of term1 term2 = Term.ret @@ let+ x, args1 = Term.with_used_args term1 @@ -584,7 +597,7 @@ module Builder = struct ; watch_exclusions : string list ; build_dir : string ; root : string option - ; trace_file : string option + ; trace_file : [ `Default | `User_specified of string ] option ; allow_builds : bool ; default_root_is_cwd : bool ; target_exec : string option @@ -614,7 +627,7 @@ module Builder = struct Buffer.contents b ;; - let make_term ~trace ~allow_pkg_flag = + let make_term ~(trace : bool) ~allow_pkg_flag = let docs = copts_sect in let+ config_from_command_line = shared_with_config_file ~allow_pkg_flag and+ debug_dep_path = @@ -793,7 +806,7 @@ module Builder = struct and+ trace_file = Arg.( value - & opt (some string) trace + & opt (some string) None & info [ "trace-file" ] ~docs @@ -952,21 +965,18 @@ module Builder = struct ; watch_exclusions ; build_dir = Option.value ~default:default_build_dir build_dir ; root - ; trace_file + ; trace_file = + (match trace_file with + | Some s -> Some (`User_specified s) + | None -> if trace then Some `Default else None) ; allow_builds = true ; default_root_is_cwd = false ; target_exec } ;; - let term_no_trace_no_pkg = make_term ~trace:None ~allow_pkg_flag:false - - let term = - make_term - ~trace:(Some (Stdune.Path.Local.to_string default_trace_file)) - ~allow_pkg_flag:true - ;; - + let term_no_trace_no_pkg = make_term ~trace:false ~allow_pkg_flag:false + let term = make_term ~trace:true ~allow_pkg_flag:true let default = Term.eval_no_args_empty_env term let equal @@ -1029,7 +1039,14 @@ module Builder = struct && List.equal String.equal t.watch_exclusions watch_exclusions && String.equal t.build_dir build_dir && Option.equal String.equal t.root root - && Option.equal String.equal t.trace_file trace_file + && Option.equal + (fun a b -> + match a, b with + | `Default, `Default -> true + | `User_specified a, `User_specified b -> String.equal a b + | _ -> false) + t.trace_file + trace_file && Bool.equal t.allow_builds allow_builds && Bool.equal t.default_root_is_cwd default_root_is_cwd && Option.equal String.equal t.target_exec target_exec @@ -1171,20 +1188,24 @@ let init_with_root ~(root : Workspace_root.t) (builder : Builder.t) = let () = match builder.trace_file with | None -> Log.init No_log_file - | Some stats -> + | Some trace_config -> (match (* For default location, try to acquire lock first to avoid corrupting an existing trace from another dune process *) - if String.equal stats (Stdune.Path.Local.to_string default_trace_file) - then ( - match Global_lock.lock ~timeout:None with - | Ok () -> `Create - | Error _ -> `Skip) - else `Create + match trace_config with + | `Default -> + (match Global_lock.lock ~timeout:None with + | Ok () -> `Create + | Error _ -> `Skip) + | `User_specified _ -> `Create with | `Skip -> Log.init No_log_file | `Create -> - let trace = Path.of_filename_relative_to_initial_cwd stats in + let trace = + match trace_config with + | `Default -> Path.build (Path.Build.relative Path.Build.root trace_file_name) + | `User_specified stats -> Path.of_filename_relative_to_initial_cwd stats + in Path.parent trace |> Option.iter ~f:Path.mkdir_p; let stats = Dune_trace.Out.create trace in Dune_trace.set_global stats; diff --git a/bin/common.mli b/bin/common.mli index 6d09f6e2c16..d26e707d12e 100644 --- a/bin/common.mli +++ b/bin/common.mli @@ -1,5 +1,4 @@ open Dune_config_file -open Stdune type t @@ -20,7 +19,7 @@ val watch_exclusions : t -> string list val watch : t -> Dune_rpc_impl.Watch_mode_config.t val file_watcher : t -> Dune_scheduler.Scheduler.Run.file_watcher val prefix_target : t -> string -> string -val default_trace_file : Path.Local.t +val find_default_trace_file : unit -> string (** [Builder] describes how to initialize Dune. *) module Builder : sig diff --git a/bin/trace.ml b/bin/trace.ml index 195153c0065..f58e8538aae 100644 --- a/bin/trace.ml +++ b/bin/trace.ml @@ -264,7 +264,7 @@ let cat = let trace_file = match trace_file with | Some s -> s - | None -> Path.Local.to_string Common.default_trace_file + | None -> Common.find_default_trace_file () in if follow then iter_sexps_follow trace_file ~f:print_with_flush @@ -294,7 +294,7 @@ let commands = let trace_file = match trace_file with | Some s -> s - | None -> Path.Local.to_string Common.default_trace_file + | None -> Common.find_default_trace_file () in iter_sexps trace_file ~f:(fun sexp -> match parse_process_event sexp with diff --git a/doc/changes/fixed/13735.md b/doc/changes/fixed/13735.md new file mode 100644 index 00000000000..cc8e0a1d15e --- /dev/null +++ b/doc/changes/fixed/13735.md @@ -0,0 +1,3 @@ +- Place the default trace file inside the build directory at the + workspace root, rather than relative to the current directory. + (#13735, @vouillon) diff --git a/test/blackbox-tests/test-cases/custom-build-dir.t/run.t b/test/blackbox-tests/test-cases/custom-build-dir.t/run.t index 5a73ce5a8c7..f0eb8f2a00d 100644 --- a/test/blackbox-tests/test-cases/custom-build-dir.t/run.t +++ b/test/blackbox-tests/test-cases/custom-build-dir.t/run.t @@ -2,6 +2,7 @@ _foobar _foobar/default _foobar/default/foo + _foobar/trace.csexp $ rm -rf _foobar @@ -34,6 +35,7 @@ Test with build directory being an absolute path build build/default build/default/foo + build/trace.csexp $ rm -rf build diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/cross-compilation-ocamlfind.t b/test/blackbox-tests/test-cases/custom-cross-compilation/cross-compilation-ocamlfind.t index 37dc2a9130b..cd0776de4a4 100644 --- a/test/blackbox-tests/test-cases/custom-cross-compilation/cross-compilation-ocamlfind.t +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/cross-compilation-ocamlfind.t @@ -77,7 +77,7 @@ Dune should be able to find it too Entering directory 'app' Leaving directory 'app' - $ dune trace cat | jq ' + $ dune trace cat --trace-file app/_build/trace.csexp | jq ' > include "dune"; > processes > | .args diff --git a/test/blackbox-tests/test-cases/exec/exec-cmd.t/run.t b/test/blackbox-tests/test-cases/exec/exec-cmd.t/run.t index 3e1261a32c3..342d56473fb 100644 --- a/test/blackbox-tests/test-cases/exec/exec-cmd.t/run.t +++ b/test/blackbox-tests/test-cases/exec/exec-cmd.t/run.t @@ -29,4 +29,3 @@ $ ls -a test/_build . .. - trace.csexp diff --git a/test/blackbox-tests/test-cases/github7034.t/run.t b/test/blackbox-tests/test-cases/github7034.t/run.t index df9d0f83b8b..569622bdbfd 100644 --- a/test/blackbox-tests/test-cases/github7034.t/run.t +++ b/test/blackbox-tests/test-cases/github7034.t/run.t @@ -111,7 +111,7 @@ But when lang dune is 3.3 or higher the warning becomes an error: Entering directory 'outer' Leaving directory 'outer' - $ dune trace cat | jq 'include "dune"; + $ dune trace cat --trace-file outer/_build/trace.csexp | jq 'include "dune"; > processes > | .args > | select(.target_files and (.target_files | any(contains(".cmx")))) diff --git a/test/blackbox-tests/test-cases/rocq/compose-installed-compat.t/run.t b/test/blackbox-tests/test-cases/rocq/compose-installed-compat.t/run.t index 41c0faa8b53..fedd95ddf79 100644 --- a/test/blackbox-tests/test-cases/rocq/compose-installed-compat.t/run.t +++ b/test/blackbox-tests/test-cases/rocq/compose-installed-compat.t/run.t @@ -48,7 +48,7 @@ Next we go into our Dune project and build it. Now we check the flags that were passed to coqdep and coqc: - $ dune trace cat | jq 'include "dune"; coqcCoqdepFlags' + $ dune trace cat --trace-file A/_build/trace.csexp | jq 'include "dune"; coqcCoqdepFlags' { "name": "rocq", "args": [ diff --git a/test/blackbox-tests/test-cases/rocq/coq/compose-installed-compat.t/run.t b/test/blackbox-tests/test-cases/rocq/coq/compose-installed-compat.t/run.t index 0a705c0bb65..19d445b4dff 100644 --- a/test/blackbox-tests/test-cases/rocq/coq/compose-installed-compat.t/run.t +++ b/test/blackbox-tests/test-cases/rocq/coq/compose-installed-compat.t/run.t @@ -58,7 +58,7 @@ Next we go into our Dune project and build it. Now we check the flags that were passed to coqdep and coqc: - $ dune trace cat | jq 'include "dune"; rocqFlags' + $ dune trace cat --trace-file A/_build/trace.csexp | jq 'include "dune"; rocqFlags' { "name": "coqc", "args": [ diff --git a/test/blackbox-tests/test-cases/rocq/rocq-native/compose-installed-compat.t/run.t b/test/blackbox-tests/test-cases/rocq/rocq-native/compose-installed-compat.t/run.t index 878f3613df8..c9ec3abcb15 100644 --- a/test/blackbox-tests/test-cases/rocq/rocq-native/compose-installed-compat.t/run.t +++ b/test/blackbox-tests/test-cases/rocq/rocq-native/compose-installed-compat.t/run.t @@ -50,7 +50,7 @@ Next we go into our Dune project and build it. Now we check the flags that were passed to coqdep and coqc: - $ dune trace cat | jq 'include "dune"; coqcCoqdepFlags' + $ dune trace cat --trace-file A/_build/trace.csexp | jq 'include "dune"; coqcCoqdepFlags' { "name": "rocq", "args": [ diff --git a/test/blackbox-tests/test-cases/trace/trace-subdir.t b/test/blackbox-tests/test-cases/trace/trace-subdir.t new file mode 100644 index 00000000000..ffa43877217 --- /dev/null +++ b/test/blackbox-tests/test-cases/trace/trace-subdir.t @@ -0,0 +1,32 @@ +Test that trace files are written to the correct location when running dune from +a subdirectory. + + $ make_dune_project 3.21 + $ mkdir -p src + +Run dune build from the subdirectory: + + $ (cd src && dune build --root ..) + Entering directory '..' + Leaving directory '..' + +Check that the trace file is not written in the incorrect location: + + $ test -f src/_build/trace.csexp + [1] + +The trace file should be written in the correct location: + + $ test -f _build/trace.csexp + +dune trace cat should work from both the root and subdirectory: + + $ dune trace cat | jq 'select(.name == "exit") | {name}' + { + "name": "exit" + } + + $ (cd src && dune trace cat | jq 'select(.name == "exit") | {name}') + { + "name": "exit" + }