infer_clone/infer/src/infer.ml

(*
 * Copyright (c) Facebook, Inc. and its affiliates.
 *
 * This source code is licensed under the MIT license found in the
 * LICENSE file in the root directory of this source tree.
 *)

open! IStd

(** Top-level driver that orchestrates build system integration, frontends, backend, and reporting *)

module CLOpt = CommandLineOption
module L = Logging

let run driver_mode =
  let open Driver in
  run_prologue driver_mode ;
  let changed_files = read_config_changed_files () in
  InferAnalyze.invalidate_changed_procedures changed_files ;
  capture driver_mode ~changed_files ;
  analyze_and_report driver_mode ~changed_files ;
  run_epilogue ()


let run driver_mode = ScubaLogging.execute_with_time_logging "run" (fun () -> run driver_mode)

let setup () =
  let db_start =
    let already_started = ref false in
    fun () ->
      if (not !already_started) && CLOpt.is_originator && DBWriter.use_daemon then (
        DBWriter.start () ;
        Epilogues.register ~f:DBWriter.stop ~description:"Stop Sqlite write daemon" ;
        already_started := true )
  in
  ( match Config.command with
  | Analyze ->
      ResultsDir.assert_results_dir "have you run capture before?"
  | Report | ReportDiff ->
      ResultsDir.create_results_dir ()
  | Capture | Compile | Run ->
      let driver_mode = Lazy.force Driver.mode_from_command_line in
      if
        Config.(
          (* In Buck mode, delete infer-out directories inside buck-out to start fresh and to
             avoid getting errors because some of their contents is missing (removed by
             [Driver.clean_results_dir ()]). *)
          (buck && Option.exists buck_mode ~f:BuckMode.is_clang_flavors) || genrule_mode)
        || not
             ( Driver.is_analyze_mode driver_mode
             || Config.(
                  continue_capture || infer_is_clang || infer_is_javac || reactive_mode
                  || incremental_analysis) )
      then ResultsDir.remove_results_dir () ;
      ResultsDir.create_results_dir () ;
      if
        CLOpt.is_originator && (not Config.continue_capture)
        && not (Driver.is_analyze_mode driver_mode)
      then ( db_start () ; SourceFiles.mark_all_stale () )
  | Explore ->
      ResultsDir.assert_results_dir "please run an infer analysis first" ) ;
  db_start () ;
  NullsafeInit.init () ;
  if CLOpt.is_originator then ResultsDir.RunState.add_run_to_sequence () ;
  ()


let print_active_checkers () =
  (if Config.print_active_checkers && CLOpt.is_originator then L.result else L.environment_info)
    "Active checkers: %a@."
    (Pp.seq ~sep:", " RegisterCheckers.pp_checker)
    (RegisterCheckers.get_active_checkers ())


let print_scheduler () =
  L.environment_info "Scheduler: %s@\n"
    ( match Config.scheduler with
    | File ->
        "file"
    | Restart ->
        "restart"
    | SyntacticCallGraph ->
        "callgraph" )


let print_cores_used () = L.environment_info "Cores used: %d@\n" Config.jobs

let log_environment_info () =
  L.environment_info "CWD = %s@\n" (Sys.getcwd ()) ;
  ( match Config.inferconfig_file with
  | Some file ->
      L.environment_info "Read configuration in %s@\n" file
  | None ->
      L.environment_info "No .inferconfig file found@\n" ) ;
  L.environment_info "Project root = %s@\n" Config.project_root ;
  let infer_args =
    Sys.getenv CLOpt.args_env_var
    |> Option.map ~f:(String.split ~on:CLOpt.env_var_sep)
    |> Option.value ~default:["<not set>"]
  in
  L.environment_info "INFER_ARGS = %a@\n"
    (Pp.cli_args_with_verbosity ~verbose:Config.debug_mode)
    infer_args ;
  L.environment_info "command line arguments: %a@\n"
    (Pp.cli_args_with_verbosity ~verbose:Config.debug_mode)
    (Array.to_list Sys.(get_argv ())) ;
  ( match Utils.get_available_memory_MB () with
  | None ->
      L.environment_info "Could not retrieve available memory (possibly not on Linux)@\n"
  | Some available_memory ->
      L.environment_info "Available memory at startup: %d MB@\n" available_memory ;
      ScubaLogging.log_count ~label:"startup_mem_avail_MB" ~value:available_memory ) ;
  print_active_checkers () ; print_scheduler () ; print_cores_used ()


