Skip to content

Commit 0144dc4

Browse files
rgrinbergrgrinberg
committed
feature: introduce $ dune trace commands
Introduce a command to read all the commands executed by dune. This replaces all practical uses of _build/log Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
1 parent 545f401 commit 0144dc4

File tree

4 files changed

+256
-1
lines changed

4 files changed

+256
-1
lines changed

‎bin/trace.ml‎

Lines changed: 112 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,87 @@ let base_of_sexp (sexp : Sexp.t) =
4444
| _ -> invalid_sexp sexp
4545
;;
4646

47+
type process_info =
48+
{ prog : string
49+
; args : string list
50+
; dir : string option
51+
; exit_code : int
52+
; error : string option
53+
; stderr : string
54+
}
55+
56+
let parse_process_event (sexp : Sexp.t) : process_info option =
57+
match base_of_sexp sexp with
58+
| "process", "finish", _ts, rest ->
59+
let rec extract_fields prog args dir exit error stderr = function
60+
| [] -> prog, args, dir, exit, error, stderr
61+
| Sexp.List [ Atom "process_args"; List arg_sexps ] :: rest ->
62+
let args =
63+
List.filter_map arg_sexps ~f:(function
64+
| Sexp.Atom s -> Some s
65+
| _ -> None)
66+
in
67+
extract_fields prog (Some args) dir exit error stderr rest
68+
| Sexp.List [ Atom "prog"; Atom p ] :: rest ->
69+
extract_fields (Some p) args dir exit error stderr rest
70+
| Sexp.List [ Atom "dir"; Atom d ] :: rest ->
71+
extract_fields prog args (Some d) exit error stderr rest
72+
| Sexp.List [ Atom "exit"; Atom e ] :: rest ->
73+
let exit_code =
74+
try int_of_string e with
75+
| Failure _ -> 0
76+
in
77+
extract_fields prog args dir (Some exit_code) error stderr rest
78+
| Sexp.List [ Atom "error"; Atom err ] :: rest ->
79+
extract_fields prog args dir exit (Some err) stderr rest
80+
| Sexp.List [ Atom "stderr"; Atom s ] :: rest ->
81+
extract_fields prog args dir exit error (Some s) rest
82+
| _ :: rest -> extract_fields prog args dir exit error stderr rest
83+
in
84+
let prog, args, dir, exit, error, stderr =
85+
extract_fields None None None None None None rest
86+
in
87+
(match prog with
88+
| None -> None
89+
| Some prog ->
90+
Some
91+
{ prog
92+
; args = Option.value args ~default:[]
93+
; dir
94+
; exit_code = Option.value exit ~default:0
95+
; error
96+
; stderr = Option.value stderr ~default:""
97+
})
98+
| _ -> None
99+
;;
100+
101+
let format_shell_command (info : process_info) : string =
102+
let module Escape = Escape0 in
103+
let dir_str = Option.value info.dir ~default:"." in
104+
let quoted_dir = Escape.quote_if_needed dir_str in
105+
let quoted_prog = Escape.quote_if_needed info.prog in
106+
let quoted_args = List.map info.args ~f:Escape.quote_if_needed in
107+
let cmd = String.concat ~sep:" " (quoted_prog :: quoted_args) in
108+
Printf.sprintf "(cd %s && %s)" quoted_dir cmd
109+
;;
110+
111+
let format_output (info : process_info) : string =
112+
let cmd_line = format_shell_command info in
113+
if info.exit_code = 0
114+
then cmd_line
115+
else (
116+
let error_line =
117+
match info.error with
118+
| Some err -> Printf.sprintf "# %s" err
119+
| None -> Printf.sprintf "# Exit code: %d" info.exit_code
120+
in
121+
let lines = [ cmd_line; error_line ] in
122+
let lines =
123+
if info.stderr <> "" then lines @ [ "# Stderr:"; info.stderr ] else lines
124+
in
125+
String.concat ~sep:"\n" lines)
126+
;;
127+
47128
let iter_sexps_follow file ~f =
48129
Io.String_path.with_file_in ~binary:true file ~f:(fun chan ->
49130
let rec loop () =
@@ -183,10 +264,40 @@ let cat =
183264
Cmd.v info term
184265
;;
185266

267+
let commands =
268+
let info =
269+
let doc = "Display executed processes in shell format" in
270+
Cmd.info "commands" ~doc
271+
in
272+
let term =
273+
let+ trace_file =
274+
Arg.(
275+
value
276+
& opt (some string) None
277+
& info
278+
[ "trace-file" ]
279+
~docv:"FILE"
280+
~doc:(Some "Read this trace file (default: _build/trace.json)"))
281+
in
282+
let trace_file =
283+
match trace_file with
284+
| Some s -> s
285+
| None -> Path.Local.to_string Common.default_trace_file
286+
in
287+
iter_sexps trace_file ~f:(fun sexp ->
288+
match parse_process_event sexp with
289+
| Some info ->
290+
let output = format_output info in
291+
print_endline output
292+
| None -> ())
293+
in
294+
Cmd.v info term
295+
;;
296+
186297
let group =
187298
let info =
188299
let doc = "Commands to view dune's event trace" in
189300
Cmd.info "trace" ~doc
190301
in
191-
Cmd.group info [ cat ]
302+
Cmd.group info [ cat; commands ]
192303
;;

‎otherlibs/stdune/src/stdune.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -75,6 +75,7 @@ module Applicative = Applicative
7575
module Json = Json
7676
module Log = Log
7777
module Time = Time
78+
module Escape0 = Escape
7879

7980
module type Top_closure = Top_closure.Top_closure
8081

‎test/blackbox-tests/test-cases/trace/commands-advanced.t‎

Lines changed: 87 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,87 @@
1+
Test dune trace commands with special characters and multiple directories
2+
3+
Set up a project with subdirectories:
4+
5+
$ cat >dune-project <<EOF
6+
> (lang dune 3.21)
7+
> EOF
8+
9+
$ mkdir -p subdir
10+
11+
$ cat >dune <<EOF
12+
> (rule
13+
> (target quotes.txt)
14+
> (action (bash "echo 'Hello \"World\"' > quotes.txt")))
15+
> EOF
16+
17+
$ cat >subdir/dune <<EOF
18+
> (rule
19+
> (target output.txt)
20+
> (action (bash "echo 'test' > output.txt")))
21+
> EOF
22+
23+
Build targets to generate trace with commands from different directories:
24+
25+
$ dune build quotes.txt subdir/output.txt 2>&1 | grep -v "Entering directory"
26+
[1]
27+
28+
Verify commands show correct working directories:
29+
30+
$ dune trace commands | grep "cd.*subdir" | dune_cmd subst '[^ ]+/bin/' '' | head -1
31+
(cd _build/default/subdir && bash -e -u -o pipefail -c "echo 'test' > output.txt")
32+
33+
Verify root directory commands:
34+
35+
$ dune trace commands | grep "cd \$TESTCASE_ROOT &&" | head -1
36+
[1]
37+
38+
Test that all process events are captured:
39+
40+
$ dune trace commands | grep "^(cd" | wc -l | awk '{if($1 > 0) print "Found process events"}'
41+
Found process events
42+
43+
Test log output format is consistent (each command on one line unless it fails):
44+
45+
$ dune trace commands | grep "^(cd" | head -1 | grep -c "cd.*&&.*bash"
46+
0
47+
[1]
48+
49+
Create a rule with a command that has special shell characters:
50+
51+
$ cat >dune <<EOF
52+
> (rule
53+
> (target special.txt)
54+
> (action (bash "echo 'test' | cat > special.txt")))
55+
> EOF
56+
57+
$ dune build special.txt 2>&1 | grep -v "Entering directory"
58+
[1]
59+
60+
Verify special characters are properly quoted in output:
61+
62+
$ dune trace commands | grep special | tail -1 | dune_cmd subst '[^ ]+/bin/' ''
63+
(cd _build/default && bash -e -u -o pipefail -c "echo 'test' | cat > special.txt")
64+
65+
Test that successful commands (exit code 0) don't show exit code:
66+
67+
$ dune trace commands | grep -A 1 "special.txt" | grep -c "Exit code" || echo "No exit code for success"
68+
0
69+
No exit code for success
70+
71+
Test with a command in a deeply nested directory:
72+
73+
$ mkdir -p a/b/c
74+
75+
$ cat >a/b/c/dune <<EOF
76+
> (rule
77+
> (target nested.txt)
78+
> (action (bash "pwd > nested.txt")))
79+
> EOF
80+
81+
$ dune build a/b/c/nested.txt 2>&1 | grep -v "Entering directory"
82+
[1]
83+
84+
Verify deeply nested paths are shown correctly:
85+
86+
$ dune trace commands | grep "cd.*a/b/c" | head -1 | dune_cmd subst '[^ ]+/bin/' ''
87+
(cd _build/default/a/b/c && bash -e -u -o pipefail -c "pwd > nested.txt")

‎test/blackbox-tests/test-cases/trace/commands.t‎

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
Test dune trace commands command
2+
3+
Set up a simple project with rules that execute various commands:
4+
5+
$ cat >dune-project <<EOF
6+
> (lang dune 3.21)
7+
> EOF
8+
9+
$ cat >dune <<EOF
10+
> (rule
11+
> (target success.txt)
12+
> (action (system "echo 'Hello World' > success.txt")))
13+
>
14+
> (rule
15+
> (target failure.txt)
16+
> (deps success.txt)
17+
> (action (system "echo 'Error message' >&2 && exit 1")))
18+
>
19+
> (rule
20+
> (target spaces.txt)
21+
> (action (system "echo test > spaces.txt")))
22+
> EOF
23+
24+
Build the successful target to generate trace events:
25+
26+
$ dune build success.txt
27+
28+
Now test the basic trace commands output - it should show commands in shell format:
29+
30+
$ dune trace commands | grep -E "^\(cd .* && " | head -3 | dune_cmd subst '[^ ]+/bin/' ''
31+
(cd . && ocamlc.opt -config)
32+
(cd _build/default && sh -c "echo 'Hello World' > success.txt")
33+
34+
Verify the format is executable by checking it contains cd && pattern:
35+
36+
$ dune trace commands | grep "cd.*&&.*bash" | dune_cmd subst '[^ ]+/bin/' '' | head -1
37+
(cd _build/default && sh -c "echo 'Hello World' > success.txt")
38+
39+
Test with a failing command to verify stderr output:
40+
41+
$ dune build failure.txt
42+
File "dune", lines 5-8, characters 0-104:
43+
5 | (rule
44+
6 | (target failure.txt)
45+
7 | (deps success.txt)
46+
8 | (action (system "echo 'Error message' >&2 && exit 1")))
47+
Error message
48+
[1]
49+
50+
Check that failed processes show exit code and stderr:
51+
52+
$ dune trace commands | grep -A 3 "exit 1" | dune_cmd subst '[^ ]+/bin/' ''
53+
(cd _build/default && sh -c "echo 'Error message' >&2 && exit 1")
54+
# exited with code 1
55+
# Stderr:
56+
Error message

0 commit comments

Comments
 (0)