change procedures_translated logging to use eventlogger framework

Summary:
- After completing program translation, infer logs # of attempted procedure translations and # of completed procedure translations via EventLogger
- New possible type of event in EventLogger

Reviewed By: dulmarod

Differential Revision: D6711662

fbshipit-source-id: 5e31332

infer/src/base/EventLogger.ml

@@ -74,9 +74,31 @@ end
 
 let get_log_identifier () = Random_id.get ()
 
-type event = UncaughtException of exn * int
+type procedures_translated =
+  { procedures_translated_total: int
+  ; procedures_translated_failed: int
+  ; lang: string
+  ; source_file: SourceFile.t }
+
+let create_procedures_translated_row base record =
+  let open JsonBuilder in
+  base |> add_int ~key:"procedures_translated_total" ~data:record.procedures_translated_total
+  |> add_int ~key:"procedures_translated_failed" ~data:record.procedures_translated_failed
+  |> add_string ~key:"lang" ~data:record.lang
+  |> add_string ~key:"source_file" ~data:(SourceFile.to_rel_path record.source_file)
+
+
+type event =
+  | UncaughtException of exn * int
+  | ProceduresTranslatedSummary of procedures_translated
+
+let string_of_event event =
+  match event with
+  | UncaughtException _ ->
+      "UncaughtException"
+  | ProceduresTranslatedSummary _ ->
+      "ProceduresTranslatedSummary"
 
-let string_of_event event = match event with UncaughtException _ -> "UncaughtException"
 
 let sequence_ctr = ref 0
 
@@ -104,10 +126,13 @@ let create_row event =
     |> add_int ~key:"sequence" ~data:(!sequence_ctr - 1) |> add_string ~key:"sysname" ~data:sysname
     |> add_int ~key:"time" ~data:(int_of_float (Unix.time ()))
   in
-  ( match event with UncaughtException (exn, exitcode) ->
+  ( match event with
+  | UncaughtException (exn, exitcode) ->
       base |> add_string ~key:"exception" ~data:(Caml.Printexc.exn_slot_name exn)
       |> add_string ~key:"exception_info" ~data:(Exn.to_string exn)
-      |> add_int ~key:"exitcode" ~data:exitcode )
+      |> add_int ~key:"exitcode" ~data:exitcode
+  | ProceduresTranslatedSummary record ->
+      create_procedures_translated_row base record )
   |> JsonBuilder.to_json
 
 

infer/src/base/EventLogger.mli

@@ -7,7 +7,15 @@
  * of patent rights can be found in the PATENTS file in the same directory.
  *)
 
-type event = UncaughtException of exn * int  (** exception, exitcode *)
+type procedures_translated =
+  { procedures_translated_total: int
+  ; procedures_translated_failed: int
+  ; lang: string
+  ; source_file: SourceFile.t }
+
+type event =
+  | UncaughtException of exn * int  (** exception, exitcode *)
+  | ProceduresTranslatedSummary of procedures_translated  (** record of procedures translated *)
 
 val get_log_identifier : unit -> string
 

infer/src/clang/cFrontend.ml

@@ -39,7 +39,7 @@ let init_global_state_capture () =
   CProcname.reset_block_counter ()
 
 
-let do_source_file translation_unit_context ast =
+let do_source_file (translation_unit_context: CFrontend_config.translation_unit_context) ast =
   let tenv = Tenv.create () in
   CType_decl.add_predefined_types tenv ;
   init_global_state_capture () ;
@@ -66,9 +66,13 @@ let do_source_file translation_unit_context ast =
     Dotty.print_icfg_dotty source_file cfg ;
     Cg.save_call_graph_dotty source_file call_graph ) ;
   L.(debug Capture Verbose) "%a" Cfg.pp_proc_signatures cfg ;
-  L.(debug Capture Verbose)
+  let procedures_translated_summary =
-    "# Procedures started: %d@\n# Procedures completed: %d@\n@\n"
+    EventLogger.ProceduresTranslatedSummary
-    !CFrontend_config.procedures_attempted
+      { procedures_translated_total= !CFrontend_config.procedures_attempted
-    (!CFrontend_config.procedures_attempted - !CFrontend_config.procedures_failed) ;
+      ; procedures_translated_failed= !CFrontend_config.procedures_failed
+      ; lang= CFrontend_config.string_of_clang_lang translation_unit_context.lang
+      ; source_file= translation_unit_context.source_file }
+  in
+  EventLogger.log procedures_translated_summary ;
   (* NOTE: nothing should be written to source_dir after this *)
   DB.mark_file_updated (DB.source_dir_to_string source_dir)

infer/src/clang/cFrontend_config.ml

@@ -22,6 +22,10 @@ let unimplemented fmt = F.kasprintf (fun msg -> raise (Unimplemented msg)) fmt
 
 type clang_lang = C | CPP | ObjC | ObjCPP [@@deriving compare]
 
+let string_of_clang_lang (lang: clang_lang) : string =
+  match lang with C -> "C" | CPP -> "CPP" | ObjC -> "ObjC" | ObjCPP -> "ObjCPP"
+
+
 let equal_clang_lang = [%compare.equal : clang_lang]
 
 type translation_unit_context = {lang: clang_lang; source_file: SourceFile.t}

infer/src/clang/cFrontend_config.mli

@@ -25,6 +25,8 @@ val unimplemented : ('a, Format.formatter, unit, _) format4 -> 'a
 
 type clang_lang = C | CPP | ObjC | ObjCPP [@@deriving compare]
 
+val string_of_clang_lang : clang_lang -> string
+
 val equal_clang_lang : clang_lang -> clang_lang -> bool
 
 type translation_unit_context = {lang: clang_lang; source_file: SourceFile.t}