diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 5c9cee60..8f6b3d09 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -28,30 +28,48 @@ module Gen(P : Params) = struct +-----------------------------------------------------------------+ *) module Eval_modules = Ordered_set_lang.Make(struct - type t = Module.t - let name = Module.name + type t = (Module.t, string * Loc.t) result + let name = function + | Error (s, _) -> s + | Ok m -> Module.name m end) - let parse_modules ~all_modules ~buildable = + let parse_modules ~(all_modules : Module.t String_map.t) ~buildable = let conf : Buildable.t = buildable in + let standard_modules = String_map.map all_modules ~f:(fun m -> Ok m) in + let fake_modules = ref String_map.empty in let parse ~loc s = - let s = String.capitalize_ascii s in - match String_map.find s all_modules with - | Some m -> m - | None -> Loc.fail loc "Module %s doesn't exist." s + let s = String.capitalize_ascii s in + match String_map.find s all_modules with + | Some m -> Ok m + | None -> + fake_modules := String_map.add ~key:s ~data:loc !fake_modules; + Error (s, loc) in let modules = Eval_modules.eval_unordered conf.modules ~parse - ~standard:all_modules + ~standard:standard_modules in + let only_present_modules modules = + String_map.filter_map ~f:(fun ~key:_ ~data -> + match data with + | Ok m -> Some m + | Error (s, loc) -> Loc.fail loc "Module %s doesn't exist." s + ) modules + in + let modules = only_present_modules modules in let intf_only = Eval_modules.eval_unordered conf.modules_without_implementation ~parse ~standard:String_map.empty in + let intf_only = only_present_modules intf_only in + String_map.iter !fake_modules ~f:(fun ~key ~data:loc -> + Loc.warn loc "Module %s is excluded but it doesn't exist." key + ); let real_intf_only = String_map.filter modules ~f:(fun _ (m : Module.t) -> Option.is_none m.impl) @@ -102,6 +120,12 @@ module Gen(P : Params) = struct let name (_, m) = Module.name m end) in + let parse ~loc s = + let s = String.capitalize_ascii s in + match String_map.find s all_modules with + | Some m -> m + | None -> Loc.fail loc "Module %s doesn't exist." s + in let parse ~loc s = (loc, parse ~loc s) in let shouldn't_be_listed = Eval.eval_unordered conf.modules_without_implementation diff --git a/src/import.ml b/src/import.ml index 3efe8651..e5d94880 100644 --- a/src/import.ml +++ b/src/import.ml @@ -155,6 +155,7 @@ module Map = struct val of_alist_reduce : (key * 'a) list -> f:('a -> 'a -> 'a) -> 'a t val keys : 'a t -> key list val values : 'a t -> 'a list + val filter_map : 'a t -> f:(key:key -> data:'a -> 'b option) -> 'b t end module Make(Key : OrderedType) : S with type key = Key.t = struct @@ -209,6 +210,12 @@ module Map = struct let keys t = bindings t |> List.map ~f:fst let values t = bindings t |> List.map ~f:snd + + let filter_map t ~f = + merge t empty ~f:(fun key data _always_none -> + match data with + | None -> assert false + | Some data -> f ~key ~data) end end diff --git a/test/blackbox-tests/test-cases/exclude-missing-module/run.t b/test/blackbox-tests/test-cases/exclude-missing-module/run.t index 7e863493..5feaf4c4 100644 --- a/test/blackbox-tests/test-cases/exclude-missing-module/run.t +++ b/test/blackbox-tests/test-cases/exclude-missing-module/run.t @@ -1,4 +1,3 @@ $ $JBUILDER build --display short --root . -j 1 File "jbuild", line 1, characters 0-50: - Error: Module Fake doesn't exist. - [1] + Warning: Module Fake is excluded but it doesn't exist.