From 5df12c772533196a2719129f489c7ead0061c9c1 Mon Sep 17 00:00:00 2001
From: Timotej Kapus <kapust@fb.com>
Date: Fri, 28 Jun 2019 01:29:48 -0700
Subject: [PATCH] [sledge] Add lib-fuzzer to buck analyze

Summary: Adds `-lib-fuzzer` flag to `buck analyze` for better usability

Reviewed By: ngorogiannis

Differential Revision: D16032095

fbshipit-source-id: cc528dd5d
---
 sledge/src/llair/frontend.ml  | 11 +++++++++--
 sledge/src/llair/frontend.mli |  2 +-
 sledge/src/sledge.ml          |  4 +++-
 3 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/sledge/src/llair/frontend.ml b/sledge/src/llair/frontend.ml
index eedff14bd..ae74c27bd 100644
--- a/sledge/src/llair/frontend.ml
+++ b/sledge/src/llair/frontend.ml
@@ -1395,8 +1395,8 @@ let link_in : Llvm.llcontext -> Llvm.lllinker -> string -> unit =
   |>
   [%Trace.retn fun {pf} _ -> pf ""]
 
-let translate : string list -> Llair.t =
- fun inputs ->
+let translate : lib_fuzzer_harness:bool -> string list -> Llair.t =
+ fun ~lib_fuzzer_harness inputs ->
   [%Trace.call fun {pf} ->
     pf "%a" (List.pp "@ " Format.pp_print_string) inputs]
   ;
@@ -1409,6 +1409,13 @@ let translate : string list -> Llair.t =
     in
     Llvm_irreader.parse_ir llcontext model_memorybuffer
   in
+  ( if lib_fuzzer_harness then
+    let lib_fuzzer_memorybuffer =
+      Llvm.MemoryBuffer.of_string
+        (Option.value_exn (Model.read "/lib_fuzzer_main.bc"))
+    in
+    Llvm_linker.link_modules' llmodule
+      (Llvm_irreader.parse_ir llcontext lib_fuzzer_memorybuffer) ) ;
   let link_ctx = Llvm_linker.get_linker llmodule in
   List.iter inputs ~f:(link_in llcontext link_ctx) ;
   Llvm_linker.linker_dispose link_ctx ;
diff --git a/sledge/src/llair/frontend.mli b/sledge/src/llair/frontend.mli
index 4824844ab..ce3fbb63f 100644
--- a/sledge/src/llair/frontend.mli
+++ b/sledge/src/llair/frontend.mli
@@ -9,6 +9,6 @@
 
 exception Invalid_llvm of string
 
-val translate : string list -> Llair.t
+val translate : lib_fuzzer_harness:bool -> string list -> Llair.t
 (** Translate the compilation units in the named (llvm or bitcode) files to
     LLAIR. Attempts to raise [Invalid_llvm] when the input is invalid LLVM. *)
diff --git a/sledge/src/sledge.ml b/sledge/src/sledge.ml
index c76149707..5b4814e08 100644
--- a/sledge/src/sledge.ml
+++ b/sledge/src/sledge.ml
@@ -88,9 +88,11 @@ let translate =
   let%map_open output =
     flag "output-llair" (optional string)
       ~doc:"<file> write generated LLAIR to <file>"
+  and lib_fuzzer_harness =
+    flag "lib-fuzzer" no_arg ~doc:"add a harness for lib fuzzer binaries"
   in
   fun bitcode_inputs () ->
-    let program = Frontend.translate bitcode_inputs in
+    let program = Frontend.translate ~lib_fuzzer_harness bitcode_inputs in
     Option.iter ~f:(marshal program) output ;
     program