/main_scheck_heavy.ml
https://github.com/repos-ocaml/pfff · OCaml · 211 lines · 110 code · 46 blank · 55 comment · 3 complexity · 89f93843f633bc7b52167cdf64160fe3 MD5 · raw file
- (*
- * The author disclaims copyright to this source code. In place of
- * a legal notice, here is a blessing:
- *
- * May you do good and not evil.
- * May you find forgiveness for yourself and forgive others.
- * May you share freely, never taking more than you give.
- *)
- open Common
- open Ast_php
- module Ast = Ast_php
- module V = Visitor_php
- module S = Scope_code
- (*****************************************************************************)
- (* Purpose *)
- (*****************************************************************************)
- (* A lint-like checker for PHP using (expensive) global analysis.
- * Mostly a copy paste of main_scheck.ml.
- *)
- (*****************************************************************************)
- (* Flags *)
- (*****************************************************************************)
- let verbose = ref false
- (* action mode *)
- let action = ref ""
- (* no -heavy or -depth_limit or -php_stdlib or -cache_parse here *)
- let metapath = ref "/tmp/pfff_db"
- let strict_scope = ref false
- let rank = ref true
- let layer_file = ref (None: filename option)
- (*****************************************************************************)
- (* Helpers *)
- (*****************************************************************************)
- (*****************************************************************************)
- (* Wrappers *)
- (*****************************************************************************)
- let pr2_dbg s =
- if !verbose then Common.pr2 s
- (*****************************************************************************)
- (* Main action *)
- (*****************************************************************************)
- (* mostly a copy paste of main_scheck.ml but now use metapath *)
- let main_action xs =
- let files = Lib_parsing_php.find_php_files_of_dir_or_files xs in
- let errors = ref [] in
- Flag_parsing_php.show_parsing_error := false;
- Flag_parsing_php.verbose_lexing := false;
- Database_php.with_db ~metapath:!metapath (fun db ->
- let find_entity = Some (Database_php_build.build_entity_finder db) in
- files +> Common.index_list_and_total +> List.iter (fun (file, i, total) ->
- try
- pr2_dbg (spf "processing: %s (%d/%d)" file i total);
- Check_all_php.check_file ~find_entity file;
- with
- | (Timeout | UnixExit _) as exn -> raise exn
- | exn ->
- Common.push2 (spf "PB with %s, exn = %s" file
- (Common.string_of_exn exn)) errors;
- );
- let errs = !Error_php._errors +> List.rev in
- let errs =
- if !rank
- then Error_php.rank_errors errs +> Common.take_safe 20
- else errs
- in
- errs +> List.iter (fun err -> pr (Error_php.string_of_error err));
- Error_php.show_10_most_recurring_unused_variable_names ();
- pr2 (spf "total errors = %d" (List.length !Error_php._errors));
- pr2 "";
- !errors +> List.iter pr2;
- pr2 "";
- !layer_file +> Common.do_option (fun file ->
- (* a layer needs readable paths, hence the root *)
- let root = Common.common_prefix_of_files_or_dirs xs in
- Layer_checker_php.gen_layer ~root ~output:file !Error_php._errors
- );
- )
- (*****************************************************************************)
- (* Extra actions *)
- (*****************************************************************************)
- (*---------------------------------------------------------------------------*)
- (* the command line flags *)
- (*---------------------------------------------------------------------------*)
- let extra_actions () = [
- ]
- (*****************************************************************************)
- (* The options *)
- (*****************************************************************************)
- let all_actions () =
- extra_actions()++
- []
- let options () =
- [
- "-metapath", Arg.Set_string metapath,
- "<dir> (default=" ^ !metapath ^ ")";
- "-strict", Arg.Set strict_scope,
- " emulate block scope instead of function scope";
- "-no_scrict", Arg.Clear strict_scope,
- " use function scope (default)";
- "-no_rank", Arg.Clear rank,
- " ";
- "-gen_layer", Arg.String (fun s -> layer_file := Some s),
- " <file> save result in pfff layer file";
- "-verbose", Arg.Set verbose,
- " ";
- ] ++
- Flag_analyze_php.cmdline_flags_verbose () ++
- Common.options_of_actions action (all_actions()) ++
- Common.cmdline_flags_devel () ++
- Common.cmdline_flags_verbose () ++
- Common.cmdline_flags_other () ++
- [
- "-version", Arg.Unit (fun () ->
- pr2 (spf "scheck version: %s" Config.version);
- exit 0;
- ),
- " guess what";
- (* this can not be factorized in Common *)
- "-date", Arg.Unit (fun () ->
- pr2 "version: $Date: 2010/04/25 00:44:57 $";
- raise (Common.UnixExit 0)
- ),
- " guess what";
- ] ++
- []
- (*****************************************************************************)
- (* Main entry point *)
- (*****************************************************************************)
- let main () =
- Common_extra.set_link();
- Database_php_storage.set_link();
- let usage_msg =
- "Usage: " ^ Common.basename Sys.argv.(0) ^
- " [options] <file or dir> " ^ "\n" ^ "Options are:"
- in
- (* does side effect on many global flags *)
- let args = Common.parse_options (options()) usage_msg Sys.argv in
- (* must be done after Arg.parse, because Common.profile is set by it *)
- Common.profile_code "Main total" (fun () ->
- (match args with
- (* --------------------------------------------------------- *)
- (* actions, useful to debug subpart *)
- (* --------------------------------------------------------- *)
- | xs when List.mem !action (Common.action_list (all_actions())) ->
- Common.do_action !action xs (all_actions())
- | _ when not (Common.null_string !action) ->
- failwith ("unrecognized action or wrong params: " ^ !action)
- (* --------------------------------------------------------- *)
- (* main entry *)
- (* --------------------------------------------------------- *)
- | x::xs ->
- main_action (x::xs)
- (* --------------------------------------------------------- *)
- (* empty entry *)
- (* --------------------------------------------------------- *)
- | [] ->
- Common.usage usage_msg (options());
- failwith "too few arguments"
- )
- )
- (*****************************************************************************)
- let _ =
- Common.main_boilerplate (fun () ->
- main ();
- )