(* $Id$ -*- tuareg -*-
* ----------------------------------------------------------------------
*
*)
open Fl_metascanner
module Have = struct
module T = struct
type mode = [`Byte | `Native | `Toploop | `Preprocessor | `Ppx_driver]
type t = [
`Mode of [ `TooMany | `None]
(** problem in the number of mode (byte,native,syntax,...)
in the variable *)
| `Archive of [`Plugin|`NoPlugin] * mode
(** archive(plugin,...) or archive(...)) *)
| `Plugin of [`Plugin|`NoPlugin] * mode
(** plugin(...) *)
| `Description
| `Requires
| `Version
]
let compare = compare
end
include T
module Set = Set.Make(T)
module Map = Map.Make(T)
end
let scan_def acc def =
let add have = Have.Map.add have def acc in
let has_plugin_pred = List.mem (`Pred "plugin") def.def_preds in
let plugin = if has_plugin_pred then `Plugin else `NoPlugin in
let modes = [ "byte", `Byte;
"native", `Native;
"toploop", `Toploop;
"preprocessor", `Preprocessor;
"ppx_driver", `Ppx_driver
] in
let modes =
List.filter
(fun (p,_) -> List.mem (`Pred p) def.def_preds)
modes
in
let modes = List.map snd modes in
match def.def_var, modes with
(** For archive the modes are used in multiple ways, so we can't
check exhaustiveness or presence.
*)
| "plugin", [] -> add (`Mode(`None))
| "plugin", _::_::_ -> add (`Mode(`TooMany))
| "archive", [mode] -> add (`Archive(plugin,mode))
| "plugin", [mode] -> add (`Plugin(plugin,mode))
| "description", _ -> add `Description
| "requires", _ -> add `Requires
| "version", _ -> add `Version
| _ -> acc
let warn_def ~warned pkg =
let haves =
List.fold_left scan_def Have.Map.empty pkg.pkg_defs
in
let mem x = Have.Map.mem x haves in
let find x = Have.Map.find x haves in
let warning fmt = warned := true; Printf.printf fmt in
let if_ ?has ?(has_not=[]) msg =
match has, has_not with
| Some has, [] when mem has ->
warning "%a%s\n\n" print_def (find has) msg;
| Some has, has_not when mem has && not (List.exists mem has_not) ->
warning "%a%s\n\n" print_def (find has) msg;
| None, has_not when not (List.exists mem has_not) ->
warning "%s\n\n" msg;
| _ -> ()
in
if_ ~has_not:[`Description]
"You should add a description.";
if_ ~has_not:[`Version]
"You should add a version.";
if_ ~has_not:[`Requires]
"You should add the required libraries. You can silent this \
warning by using the empty string.";
if_ ~has:(`Mode(`TooMany))
"This variable should have only one mode
(\"byte\", \"native\").";
if_ ~has:(`Mode(`None))
"This variable should have at least the predicate \
\"byte\" or \"native\".";
let with_mode mode =
if_ ~has:(`Plugin (`Plugin,mode))
"You must not add the predicate \"plugin\" to the variable \
\"plugin\".";
if_ ~has:(`Archive (`Plugin,mode)) ~has_not:[`Plugin (`NoPlugin,mode)]
"This specification of dynamic loading is deprecated, you should add a \
\"plugin(...)\" variable.";
if_ ~has:(`Archive (`NoPlugin,mode))
~has_not:[`Plugin (`NoPlugin,mode);`Archive (`Plugin,mode)]
"This variable indicates how to link statically, you should add a \
\"plugin(...)\" variable for linking dynamically.";
in
with_mode `Byte;
with_mode `Native
let warn pkg =
let warned = ref false in
let rec aux pkg =
warn_def ~warned pkg;
List.iter (fun (_,pkg) -> aux pkg) pkg.pkg_children;
in
aux pkg;
!warned