let () =
  (* We specifically want to collect samples only from the main process until
     we figure out what other entries and how we want to collect *)
  if CommandLineOption.is_originator then ScubaLogging.register_global_log_flushing_at_exit () ;
  ( if Config.linters_validate_syntax_only then
    match CTLParserHelper.validate_al_files () with
    | Ok () ->
        L.exit 0
    | Error e ->
        print_endline e ; L.exit 3 ) ;
  ( match Config.check_version with
  | Some check_version ->
      if not (String.equal check_version Version.versionString) then
        L.(die UserError)
          "Provided version '%s' does not match actual version '%s'" check_version
          Version.versionString
  | None ->
      () ) ;
  if Config.print_builtins then Builtin.print_and_exit () ;
  setup () ;
  log_environment_info () ;
  if Config.debug_mode && CLOpt.is_originator then (
    L.progress "Logs in %s@." (ResultsDir.get_path Logs) ;
    L.progress "Execution ID %Ld@." Config.execution_id ) ;
  ( if Config.test_determinator && not Config.process_clang_ast then
    TestDeterminator.compute_and_emit_test_to_run ()
  else
    match Config.command with
    | Analyze ->
        run Driver.Analyze
    | Capture | Compile | Run ->
        run (Lazy.force Driver.mode_from_command_line)
    | Report -> (
      match Config.issues_tests with
      | None ->
          if not Config.quiet then L.result "%t" SpecsFiles.pp_from_config
      | Some out_path ->
          IssuesTest.write_from_json ~json_path:Config.from_json_report ~out_path
            Config.issues_tests_fields )
    | ReportDiff ->
        (* at least one report must be passed in input to compute differential *)
        ( match Config.(report_current, report_previous, costs_current, costs_previous) with
        | None, None, None, None ->
            L.(die UserError)
              "Expected at least one argument among '--report-current', '--report-previous', \
               '--costs-current', and '--costs-previous'"
        | _ ->
            () ) ;
        ReportDiff.reportdiff ~current_report:Config.report_current
          ~previous_report:Config.report_previous ~current_costs:Config.costs_current
          ~previous_costs:Config.costs_previous
    | Explore -> (
      match (Config.procedures, Config.source_files) with
      | true, false ->
          let filter = Lazy.force Filtering.procedures_filter in
          if Config.procedures_summary then
            let pp_summary fmt proc_name =
              match Summary.OnDisk.get proc_name with
              | None ->
                  Format.fprintf fmt "No summary found: %a@\n" Procname.pp proc_name
              | Some summary ->
                  Summary.pp_text fmt summary
            in
            Option.iter (Procedures.select_proc_names_interactive ~filter) ~f:(fun proc_names ->
                L.result "%a" (fun fmt () -> List.iter proc_names ~f:(pp_summary fmt)) () )
          else
            L.result "%a"
              Config.(
                Procedures.pp_all ~filter ~proc_name:procedures_name
                  ~attr_kind:procedures_definedness ~source_file:procedures_source_file
                  ~proc_attributes:procedures_attributes)
              ()
      | false, true ->
          let filter = Lazy.force Filtering.source_files_filter in
          L.result "%a"
            (SourceFiles.pp_all ~filter ~type_environment:Config.source_files_type_environment
               ~procedure_names:Config.source_files_procedure_names
               ~freshly_captured:Config.source_files_freshly_captured)
            () ;
          if Config.source_files_cfg then (
            let source_files = SourceFiles.get_all ~filter () in
            List.iter source_files ~f:(fun source_file ->
                (* create directory in captured/ *)
                DB.Results_dir.init ~debug:true source_file ;
                (* collect the CFGs for all the procedures in [source_file] *)
                let proc_names = SourceFiles.proc_names_of_source source_file in
                let cfgs = Procname.Hash.create (List.length proc_names) in
                List.iter proc_names ~f:(fun proc_name ->
                    Procdesc.load proc_name
                    |> Option.iter ~f:(fun cfg -> Procname.Hash.add cfgs proc_name cfg) ) ;
                (* emit the dot file in captured/... *)
                DotCfg.emit_frontend_cfg source_file cfgs ) ;
            L.result "CFGs written in %s/*/%s@." (ResultsDir.get_path Debug)
              Config.dotty_frontend_output )
      | false, false ->
          (* explore bug traces *)
          if Config.html then
            TraceBugs.gen_html_report ~report_json:(ResultsDir.get_path ReportJson)
              ~show_source_context:Config.source_preview ~max_nested_level:Config.max_nesting
              ~report_html_dir:(ResultsDir.get_path ReportHtml)
          else
            TraceBugs.explore ~selector_limit:None ~report_json:(ResultsDir.get_path ReportJson)
              ~report_txt:(ResultsDir.get_path ReportText) ~selected:Config.select
              ~show_source_context:Config.source_preview ~max_nested_level:Config.max_nesting
      | true, true ->
          L.user_error "Options --procedures and --source-files cannot be used together.@\n" ) ) ;
  (* to make sure the exitcode=0 case is logged, explicitly invoke exit *)
  L.exit 0