Add a LLVMWriteBitcodeToFD that exposes the raw_fd_ostream options.

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@97858 91177308-0d34-0410-b5e6-96231b3b80d8

bindings/ocaml/bitwriter/bitwriter_ocaml.c

@@ -28,3 +28,18 @@ CAMLprim value llvm_write_bitcode_file(value M, value Path) {
   int res = LLVMWriteBitcodeToFile((LLVMModuleRef) M, String_val(Path));
   return Val_bool(res == 0);
 }
+
+/* ?unbuffered:bool -> Llvm.llmodule -> Unix.file_descr -> bool */
+CAMLprim value llvm_write_bitcode_to_fd(value U, value M, value FD) {
+  int Unbuffered;
+  int res;
+
+  if (U == Val_int(0)) {
+    Unbuffered = 0;
+  } else {
+    Unbuffered = Bool_val(Field(U,0));
+  }
+
+  res = LLVMWriteBitcodeToFD((LLVMModuleRef) M, Int_val(FD), 0, Unbuffered);
+  return Val_bool(res == 0);
+}

bindings/ocaml/bitwriter/llvm_bitwriter.ml

@@ -16,3 +16,10 @@
 (* Writes the bitcode for module the given path. Returns true if successful. *)
 external write_bitcode_file : Llvm.llmodule -> string -> bool
                             = "llvm_write_bitcode_file"
+
+external write_bitcode_to_fd : ?unbuffered:bool -> Llvm.llmodule
+                               -> Unix.file_descr -> bool
+                             = "llvm_write_bitcode_to_fd"
+
+let output_bitcode ?unbuffered channel m =
+  write_bitcode_to_fd ?unbuffered m (Unix.descr_of_out_channel channel)

bindings/ocaml/bitwriter/llvm_bitwriter.mli

@@ -16,3 +16,15 @@
     [path]. Returns [true] if successful, [false] otherwise. *)
 external write_bitcode_file : Llvm.llmodule -> string -> bool
                             = "llvm_write_bitcode_file"
+
+(** [write_bitcode_to_fd ~unbuffered fd m] writes the bitcode for module
+    [m] to the channel [c]. If [unbuffered] is [true], after every write the fd
+    will be flushed. Returns [true] if successful, [false] otherwise. *)
+external write_bitcode_to_fd : ?unbuffered:bool -> Llvm.llmodule
+                               -> Unix.file_descr -> bool
+                             = "llvm_write_bitcode_to_fd"
+
+(** [output_bitcode ~unbuffered c m] writes the bitcode for module [m]
+    to the channel [c]. If [unbuffered] is [true], after every write the fd
+    will be flushed. Returns [true] if successful, [false] otherwise. *)
+val output_bitcode : ?unbuffered:bool -> out_channel -> Llvm.llmodule -> bool

include/llvm-c/BitWriter.h

@@ -28,13 +28,16 @@ extern "C" {
 
 /*===-- Operations on modules ---------------------------------------------===*/
 
-/* Writes a module to an open file descriptor. Returns 0 on success.
+/** Writes a module to the specified path. Returns 0 on success. */ 
-   Closes the Handle. Use dup first if this is not what you want. */ 
-int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int Handle);
-
-/* Writes a module to the specified path. Returns 0 on success. */ 
 int LLVMWriteBitcodeToFile(LLVMModuleRef M, const char *Path);
 
+/** Writes a module to an open file descriptor. Returns 0 on success. */
+int LLVMWriteBitcodeToFD(LLVMModuleRef M, int FD, int ShouldClose,
+                         int Unbuffered);
+
+/** Deprecated for LLVMWriteBitcodeToFD. Writes a module to an open file
+    descriptor. Returns 0 on success. Closes the Handle. */ 
+int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int Handle);
 
 #ifdef __cplusplus
 }

lib/Bitcode/Writer/BitWriter.cpp

@@ -27,9 +27,14 @@ int LLVMWriteBitcodeToFile(LLVMModuleRef M, const char *Path) {
   return 0;
 }
 
-int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int FileHandle) {
+int LLVMWriteBitcodeToFD(LLVMModuleRef M, int FD, int ShouldClose,
-  raw_fd_ostream OS(FileHandle, true);
+                         int Unbuffered) {
+  raw_fd_ostream OS(FD, ShouldClose, Unbuffered);
   
   WriteBitcodeToFile(unwrap(M), OS);
   return 0;
 }
+
+int LLVMWriteBitcodeToFileHandle(LLVMModuleRef M, int FileHandle) {
+  return LLVMWriteBitcodeToFD(M, FileHandle, true, false);
+}

test/Bindings/Ocaml/bitwriter.ml

@@ -1,4 +1,4 @@
-(* RUN: %ocamlopt -warn-error A llvm.cmxa llvm_bitwriter.cmxa %s -o %t
+(* RUN: %ocamlopt -warn-error A unix.cmxa llvm.cmxa llvm_bitwriter.cmxa %s -o %t
  * RUN: ./%t %t.bc
  * RUN: llvm-dis < %t.bc | grep caml_int_ty
  *)
@@ -10,9 +10,37 @@ let context = Llvm.global_context ()
 
 let test x = if not x then exit 1 else ()
 
+let read_file name =
+  let ic = open_in_bin name in
+  let len = in_channel_length ic in
+  let buf = String.create len in
+
+  test ((input ic buf 0 len) = len);
+
+  close_in ic;
+
+  buf
+
+let temp_bitcode ?unbuffered m =
+  let temp_name, temp_oc = Filename.open_temp_file ~mode:[Open_binary] "" "" in
+
+  test (Llvm_bitwriter.output_bitcode ?unbuffered temp_oc m);
+  flush temp_oc;
+
+  let temp_buf = read_file temp_name in
+
+  close_out temp_oc;
+
+  temp_buf
+
 let _ =
   let m = Llvm.create_module context "ocaml_test_module" in
   
   ignore (Llvm.define_type_name "caml_int_ty" (Llvm.i32_type context) m);
-  
+
-  test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1))
+  test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1));
+  let file_buf = read_file Sys.argv.(1) in
+
+  test (file_buf = temp_bitcode m);
+  test (file_buf = temp_bitcode ~unbuffered:false m);
+  test (file_buf = temp_bitcode ~unbuffered:true m)