Opinionated OCaml linter with Merlin integration for code quality, naming conventions, and style checks
fix(lint): resolve E010, E320 in memtrace, merlint, monopam
E320: Rename identifiers with too many underscores in test files.
E010: Extract helper functions to reduce nesting depth in hotspots.ml,
check_test_integrity.ml, generate_examples_ml.ml, docs.ml, dune.ml,
cmd_remove.ml, cmd_verse.ml, and clean.ml.
+155
-167
+119
-128
bin/check_test_integrity.ml
+119
-128
bin/check_test_integrity.ml
···
313
313
:: !errors)
314
314
test_dirs
315
315
316
+
(* Check a single rule's test directory structure *)
317
+
let check_rule_structure cram_dir rule_code errors =
318
+
let ( bad_exists,
319
+
good_exists,
320
+
run_exists,
321
+
dune_project_exists,
322
+
dune_exists,
323
+
has_subdirs,
324
+
has_incorrect_root_files ) =
325
+
check_test_files cram_dir rule_code
326
+
in
327
+
if not bad_exists then
328
+
errors :=
329
+
Fmt.str "Error: %s/%s.t/bad.ml is missing" cram_dir rule_code :: !errors;
330
+
if not good_exists then
331
+
errors :=
332
+
Fmt.str "Error: %s/%s.t/good.ml is missing" cram_dir rule_code :: !errors;
333
+
if not run_exists then begin
334
+
errors :=
335
+
Fmt.str "Error: %s/%s.t/run.t is missing" cram_dir rule_code :: !errors;
336
+
()
337
+
end
338
+
else begin
339
+
let has_bad_test, has_good_test, wrong_formats =
340
+
check_run_t_format cram_dir rule_code
341
+
in
342
+
if not has_bad_test then
343
+
errors :=
344
+
Fmt.str "Error: %s/%s.t/run.t doesn't test 'merlint -r %s bad.ml'"
345
+
cram_dir rule_code
346
+
(String.uppercase_ascii rule_code)
347
+
:: !errors;
348
+
if not has_good_test then
349
+
errors :=
350
+
Fmt.str "Error: %s/%s.t/run.t doesn't test 'merlint -r %s good.ml'"
351
+
cram_dir rule_code
352
+
(String.uppercase_ascii rule_code)
353
+
:: !errors;
354
+
List.iter
355
+
(fun msg ->
356
+
errors :=
357
+
Fmt.str "Error: %s/%s.t/run.t: %s" cram_dir rule_code msg :: !errors)
358
+
wrong_formats;
359
+
if has_incorrect_root_files then
360
+
errors :=
361
+
Fmt.str
362
+
"Error: %s/%s.t has dune or dune-project at root but uses \
363
+
subdirectory structure - these files should be in bad/ and good/ \
364
+
subdirs instead"
365
+
cram_dir rule_code
366
+
:: !errors;
367
+
if not dune_project_exists then begin
368
+
if has_subdirs then
369
+
errors :=
370
+
Fmt.str "Error: %s/%s.t/{bad,good}/dune-project files are missing"
371
+
cram_dir rule_code
372
+
:: !errors
373
+
else
374
+
errors :=
375
+
Fmt.str "Error: %s/%s.t/dune-project is missing" cram_dir rule_code
376
+
:: !errors
377
+
end;
378
+
if (not dune_exists) && not has_subdirs then
379
+
errors :=
380
+
Fmt.str "Error: %s/%s.t/dune is missing" cram_dir rule_code :: !errors
381
+
end
382
+
316
383
(* Check 3: Every test directory must have required files *)
317
384
let check_test_directory_structure cram_dir defined_rules test_dirs errors =
318
385
List.iter
319
386
(fun rule_code ->
320
-
if List.mem rule_code test_dirs then (
321
-
let ( bad_exists,
322
-
good_exists,
323
-
run_exists,
324
-
dune_project_exists,
325
-
dune_exists,
326
-
has_subdirs,
327
-
has_incorrect_root_files ) =
328
-
check_test_files cram_dir rule_code
329
-
in
330
-
if not bad_exists then
331
-
errors :=
332
-
Fmt.str "Error: %s/%s.t/bad.ml is missing" cram_dir rule_code
333
-
:: !errors;
334
-
if not good_exists then
335
-
errors :=
336
-
Fmt.str "Error: %s/%s.t/good.ml is missing" cram_dir rule_code
337
-
:: !errors;
338
-
if not run_exists then
339
-
errors :=
340
-
Fmt.str "Error: %s/%s.t/run.t is missing" cram_dir rule_code
341
-
:: !errors
342
-
else
343
-
(* Check 4: run.t must use correct -r flag format *)
344
-
let has_bad_test, has_good_test, wrong_formats =
345
-
check_run_t_format cram_dir rule_code
346
-
in
347
-
if not has_bad_test then
348
-
errors :=
349
-
Fmt.str "Error: %s/%s.t/run.t doesn't test 'merlint -r %s bad.ml'"
350
-
cram_dir rule_code
351
-
(String.uppercase_ascii rule_code)
352
-
:: !errors;
353
-
if not has_good_test then
354
-
errors :=
355
-
Fmt.str
356
-
"Error: %s/%s.t/run.t doesn't test 'merlint -r %s good.ml'"
357
-
cram_dir rule_code
358
-
(String.uppercase_ascii rule_code)
359
-
:: !errors;
360
-
(* Report any wrong -r flag usage *)
361
-
List.iter
362
-
(fun msg ->
363
-
errors :=
364
-
Fmt.str "Error: %s/%s.t/run.t: %s" cram_dir rule_code msg
365
-
:: !errors)
366
-
wrong_formats;
367
-
(* Check 5: test directories SHOULD have dune-project and dune files in correct location *)
368
-
if has_incorrect_root_files then
369
-
errors :=
370
-
Fmt.str
371
-
"Error: %s/%s.t has dune or dune-project at root but uses \
372
-
subdirectory structure - these files should be in bad/ and \
373
-
good/ subdirs instead"
374
-
cram_dir rule_code
375
-
:: !errors;
376
-
if not dune_project_exists then
377
-
if has_subdirs then
378
-
errors :=
379
-
Fmt.str
380
-
"Error: %s/%s.t/{bad,good}/dune-project files are missing"
381
-
cram_dir rule_code
382
-
:: !errors
383
-
else
384
-
errors :=
385
-
Fmt.str "Error: %s/%s.t/dune-project is missing" cram_dir
386
-
rule_code
387
-
:: !errors;
388
-
if (not dune_exists) && not has_subdirs then
389
-
errors :=
390
-
Fmt.str "Error: %s/%s.t/dune is missing" cram_dir rule_code
391
-
:: !errors))
387
+
if List.mem rule_code test_dirs then
388
+
check_rule_structure cram_dir rule_code errors)
392
389
defined_rules
393
390
391
+
(* Check a single test output for build errors or incorrect exit behavior *)
392
+
let check_test_output cram_dir rule_code errors (test_name, output_lines) =
393
+
let re_command_failed = Re.compile (Re.str "Command failed with exit code") in
394
+
let re_build_warning =
395
+
Re.compile (Re.str "Warning: Failed to build project")
396
+
in
397
+
let has_build_error =
398
+
List.exists
399
+
(fun line ->
400
+
Re.execp re_dune_error line
401
+
|| Re.execp re_command_failed line
402
+
|| Re.execp re_build_warning line)
403
+
output_lines
404
+
in
405
+
if has_build_error then
406
+
errors :=
407
+
Fmt.str
408
+
"Error: %s/%s.t/run.t: %s test shows build errors/warnings - fix the \
409
+
build (debug with: dune build --root %s/%s.t)"
410
+
cram_dir rule_code test_name cram_dir rule_code
411
+
:: !errors
412
+
else if test_name = "bad" then begin
413
+
let has_exit_1 =
414
+
List.exists (fun line -> Re.execp re_exit_1 line) output_lines
415
+
in
416
+
if not has_exit_1 then
417
+
errors :=
418
+
Fmt.str
419
+
"Error: %s/%s.t/run.t: bad.ml test doesn't show exit code [1] - \
420
+
should find issues"
421
+
cram_dir rule_code
422
+
:: !errors
423
+
end
424
+
else if test_name = "good" then begin
425
+
let has_exit_1 =
426
+
List.exists (fun line -> Re.execp re_exit_1 line) output_lines
427
+
in
428
+
let shows_zero_issues =
429
+
List.exists (fun line -> Re.execp re_zero_issues line) output_lines
430
+
in
431
+
if has_exit_1 && shows_zero_issues then
432
+
errors :=
433
+
Fmt.str
434
+
"Error: %s/%s.t/run.t: good.ml test shows exit [1] but claims 0 \
435
+
issues"
436
+
cram_dir rule_code
437
+
:: !errors
438
+
end
439
+
394
440
(* Check 6: Parse run.t files to verify expected behavior *)
395
441
let check_expected_outputs cram_dir defined_rules test_dirs errors =
396
442
Fmt.pr "\nChecking expected test outputs...@.";
···
398
444
(fun rule_code ->
399
445
if List.mem rule_code test_dirs then
400
446
let test_outputs = check_run_t_output cram_dir rule_code in
401
-
(* Check each test in the run.t file *)
402
-
List.iter
403
-
(fun (test_name, output_lines) ->
404
-
(* Check for any build failures or warnings - these should not be present in tests *)
405
-
let has_build_error =
406
-
let re_command_failed =
407
-
Re.compile (Re.str "Command failed with exit code")
408
-
in
409
-
let re_build_warning =
410
-
Re.compile (Re.str "Warning: Failed to build project")
411
-
in
412
-
List.exists
413
-
(fun line ->
414
-
Re.execp re_dune_error line
415
-
|| Re.execp re_command_failed line
416
-
|| Re.execp re_build_warning line)
417
-
output_lines
418
-
in
419
-
if has_build_error then
420
-
errors :=
421
-
Fmt.str
422
-
"Error: %s/%s.t/run.t: %s test shows build errors/warnings - \
423
-
fix the build (debug with: dune build --root %s/%s.t)"
424
-
cram_dir rule_code test_name cram_dir rule_code
425
-
:: !errors
426
-
else if test_name = "bad" then
427
-
(* bad.ml should exit with code [1] *)
428
-
let has_exit_1 =
429
-
List.exists (fun line -> Re.execp re_exit_1 line) output_lines
430
-
in
431
-
if not has_exit_1 then
432
-
errors :=
433
-
Fmt.str
434
-
"Error: %s/%s.t/run.t: bad.ml test doesn't show exit code \
435
-
[1] - should find issues"
436
-
cram_dir rule_code
437
-
:: !errors
438
-
else if test_name = "good" then
439
-
(* good.ml should be successful (no exit code [1] at the end) *)
440
-
let has_exit_1 =
441
-
List.exists (fun line -> Re.execp re_exit_1 line) output_lines
442
-
in
443
-
(* Check if it shows all checks passed for the specific rule *)
444
-
let shows_zero_issues =
445
-
List.exists
446
-
(fun line -> Re.execp re_zero_issues line)
447
-
output_lines
448
-
in
449
-
if has_exit_1 && shows_zero_issues then
450
-
errors :=
451
-
Fmt.str
452
-
"Error: %s/%s.t/run.t: good.ml test shows exit [1] but \
453
-
claims 0 issues"
454
-
cram_dir rule_code
455
-
:: !errors)
456
-
test_outputs)
447
+
List.iter (check_test_output cram_dir rule_code errors) test_outputs)
457
448
defined_rules
458
449
459
450
(* Report results and exit *)
+16
-19
bin/generate_examples_ml.ml
+16
-19
bin/generate_examples_ml.ml
···
29
29
filename;
30
30
Buffer.contents buf
31
31
32
+
let classify_entry base_dir current_path entry =
33
+
let entry_path =
34
+
if current_path = "" then entry else Filename.concat current_path entry
35
+
in
36
+
let full_entry_path = Filename.concat base_dir entry_path in
37
+
if Sys.is_directory full_entry_path then
38
+
if entry = "_build" then `Skip else `Recurse entry_path
39
+
else if
40
+
Filename.check_suffix entry ".ml" || Filename.check_suffix entry ".mli"
41
+
then `File (entry_path, full_entry_path)
42
+
else `Skip
43
+
32
44
let rec collect_files_recursively base_dir current_path =
33
45
let full_path =
34
46
if current_path = "" then base_dir
35
47
else Filename.concat base_dir current_path
36
48
in
37
-
38
49
if Sys.file_exists full_path && Sys.is_directory full_path then
39
50
let entries = Sys.readdir full_path |> Array.to_list in
40
51
List.fold_left
41
52
(fun acc entry ->
42
-
let entry_path =
43
-
if current_path = "" then entry
44
-
else Filename.concat current_path entry
45
-
in
46
-
let full_entry_path = Filename.concat base_dir entry_path in
47
-
48
-
if Sys.is_directory full_entry_path then
49
-
(* Skip _build directories *)
50
-
if entry = "_build" then acc
51
-
else
52
-
(* Recursively collect from subdirectory *)
53
+
match classify_entry base_dir current_path entry with
54
+
| `Skip -> acc
55
+
| `Recurse entry_path ->
53
56
acc @ collect_files_recursively base_dir entry_path
54
-
else if
55
-
Filename.check_suffix entry ".ml"
56
-
|| Filename.check_suffix entry ".mli"
57
-
then
58
-
(* Include the relative path from test_dir *)
59
-
(entry_path, full_entry_path) :: acc
60
-
else acc)
57
+
| `File file -> file :: acc)
61
58
[] entries
62
59
|> List.sort (fun (a, _) (b, _) -> String.compare a b)
63
60
else []
+11
-12
lib/docs.ml
+11
-12
lib/docs.ml
···
298
298
String.concat " * " type_strs
299
299
| _ -> "<complex type>"
300
300
301
+
(** Check if a line is a regular comment immediately before a val declaration.
302
+
*)
303
+
let is_comment_before_val lines i trimmed =
304
+
Re.execp (Re.compile (Re.str "(* ")) trimmed
305
+
&& Re.execp (Re.compile (Re.str " *)")) trimmed
306
+
&& (not (String.starts_with ~prefix:"(**" trimmed))
307
+
&& i + 1 < List.length lines
308
+
&& String.starts_with ~prefix:"val " (String.trim (List.nth lines (i + 1)))
309
+
301
310
(** Find regular comments that precede value declarations *)
302
311
let regular_comments lines =
303
312
let regular_comments = ref [] in
304
313
List.iteri
305
314
(fun i line ->
306
315
let trimmed = String.trim line in
307
-
if
308
-
Re.execp (Re.compile (Re.str "(* ")) trimmed
309
-
&& Re.execp (Re.compile (Re.str " *)")) trimmed
310
-
&& not (String.starts_with ~prefix:"(**" trimmed)
311
-
then
312
-
if
313
-
(* Found a regular comment, check if next line is a val *)
314
-
i + 1 < List.length lines
315
-
then
316
-
let next_line = String.trim (List.nth lines (i + 1)) in
317
-
if String.starts_with ~prefix:"val " next_line then
318
-
regular_comments := (i + 2, "BAD_COMMENT") :: !regular_comments)
316
+
if is_comment_before_val lines i trimmed then
317
+
regular_comments := (i + 2, "BAD_COMMENT") :: !regular_comments)
319
318
lines;
320
319
!regular_comments
321
320
+9
-8
lib/dune.ml
+9
-8
lib/dune.ml
···
477
477
478
478
{ libraries; executables; tests }
479
479
480
+
(** Check if [s1] contains [s2] as a substring. *)
481
+
let string_contains s1 s2 =
482
+
let len2 = String.length s2 in
483
+
let rec aux i =
484
+
i + len2 <= String.length s1 && (String.sub s1 i len2 = s2 || aux (i + 1))
485
+
in
486
+
aux 0
487
+
480
488
(** Filter out files matching patterns *)
481
489
let exclude patterns describe =
482
490
let filter_files files =
···
485
493
let file_str = Fpath.to_string file in
486
494
not
487
495
(List.exists
488
-
(fun pattern ->
489
-
(* Check if pattern is a substring of file *)
490
-
let rec contains s1 s2 =
491
-
String.length s1 >= String.length s2
492
-
&& (String.sub s1 0 (String.length s2) = s2
493
-
|| contains (String.sub s1 1 (String.length s1 - 1)) s2)
494
-
in
495
-
contains file_str pattern)
496
+
(fun pattern -> string_contains file_str pattern)
496
497
patterns))
497
498
files
498
499
in