My own corner of monopam
monopam: lint :with-test scope deps
Extend [monopam lint] to check test-scoped opam deps -- previously the
unused/missing checks operated only on runtime deps (anything tagged
[:with-test], [:with-doc], or [build] was excluded from the comparison).
That left two real classes of issue silently unflagged:
- A test uses library X via [(test (libraries ... X ...))] but X has no
opam dep at all (neither runtime nor [:with-test]). Builds locally
because dune sees the union of all deps, but [opam install --with-test]
from a fresh switch would fail.
- An opam dep is declared [:with-test] but no stanza in any dune file
references it. Stale [:with-test] from a removed test, typically.
Two new issue kinds in [Monopam.Lint]:
- [Missing_test] -- emitted for the first case above. Reported as
"[<subtree>] missing :with-test: <pkgs>" in plain output.
- [Unused_test] -- emitted for the second case. Reported as
"[<subtree>] unused :with-test: <pkgs>".
Also exposed in the table renderer (separate "Missing test" / "Unused
test" columns) and the summary line.
Implementation:
- [opam_pkg] gains a [test : String_set.t] field. New
[scope_in_item / is_with_test] helpers parse the
[{with-test & ...}] grammar without conflating [:with-test] with
[:with-doc] or [:build] (which the existing [is_scoped] still
collapses).
- [extract_used_libs] takes a [?scope:[\`Both | \`Runtime | \`Test]]
argument that filters by stanza kind ([library]/[executable]/
[executables] vs [test]/[tests]). [(mdx ...)] stanzas surface as a
test-scope use of [mdx], so packages that declare [(mdx :with-test)]
in opam aren't falsely flagged as unused-test.
- [check_package] takes a [~dune_test_pkgs] set in addition to
[~dune_pkgs]. The test-scope checks subtract [dune_pkgs] (any-stanza
uses), [runtime_deps], [own_set], and [implicit_deps] -- so a
[:with-test] dep used by a fuzz [(executable ...)] that runs only
via [(rule (alias runtest))] is still considered "used".
[lint.mli] kind doc-comments updated to spell out the new variants.
+208
-73
+41
-25
monopam/bin/cmd_lint.ml
+41
-25
monopam/bin/cmd_lint.ml
···
37
37
38
38
let pp_table issues =
39
39
let groups, order = group_by_subtree issues in
40
-
let columns =
40
+
let kinds =
41
41
[
42
-
Tty.Table.column "Package";
43
-
Tty.Table.column ~max_width:50 "Missing";
44
-
Tty.Table.column ~max_width:50 "Unused";
45
-
Tty.Table.column ~max_width:50 "Dead lib";
46
-
Tty.Table.column ~max_width:50 "Missing pin";
42
+
(Monopam.Lint.Missing, "Missing", `Yellow);
43
+
(Monopam.Lint.Unused, "Unused", `Cyan);
44
+
(Monopam.Lint.Missing_test, "Missing test", `Yellow);
45
+
(Monopam.Lint.Unused_test, "Unused test", `Cyan);
46
+
(Monopam.Lint.Dead_lib, "Dead lib", `Magenta);
47
+
(Monopam.Lint.Missing_pin, "Missing pin", `Red);
47
48
]
48
49
in
50
+
let active_kinds =
51
+
List.filter
52
+
(fun (kind, _, _) ->
53
+
List.exists (fun (i : Monopam.Lint.issue) -> i.kind = kind) issues)
54
+
kinds
55
+
in
56
+
let columns =
57
+
Tty.Table.column "Package"
58
+
:: List.map
59
+
(fun (_, header, _) -> Tty.Table.column ~max_width:50 header)
60
+
active_kinds
61
+
in
49
62
let rows =
50
63
List.map
51
64
(fun subtree ->
52
65
let issues = List.rev (Hashtbl.find groups subtree) in
53
-
let missing = pkgs_of_kind Monopam.Lint.Missing issues in
54
-
let unused = pkgs_of_kind Monopam.Lint.Unused issues in
55
-
let dead = pkgs_of_kind Monopam.Lint.Dead_lib issues in
56
-
let missing_pin = pkgs_of_kind Monopam.Lint.Missing_pin issues in
57
-
[
58
-
Tty.Span.text subtree;
59
-
Tty.Span.styled
60
-
Tty.Style.(fg (Tty.Color.ansi `Yellow))
61
-
(String.concat " " missing);
62
-
Tty.Span.styled
63
-
Tty.Style.(fg (Tty.Color.ansi `Cyan))
64
-
(String.concat " " unused);
65
-
Tty.Span.styled
66
-
Tty.Style.(fg (Tty.Color.ansi `Magenta))
67
-
(String.concat " " dead);
68
-
Tty.Span.styled
69
-
Tty.Style.(fg (Tty.Color.ansi `Red))
70
-
(String.concat " " missing_pin);
71
-
])
66
+
Tty.Span.text subtree
67
+
:: List.map
68
+
(fun (kind, _, color) ->
69
+
Tty.Span.styled
70
+
Tty.Style.(fg (Tty.Color.ansi color))
71
+
(String.concat " " (pkgs_of_kind kind issues)))
72
+
active_kinds)
72
73
order
73
74
in
74
75
let table = Tty.Table.of_rows ~border:Tty.Border.rounded columns rows in
···
81
82
let issues = List.rev (Hashtbl.find groups subtree) in
82
83
let missing = pkgs_of_kind Monopam.Lint.Missing issues in
83
84
let unused = pkgs_of_kind Monopam.Lint.Unused issues in
85
+
let missing_test = pkgs_of_kind Monopam.Lint.Missing_test issues in
86
+
let unused_test = pkgs_of_kind Monopam.Lint.Unused_test issues in
84
87
let dead = pkgs_of_kind Monopam.Lint.Dead_lib issues in
85
88
let missing_pin = pkgs_of_kind Monopam.Lint.Missing_pin issues in
86
89
if missing <> [] then
87
90
Fmt.pr "%s missing: %s@." subtree (String.concat " " missing);
88
91
if unused <> [] then
89
92
Fmt.pr "%s unused: %s@." subtree (String.concat " " unused);
93
+
if missing_test <> [] then
94
+
Fmt.pr "%s missing :with-test: %s@." subtree
95
+
(String.concat " " missing_test);
96
+
if unused_test <> [] then
97
+
Fmt.pr "%s unused :with-test: %s@." subtree
98
+
(String.concat " " unused_test);
90
99
if dead <> [] then
91
100
Fmt.pr "%s dead lib: %s@." subtree (String.concat " " dead);
92
101
if missing_pin <> [] then
···
180
189
let summary_parts ~issues ~source_issues ~dune_warning_issues =
181
190
let n_missing = count_kind Monopam.Lint.Missing issues in
182
191
let n_unused = count_kind Monopam.Lint.Unused issues in
192
+
let n_missing_test = count_kind Monopam.Lint.Missing_test issues in
193
+
let n_unused_test = count_kind Monopam.Lint.Unused_test issues in
183
194
let n_dead = count_kind Monopam.Lint.Dead_lib issues in
184
195
let n_missing_pin = count_kind Monopam.Lint.Missing_pin issues in
185
196
let n_source = List.length source_issues in
···
188
199
[
189
200
(if n_missing > 0 then Some (Fmt.str "%d missing" n_missing) else None);
190
201
(if n_unused > 0 then Some (Fmt.str "%d unused" n_unused) else None);
202
+
(if n_missing_test > 0 then
203
+
Some (Fmt.str "%d missing-test" n_missing_test)
204
+
else None);
205
+
(if n_unused_test > 0 then Some (Fmt.str "%d unused-test" n_unused_test)
206
+
else None);
191
207
(if n_dead > 0 then Some (Fmt.str "%d dead-lib" n_dead) else None);
192
208
(if n_missing_pin > 0 then Some (Fmt.str "%d missing-pin" n_missing_pin)
193
209
else None);
+155
-46
monopam/lib/lint.ml
+155
-46
monopam/lib/lint.ml
···
161
161
name : string;
162
162
runtime : String_set.t;
163
163
(** Runtime deps (no [with-test], [with-doc], [build]). *)
164
+
test : String_set.t;
165
+
(** Deps annotated [:with-test]. Subset of {!all}; disjoint from
166
+
{!runtime} except where a dep is declared twice (rare). *)
164
167
all : String_set.t; (** Every declared dep, regardless of scope. *)
165
168
pin_depends : String_set.t;
166
169
(** Package names from [pin-depends:], stripped of versions. *)
167
170
}
168
171
(** What [scan_opam_files] returns for each [.opam] file: package name plus the
169
-
three dep sets we care about. *)
172
+
dep sets we care about. *)
170
173
171
174
let rec extract_dep_name (v : Opam.Value.t) =
172
175
match v with
···
174
177
| Opam.Value.Option (inner, _) -> extract_dep_name inner
175
178
| _ -> None
176
179
180
+
type dep_scope = { with_test : bool; with_doc : bool; build : bool }
181
+
(** Walk an opam dep entry and report which scope annotations it carries. A dep
182
+
can be annotated with multiple scopes (e.g. [{with-test & build}]); we
183
+
return all that are present. *)
184
+
185
+
let empty_scope = { with_test = false; with_doc = false; build = false }
186
+
187
+
let merge_scope a b =
188
+
{
189
+
with_test = a.with_test || b.with_test;
190
+
with_doc = a.with_doc || b.with_doc;
191
+
build = a.build || b.build;
192
+
}
193
+
194
+
let rec scope_of (v : Opam.Value.t) =
195
+
match v with
196
+
| Opam.Value.Option (_, constraints) -> scope_in_items constraints
197
+
| _ -> empty_scope
198
+
199
+
and scope_in_items items =
200
+
List.fold_left
201
+
(fun acc (item : Opam.Value.t) -> merge_scope acc (scope_in_item item))
202
+
empty_scope items
203
+
204
+
and scope_in_item item =
205
+
match item with
206
+
| Opam.Value.Ident "with-test" -> { empty_scope with with_test = true }
207
+
| Opam.Value.Ident "with-doc" -> { empty_scope with with_doc = true }
208
+
| Opam.Value.Ident "build" -> { empty_scope with build = true }
209
+
| Opam.Value.Logop (_, l, r) ->
210
+
merge_scope (scope_in_item l) (scope_in_item r)
211
+
| Opam.Value.Pfxop (_, inner) -> scope_in_item inner
212
+
| _ -> empty_scope
213
+
177
214
(** Check if a dep entry has [with-test], [with-doc], or [build] scope. *)
178
-
let rec is_scoped (v : Opam.Value.t) =
179
-
match v with
180
-
| Opam.Value.Option (_, constraints) -> has_scope constraints
181
-
| _ -> false
215
+
let is_scoped v =
216
+
let s = scope_of v in
217
+
s.with_test || s.with_doc || s.build
182
218
183
-
and has_scope items =
184
-
List.exists
185
-
(fun (item : Opam.Value.t) ->
186
-
match item with
187
-
| Opam.Value.Ident s -> s = "with-test" || s = "with-doc" || s = "build"
188
-
| Opam.Value.Logop (_, l, r) -> has_scope [ l ] || has_scope [ r ]
189
-
| Opam.Value.Pfxop (_, inner) -> has_scope [ inner ]
190
-
| _ -> false)
191
-
items
219
+
let is_with_test v = (scope_of v).with_test
192
220
193
221
(** Strip the [".version"] suffix from a [pin-depends] entry name like
194
222
["tw.dev"] or ["wire.0.9.0"]. *)
···
216
244
{
217
245
name;
218
246
runtime = String_set.empty;
247
+
test = String_set.empty;
219
248
all = String_set.empty;
220
249
pin_depends = String_set.empty;
221
250
}
···
229
258
let deps =
230
259
match value with Opam.Value.List items -> items | _ -> []
231
260
in
232
-
let runtime, all =
261
+
let runtime, test, all =
233
262
List.fold_left
234
-
(fun (rt, al) dep ->
263
+
(fun (rt, ts, al) dep ->
235
264
match extract_dep_name dep with
236
-
| None -> (rt, al)
265
+
| None -> (rt, ts, al)
237
266
| Some n ->
238
267
let al = String_set.add n al in
239
-
if is_scoped dep then (rt, al)
240
-
else (String_set.add n rt, al))
241
-
(acc.runtime, acc.all) deps
268
+
let ts =
269
+
if is_with_test dep then String_set.add n ts else ts
270
+
in
271
+
let rt =
272
+
if is_scoped dep then rt else String_set.add n rt
273
+
in
274
+
(rt, ts, al))
275
+
(acc.runtime, acc.test, acc.all)
276
+
deps
242
277
in
243
-
{ acc with runtime; all }
278
+
{ acc with runtime; test; all }
244
279
| Opam.Value.Variable ("pin-depends", value) ->
245
280
{
246
281
acc with
···
288
323
| Sexp.List (Sexp.Atom n :: rest) when n = name -> Some rest | _ -> None)
289
324
sexps
290
325
291
-
(** Extract all libraries from [(libraries ...)] in any build stanza, plus build
292
-
tools like menhir detected from [(menhir ...)] stanzas. *)
293
-
let extract_used_libs sexps =
326
+
(** Stanza kinds we care about. [Runtime] covers the kinds whose deps must be
327
+
available at install time of the package. [Test] covers the kinds that are
328
+
only built when [--with-test] is on. *)
329
+
type stanza_kind = Runtime | Test
330
+
331
+
let stanza_kind_of = function
332
+
| "library" | "executable" | "executables" -> Some Runtime
333
+
| "test" | "tests" -> Some Test
334
+
| _ -> None
335
+
336
+
(** Extract libraries from [(libraries ...)] in build stanzas, plus build tools
337
+
like menhir detected from [(menhir ...)] stanzas. [scope] selects which
338
+
stanza kinds to include. *)
339
+
let extract_used_libs ?(scope = `Both) sexps =
294
340
let from_fields fields =
295
341
match field "libraries" fields with
296
342
| None -> []
···
301
347
| Sexp.List [ Sexp.Atom "re_export"; Sexp.Atom s ] -> Some s
302
348
| _ -> None)
303
349
libs
350
+
in
351
+
let kind_matches k =
352
+
match (scope, k) with
353
+
| `Both, _ -> true
354
+
| `Runtime, Runtime -> true
355
+
| `Test, Test -> true
356
+
| _ -> false
304
357
in
305
358
let build_tools =
306
-
List.filter_map
307
-
(function
308
-
| Sexp.List (Sexp.Atom "menhir" :: _) -> Some "menhir" | _ -> None)
309
-
sexps
359
+
if scope = `Test then []
360
+
else
361
+
List.filter_map
362
+
(function
363
+
| Sexp.List (Sexp.Atom "menhir" :: _) -> Some "menhir" | _ -> None)
364
+
sexps
310
365
in
311
-
build_tools
366
+
(* The [(mdx ...)] stanza is its own build kind: its presence means the
367
+
package needs mdx at test-with-doc time. Surface it as a test-scope
368
+
library use so the [:with-test] check finds the matching dep. *)
369
+
let mdx_uses =
370
+
if scope = `Runtime then []
371
+
else
372
+
List.filter_map
373
+
(function Sexp.List (Sexp.Atom "mdx" :: _) -> Some "mdx" | _ -> None)
374
+
sexps
375
+
in
376
+
build_tools @ mdx_uses
312
377
@ List.concat_map
313
378
(function
314
-
| Sexp.List (Sexp.Atom kind :: fields)
315
-
when List.mem kind
316
-
[ "library"; "executable"; "executables"; "test"; "tests" ] ->
317
-
from_fields fields
379
+
| Sexp.List (Sexp.Atom kind :: fields) -> (
380
+
match stanza_kind_of kind with
381
+
| Some k when kind_matches k -> from_fields fields
382
+
| _ -> [])
318
383
| _ -> [])
319
384
sexps
320
385
···
354
419
| Stdlib.Error _ -> []))
355
420
|> String_set.of_list
356
421
357
-
(** Collect all packages referenced via [(libraries ...)] in any dune file in a
358
-
subtree. This covers executable and test deps not captured by META. *)
359
-
let dune_needed_packages ~fs ~index subtree_path =
422
+
(** Collect packages referenced via [(libraries ...)] in dune files of a
423
+
subtree, scoped by stanza kind. With [scope = `Both] this covers executable
424
+
and test deps not captured by META; with [`Runtime] only library/executable
425
+
stanzas; with [`Test] only test/tests stanzas. *)
426
+
let dune_needed_packages ?(scope = `Both) ~fs ~index subtree_path =
360
427
let dune_files = dune_files_in ~fs subtree_path in
361
428
let private_libs = local_private_libs ~fs subtree_path in
362
429
List.concat_map
363
430
(fun df ->
364
431
match load_file fs df with
365
432
| None -> []
366
-
| Some content -> extract_used_libs (parse_sexps content))
433
+
| Some content -> extract_used_libs ~scope (parse_sexps content))
367
434
dune_files
368
435
|> List.filter_map (fun lib ->
369
436
if is_builtin lib || String_set.mem lib private_libs then None
···
493
560
494
561
(* ---- Types ---- *)
495
562
496
-
type kind = Missing | Unused | Dead_lib | Missing_pin
563
+
type kind =
564
+
| Missing
565
+
| Unused
566
+
| Missing_test
567
+
| Unused_test
568
+
| Dead_lib
569
+
| Missing_pin
570
+
497
571
type issue = { subtree : string; kind : kind; package : string }
498
572
499
573
(* ---- Dead-lib detection ----
···
778
852
| exception _ -> false)
779
853
|> List.sort String.compare
780
854
781
-
let check_package ~index ~build_lib ~dune_pkgs ~dune_owner_pkgs ~own_set
782
-
~all_deps ~subtree (pkg : opam_pkg) ~fs =
855
+
let check_package ~index ~build_lib ~dune_pkgs ~dune_test_pkgs ~dune_owner_pkgs
856
+
~own_set ~all_deps ~subtree (pkg : opam_pkg) ~fs =
783
857
let pkg_name = pkg.name in
784
858
let runtime_deps = pkg.runtime in
859
+
let test_deps = pkg.test in
785
860
let meta_path = Fpath.(build_lib / pkg_name / "META") in
786
861
let meta_pkgs, meta_available =
787
862
match load_meta ~fs meta_path with
···
824
899
else acc)
825
900
required_pkgs []
826
901
in
902
+
(* Test-scope checks are independent of META availability: tests are
903
+
compiled from this subtree's dune files, not from installed METAs. *)
904
+
let test_missing =
905
+
String_set.fold
906
+
(fun pkg acc ->
907
+
if String_set.mem pkg own_set then acc
908
+
else if String_set.mem pkg all_deps then acc
909
+
else { subtree; kind = Missing_test; package = pkg } :: acc)
910
+
dune_test_pkgs []
911
+
in
912
+
(* A [:with-test] dep is "used" if any stanza references it -- runtime,
913
+
test, or executable. Some packages put fuzz drivers in [(executable ...)]
914
+
stanzas that only run via [(rule (alias runtest))], so they're
915
+
legitimately scoped [:with-test] in opam even though the stanza kind is
916
+
[executable]. Trust the package's scope choice; only flag [:with-test]
917
+
deps that nothing references at all. *)
918
+
let test_unused =
919
+
String_set.diff test_deps
920
+
(String_set.union dune_pkgs
921
+
(String_set.union runtime_deps
922
+
(String_set.union own_set implicit_deps)))
923
+
|> String_set.filter (fun p -> not (is_conf_pkg p))
924
+
in
925
+
let test_unused_issues =
926
+
String_set.fold
927
+
(fun pkg acc -> { subtree; kind = Unused_test; package = pkg } :: acc)
928
+
test_unused []
929
+
in
930
+
let test_issues = test_missing @ test_unused_issues in
827
931
if meta_available then
828
932
let needed =
829
933
String_set.union meta_pkgs
···
838
942
(fun pkg acc -> { subtree; kind = Unused; package = pkg } :: acc)
839
943
unused []
840
944
in
841
-
missing @ unused_issues
842
-
else missing
945
+
missing @ unused_issues @ test_issues
946
+
else missing @ test_issues
843
947
844
948
let sort_issues (issues : issue list) =
845
949
List.sort
···
849
953
let rank = function
850
954
| Missing -> 0
851
955
| Unused -> 1
852
-
| Dead_lib -> 2
853
-
| Missing_pin -> 3
956
+
| Missing_test -> 2
957
+
| Unused_test -> 3
958
+
| Dead_lib -> 4
959
+
| Missing_pin -> 5
854
960
in
855
961
let ka = rank a.kind in
856
962
let kb = rank b.kind in
···
960
1066
String_set.of_list (List.map (fun (p : opam_pkg) -> p.name) pkgs)
961
1067
in
962
1068
let dune_pkgs = dune_needed_packages ~fs ~index subtree_path in
1069
+
let dune_test_pkgs =
1070
+
dune_needed_packages ~scope:`Test ~fs ~index subtree_path
1071
+
in
963
1072
let dune_owner_pkgs =
964
1073
dune_packages_by_owner ~fs ~index ~own_set subtree_path
965
1074
in
···
984
1093
~subtree pkg
985
1094
@ !issues;
986
1095
let new_issues =
987
-
check_package ~index ~build_lib ~dune_pkgs ~dune_owner_pkgs
988
-
~own_set ~all_deps ~subtree pkg ~fs
1096
+
check_package ~index ~build_lib ~dune_pkgs ~dune_test_pkgs
1097
+
~dune_owner_pkgs ~own_set ~all_deps ~subtree pkg ~fs
989
1098
in
990
1099
issues := new_issues @ !issues)
991
1100
pkgs;
+12
-2
monopam/lib/lint.mli
+12
-2
monopam/lib/lint.mli
···
15
15
16
16
(** The kind of dependency issue. *)
17
17
type kind =
18
-
| Missing (** Library is referenced from a dune stanza but not in opam. *)
19
-
| Unused (** Package is in opam runtime depends but no dune file uses it. *)
18
+
| Missing
19
+
(** Library is referenced from a runtime dune stanza but not in opam. *)
20
+
| Unused
21
+
(** Package is in opam runtime depends but no runtime stanza uses it. *)
22
+
| Missing_test
23
+
(** Library is referenced from a [(test ...)] / [(tests ...)] stanza but
24
+
there is no opam dep for it (neither runtime nor [:with-test]).
25
+
[opam install --with-test] from a fresh switch would fail. *)
26
+
| Unused_test
27
+
(** Package is declared with [:with-test] in opam but nothing in any
28
+
[(test ...)] / [(tests ...)] stanza references it (and no runtime
29
+
stanza pulls it in either). *)
20
30
| Dead_lib
21
31
(** Library is in a stanza's [(libraries ...)] but none of the modules its
22
32
[_opam/lib/<lib>/dune-package] (or [.cmi] files) expose appear in any