+105 -16

lib/rules/e523.ml

reviewed

··· 66 66 | Sexp.Atom a :: _ when String.length a > 0 && a.[0] = ':' -> Standard 67 67 | Sexp.Atom "\\" :: _ -> Standard 68 68 | Sexp.Atom a :: tl -> loop (a :: acc) tl 69 69 - | _ :: tl -> loop acc tl 69 69 + | Sexp.List _ :: _ -> Standard 70 70 in 71 71 loop [] rest 72 72 ··· 79 79 Some (List.filter_map extract_modules_field fields) 80 80 | _ -> None 81 81 82 82 + let module_of_atom atom = 83 83 + let a = match atom with Sexp.Atom a -> a | _ -> "" in 84 84 + if Filename.check_suffix a ".ml" || Filename.check_suffix a ".mli" then 85 85 + [ Filename.remove_extension a ] 86 86 + else [] 87 87 + 88 88 + (** Pull module names produced by a [(select target from (cond -> branch) ...)] 89 89 + form inside a [(libraries ...)] field. Both the generated [target] and every 90 90 + source-side [branch] file are added, since both sit on disk (branches as 91 91 + source, target as build output) and neither should trip the uncovered check. 92 92 + *) 93 93 + let select_modules libs = 94 94 + let from_branch = function 95 95 + | Sexp.List items -> 96 96 + List.concat_map 97 97 + (function Sexp.Atom a -> module_of_atom (Sexp.Atom a) | _ -> []) 98 98 + items 99 99 + | _ -> [] 100 100 + in 101 101 + List.concat_map 102 102 + (function 103 103 + | Sexp.List (Sexp.Atom "select" :: Sexp.Atom target :: rest) -> 104 104 + module_of_atom (Sexp.Atom target) @ List.concat_map from_branch rest 105 105 + | _ -> []) 106 106 + libs 107 107 + 108 108 + (** Module name produced by [(generate_sites_module (module foo) ...)]. *) 109 109 + let generate_sites_module_name fields = 110 110 + List.concat_map 111 111 + (function 112 112 + | Sexp.List [ Sexp.Atom "module"; Sexp.Atom name ] -> [ name ] | _ -> []) 113 113 + fields 114 114 + 115 115 + (** Modules pulled in by a single [library]/[executable(s)]/[test(s)] stanza's 116 116 + sub-fields (select targets, generate_sites_module, copy_files outputs). *) 117 117 + let stanza_generator_modules fields = 118 118 + List.concat_map 119 119 + (function 120 120 + | Sexp.List (Sexp.Atom "libraries" :: libs) -> select_modules libs 121 121 + | Sexp.List (Sexp.Atom "generate_sites_module" :: gs) -> 122 122 + generate_sites_module_name gs 123 123 + | _ -> []) 124 124 + fields 125 125 + 126 126 + (** Modules from [(copy_files ...)] / [(copy_files# ...)] stanzas. The source 127 127 + argument may be a plain atom [../a/foo.ml] or [(files ../a/foo.ml)]. Globs 128 128 + like [../a/*.ml] are not expanded — the result is approximate but errs on 129 129 + the side of not flagging real generated files. *) 130 130 + let copy_files_modules rest = 131 131 + let from_atom = function 132 132 + | Sexp.Atom a when not (String.contains a '*') -> 133 133 + module_of_atom (Sexp.Atom (Filename.basename a)) 134 134 + | _ -> [] 135 135 + in 136 136 + List.concat_map 137 137 + (function 138 138 + | Sexp.Atom _ as a -> from_atom a 139 139 + | Sexp.List (Sexp.Atom "files" :: atoms) -> 140 140 + List.concat_map from_atom atoms 141 141 + | Sexp.List _ -> []) 142 142 + rest 143 143 + 82 144 (** Collect generator-produced module names so they are not falsely reported as 83 83 - uncovered. [(ocamllex x)] and [(menhir (modules x))] both produce [x.ml]; a 84 84 - [(rule (target foo.ml) ...)] or [(rule (targets a.ml b.ml) ...)] likewise 85 85 - produces one or more [.ml] files. *) 145 145 + uncovered. Covered dune constructs: 146 146 + 147 147 + - [(ocamllex x)] / [(menhir (modules x))] produce [x.ml]. 148 148 + - [(rule (target foo.ml) ...)] / [(rule (targets a.ml b.ml) ...)] produce 149 149 + the listed [.ml] files. 150 150 + - [(libraries (select t from (c -> b) ...))] inside a stanza produces the 151 151 + [t] target and every branch file [b]. 152 152 + - [(generate_sites_module (module foo) ...)] inside a library stanza 153 153 + produces [foo.ml]. 154 154 + - [(copy_files foo.ml)] / [(copy_files (files foo.ml))] drops [foo.ml] into 155 155 + the current directory. *) 86 156 let generator_modules stanzas = 87 157 let from_rule fields = 88 88 - let target_name atom = 89 89 - let a = match atom with Sexp.Atom a -> a | _ -> "" in 90 90 - if Filename.check_suffix a ".ml" || Filename.check_suffix a ".mli" then 91 91 - [ Filename.remove_extension a ] 92 92 - else [] 93 93 - in 94 158 List.concat_map 95 159 (function 96 96 - | Sexp.List [ Sexp.Atom "target"; a ] -> target_name a 160 160 + | Sexp.List [ Sexp.Atom "target"; a ] -> module_of_atom a 97 161 | Sexp.List (Sexp.Atom "targets" :: atoms) -> 98 98 - List.concat_map target_name atoms 162 162 + List.concat_map module_of_atom atoms 99 163 | _ -> []) 100 164 fields 101 165 in ··· 113 177 | _ -> []) 114 178 fields 115 179 | Sexp.List (Sexp.Atom "rule" :: fields) -> from_rule fields 180 180 + | Sexp.List (Sexp.Atom kind :: fields) when is_module_stanza kind -> 181 181 + stanza_generator_modules fields 182 182 + | Sexp.List (Sexp.Atom cf :: rest) 183 183 + when cf = "copy_files" || cf = "copy_files#" -> 184 184 + copy_files_modules rest 116 185 | _ -> []) 117 186 stanzas 118 187 188 188 + (** Directory-scanning directives that invalidate single-directory assumptions. 189 189 + When [(include_subdirs unqualified)] or [(include_subdirs qualified)] is 190 190 + present, modules in subdirectories belong to the stanza; we cannot decide 191 191 + coverage without walking them, so the rule bails out. [(include_subdirs no)] 192 192 + is the default and does not affect anything. *) 193 193 + let has_nontrivial_include_subdirs stanzas = 194 194 + List.exists 195 195 + (function 196 196 + | Sexp.List [ Sexp.Atom "include_subdirs"; Sexp.Atom mode ] 197 197 + when mode = "unqualified" || mode = "qualified" -> 198 198 + true 199 199 + | _ -> false) 200 200 + stanzas 201 201 + 119 202 let ml_modules_in_dir dir = 120 203 let entries = try Sys.readdir dir |> Array.to_list with Sys_error _ -> [] in 121 204 List.filter_map ··· 128 211 let check_dune path contents = 129 212 match Sexp.Value.parse_string_many contents with 130 213 | Error _ -> None 214 214 + | Ok stanzas when has_nontrivial_include_subdirs stanzas -> None 131 215 | Ok stanzas -> ( 132 216 let module_stanzas = List.filter_map stanza_modules stanzas in 133 217 match module_stanzas with ··· 138 222 Some (Issue.v { dune = path; kind = Redundant }) 139 223 else None 140 224 | _ :: _ :: _ -> 141 141 - (* Multiple module-accepting stanzas share a directory. Check that 142 142 - every .ml in the dir is covered by some stanza's (modules ...) 143 143 - field; if any stanza uses :standard we cannot evaluate it. *) 225 225 + (* Multiple module-accepting stanzas share a directory. If any 226 226 + stanza has no [(modules ...)] field at all, it implicitly claims 227 227 + every remaining file via dune's auto-discovery, so coverage is 228 228 + trivially complete. Likewise if any stanza uses [:standard] we 229 229 + cannot evaluate it. *) 230 230 + let any_implicit = 231 231 + List.exists (function [] -> true | _ -> false) module_stanzas 232 232 + in 144 233 let all_specs = List.concat module_stanzas in 145 234 let any_standard = 146 235 List.exists (function Standard -> true | _ -> false) all_specs 147 236 in 148 148 - if any_standard then None 237 237 + if any_implicit || any_standard then None 149 238 else 150 239 let covered = 151 240 List.concat_map

+1

test/cram/e523.t/bad/dune-project

reviewed

··· 1 1 + (lang dune 3.21)

+1

test/cram/e523.t/bad/redundant/bar.ml

reviewed

··· 1 1 + let y = 2

+3

test/cram/e523.t/bad/redundant/dune

reviewed

··· 1 1 + (library 2 2 + (name redundant) 3 3 + (modules foo bar))

+1

test/cram/e523.t/bad/redundant/foo.ml

reviewed

··· 1 1 + let x = 1

+1

test/cram/e523.t/bad/uncovered/a.ml

reviewed

··· 1 1 + let a = 1

+1

test/cram/e523.t/bad/uncovered/b.ml

reviewed

··· 1 1 + let b = 2

+1

test/cram/e523.t/bad/uncovered/c.ml

reviewed

··· 1 1 + let c = 3

+7

test/cram/e523.t/bad/uncovered/dune

reviewed

··· 1 1 + (library 2 2 + (name uncov_a) 3 3 + (modules a)) 4 4 + 5 5 + (library 6 6 + (name uncov_b) 7 7 + (modules b))

+9

test/cram/e523.t/good/copy_files/dune

reviewed

··· 1 1 + (copy_files ../src/helpers.ml) 2 2 + 3 3 + (library 4 4 + (name cf_a) 5 5 + (modules main_a)) 6 6 + 7 7 + (library 8 8 + (name cf_b) 9 9 + (modules main_b))

+1

test/cram/e523.t/good/copy_files/helpers.ml

reviewed

··· 1 1 + let h = 3

+1

test/cram/e523.t/good/copy_files/main_a.ml

reviewed

··· 1 1 + let a = 1

+1

test/cram/e523.t/good/copy_files/main_b.ml

reviewed

··· 1 1 + let b = 2

+1

test/cram/e523.t/good/dune-project

reviewed

··· 1 1 + (lang dune 3.21)

+10

test/cram/e523.t/good/gen_sites/dune

reviewed

··· 1 1 + (library 2 2 + (name gs_a) 3 3 + (modules main_a site_mod) 4 4 + (generate_sites_module 5 5 + (module site_mod) 6 6 + (sites mypkg))) 7 7 + 8 8 + (library 9 9 + (name gs_b) 10 10 + (modules main_b))

+1

test/cram/e523.t/good/gen_sites/main_a.ml

reviewed

··· 1 1 + let x = 1

+1

test/cram/e523.t/good/gen_sites/main_b.ml

reviewed

··· 1 1 + let y = 2

+1

test/cram/e523.t/good/include_subdirs/bar.ml

reviewed

··· 1 1 + let y = 2

+5

test/cram/e523.t/good/include_subdirs/dune

reviewed

··· 1 1 + (include_subdirs unqualified) 2 2 + 3 3 + (library 4 4 + (name isub) 5 5 + (modules foo bar))

+1

test/cram/e523.t/good/include_subdirs/foo.ml

reviewed

··· 1 1 + let x = 1

+1

test/cram/e523.t/good/include_subdirs/sub/baz.ml

reviewed

··· 1 1 + let z = 3

+9

test/cram/e523.t/good/ocamllex/dune

reviewed

··· 1 1 + (ocamllex lexer) 2 2 + 3 3 + (library 4 4 + (name lex_a) 5 5 + (modules main_a lexer)) 6 6 + 7 7 + (library 8 8 + (name lex_b) 9 9 + (modules main_b))

+3

test/cram/e523.t/good/ocamllex/lexer.mll

reviewed

··· 1 1 + {} 2 2 + rule tok = parse 3 3 + | eof { () }

+1

test/cram/e523.t/good/ocamllex/main_a.ml

reviewed

··· 1 1 + let a = 1

+1

test/cram/e523.t/good/ocamllex/main_b.ml

reviewed

··· 1 1 + let b = 2

+11

test/cram/e523.t/good/rule_targets/dune

reviewed

··· 1 1 + (rule 2 2 + (target gen.ml) 3 3 + (action (write-file %{target} "let x = 1"))) 4 4 + 5 5 + (library 6 6 + (name rt_a) 7 7 + (modules main_a gen)) 8 8 + 9 9 + (library 10 10 + (name rt_b) 11 11 + (modules main_b))

+1

test/cram/e523.t/good/rule_targets/main_a.ml

reviewed

··· 1 1 + let a = 1

+1

test/cram/e523.t/good/rule_targets/main_b.ml

reviewed

··· 1 1 + let b = 2

+1

test/cram/e523.t/good/select/chooser_default.ml

reviewed

··· 1 1 + let impl = "default"

+1

test/cram/e523.t/good/select/chooser_re.ml

reviewed

··· 1 1 + let impl = "re"

+11

test/cram/e523.t/good/select/dune

reviewed

··· 1 1 + (library 2 2 + (name sel_a) 3 3 + (modules main_a) 4 4 + (libraries 5 5 + (select chooser.ml from 6 6 + (re -> chooser_re.ml) 7 7 + (-> chooser_default.ml)))) 8 8 + 9 9 + (library 10 10 + (name sel_b) 11 11 + (modules main_b))

+1

test/cram/e523.t/good/select/main_a.ml

reviewed

··· 1 1 + let a = 1

+1

test/cram/e523.t/good/select/main_b.ml

reviewed

··· 1 1 + let b = 2

+67

test/cram/e523.t/run.t

reviewed

··· 1 1 + Bad examples: a single-stanza dune with an explicit (modules ...) is 2 2 + redundant, and two sibling stanzas that don't cover every .ml in the 3 3 + directory silently drop files from the build: 4 4 + 5 5 + $ merlint -B -r E523 bad/ 6 6 + Running merlint analysis... 7 7 + 8 8 + Analyzing 4 files 9 9 + 10 10 + ✓ Code Quality (0 total issues) 11 11 + ✓ Code Style (0 total issues) 12 12 + ✓ Naming Conventions (0 total issues) 13 13 + ✓ Documentation (0 total issues) 14 14 + ✗ Project Structure (2 total issues) 15 15 + [E523] Redundant or incomplete (modules ...) in dune (2 issues) 16 16 + A dune file with a single library/executable/test stanza doesn't need (modules 17 17 + ...) — dune auto-discovers every .ml in the directory. When multiple stanzas 18 18 + share a directory the (modules ...) fields must together cover every .ml file, 19 19 + otherwise some module is silently dropped. Prefer splitting into sibling 20 20 + directories when the stanza split is a design choice rather than a build 21 21 + requirement. 22 22 + - (global) bad/uncovered/dune has multiple stanzas but the (modules ...) fields do not cover c; those .ml files are silently excluded from the build 23 23 + - (global) bad/redundant/dune has a single stanza with a redundant (modules ...) field; drop it and let dune auto-discover the .ml files 24 24 + ✓ Test Quality (0 total issues) 25 25 + ✓ Interop Testing (0 total issues) 26 26 + ✓ Code Generation (0 total issues) 27 27 + 28 28 + ╭───────────────────┬─────────────────────────────────────────────────────╮ 29 29 + │ Category │ Issues │ 30 30 + ├───────────────────┼─────────────────────────────────────────────────────┤ 31 31 + │ Project Structure │ 2 (2 redundant or incomplete (modules ...) in dune) │ 32 32 + ╰───────────────────┴─────────────────────────────────────────────────────╯ 33 33 + 34 34 + 35 35 + Summary: ✗ 2 total issues (applied 1 rule) 36 36 + ✗ Some checks failed. See details above. 37 37 + [1] 38 38 + 39 39 + 40 40 + 41 41 + 42 42 + 43 43 + 44 44 + Good examples exercise every dune construct that can add modules beyond 45 45 + the source directory: select branches, generate_sites_module, rule targets, 46 46 + ocamllex, copy_files, and include_subdirs (which suppresses the rule 47 47 + because subdirectory modules merge into the stanza): 48 48 + 49 49 + $ merlint -B -r E523 good/ 50 50 + Running merlint analysis... 51 51 + 52 52 + Analyzing 12 files 53 53 + 54 54 + ✓ Code Quality (0 total issues) 55 55 + ✓ Code Style (0 total issues) 56 56 + ✓ Naming Conventions (0 total issues) 57 57 + ✓ Documentation (0 total issues) 58 58 + ✓ Project Structure (0 total issues) 59 59 + ✓ Test Quality (0 total issues) 60 60 + ✓ Interop Testing (0 total issues) 61 61 + ✓ Code Generation (0 total issues) 62 62 + 63 63 + Summary: ✓ 0 total issues (applied 1 rule) 64 64 + ✓ All checks passed! 65 65 + 66 66 + 67 67 +