Warn instead of error on harmless fake modules
E.g. (modules (:standard \ does_not_exist)) is harmless
This commit is contained in:
parent
7977b8371a
commit
d8e4145dba
|
@ -28,30 +28,48 @@ module Gen(P : Params) = struct
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
|
||||||
module Eval_modules = Ordered_set_lang.Make(struct
|
module Eval_modules = Ordered_set_lang.Make(struct
|
||||||
type t = Module.t
|
type t = (Module.t, string * Loc.t) result
|
||||||
let name = Module.name
|
let name = function
|
||||||
|
| Error (s, _) -> s
|
||||||
|
| Ok m -> Module.name m
|
||||||
end)
|
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 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 parse ~loc s =
|
||||||
let s = String.capitalize_ascii s in
|
let s = String.capitalize_ascii s in
|
||||||
match String_map.find s all_modules with
|
match String_map.find s all_modules with
|
||||||
| Some m -> m
|
| Some m -> Ok m
|
||||||
| None -> Loc.fail loc "Module %s doesn't exist." s
|
| None ->
|
||||||
|
fake_modules := String_map.add ~key:s ~data:loc !fake_modules;
|
||||||
|
Error (s, loc)
|
||||||
in
|
in
|
||||||
let modules =
|
let modules =
|
||||||
Eval_modules.eval_unordered
|
Eval_modules.eval_unordered
|
||||||
conf.modules
|
conf.modules
|
||||||
~parse
|
~parse
|
||||||
~standard:all_modules
|
~standard:standard_modules
|
||||||
in
|
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 =
|
let intf_only =
|
||||||
Eval_modules.eval_unordered
|
Eval_modules.eval_unordered
|
||||||
conf.modules_without_implementation
|
conf.modules_without_implementation
|
||||||
~parse
|
~parse
|
||||||
~standard:String_map.empty
|
~standard:String_map.empty
|
||||||
in
|
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 =
|
let real_intf_only =
|
||||||
String_map.filter modules
|
String_map.filter modules
|
||||||
~f:(fun _ (m : Module.t) -> Option.is_none m.impl)
|
~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
|
let name (_, m) = Module.name m
|
||||||
end)
|
end)
|
||||||
in
|
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 parse ~loc s = (loc, parse ~loc s) in
|
||||||
let shouldn't_be_listed =
|
let shouldn't_be_listed =
|
||||||
Eval.eval_unordered conf.modules_without_implementation
|
Eval.eval_unordered conf.modules_without_implementation
|
||||||
|
|
|
@ -155,6 +155,7 @@ module Map = struct
|
||||||
val of_alist_reduce : (key * 'a) list -> f:('a -> 'a -> 'a) -> 'a t
|
val of_alist_reduce : (key * 'a) list -> f:('a -> 'a -> 'a) -> 'a t
|
||||||
val keys : 'a t -> key list
|
val keys : 'a t -> key list
|
||||||
val values : 'a t -> 'a list
|
val values : 'a t -> 'a list
|
||||||
|
val filter_map : 'a t -> f:(key:key -> data:'a -> 'b option) -> 'b t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Make(Key : OrderedType) : S with type key = Key.t = struct
|
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 keys t = bindings t |> List.map ~f:fst
|
||||||
let values t = bindings t |> List.map ~f:snd
|
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
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
$ $JBUILDER build --display short --root . -j 1
|
$ $JBUILDER build --display short --root . -j 1
|
||||||
File "jbuild", line 1, characters 0-50:
|
File "jbuild", line 1, characters 0-50:
|
||||||
Error: Module Fake doesn't exist.
|
Warning: Module Fake is excluded but it doesn't exist.
|
||||||
[1]
|
|
||||||
|
|
Loading…
Reference in New Issue