Warn instead of error on harmless fake modules

E.g. (modules (:standard \ does_not_exist)) is harmless
This commit is contained in:
Rudi Grinberg 2018-02-15 19:52:58 +07:00
parent 7977b8371a
commit d8e4145dba
3 changed files with 40 additions and 10 deletions

View File

@ -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

View File

@ -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

View File

@ -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.