From f00a9e0f79541538df7e3af2e83de37f40d904cc Mon Sep 17 00:00:00 2001
From: Peter Zotov <whitequark@whitequark.org>
Date: Sun, 3 Nov 2013 08:27:45 +0000
Subject: [PATCH] [OCaml] Implement Llvm.MemoryBuffer.{of_string,as_string}

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@193953 91177308-0d34-0410-b5e6-96231b3b80d8
---
 bindings/ocaml/llvm/llvm.ml      |  2 ++
 bindings/ocaml/llvm/llvm.mli     |  7 +++++++
 bindings/ocaml/llvm/llvm_ocaml.c | 24 ++++++++++++++++++++++++
 test/Bindings/Ocaml/vmcore.ml    |  9 +++++++++
 4 files changed, 42 insertions(+)

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 67427089fe2..7596d65e148 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -1167,6 +1167,8 @@ external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue
 module MemoryBuffer = struct
   external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file"
   external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin"
+  external of_string : ?name:string -> string -> llmemorybuffer = "llvm_memorybuffer_of_string"
+  external as_string : llmemorybuffer -> string = "llvm_memorybuffer_as_string"
   external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose"
 end
 
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index c4375dc4524..e90fafe5241 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -2345,6 +2345,13 @@ module MemoryBuffer : sig
   (** [of_stdin ()] is the memory buffer containing the contents of standard input.
       If standard input is empty, then [IoError msg] is raised. *)
   val of_stdin : unit -> llmemorybuffer
+
+  (** [of_string ~name s] is the memory buffer containing the contents of string [s].
+      The name of memory buffer is set to [name] if it is provided. *)
+  val of_string : ?name:string -> string -> llmemorybuffer
+
+  (** [as_string mb] is the string containing the contents of memory buffer [mb]. *)
+  val as_string : llmemorybuffer -> string
   
   (** Disposes of a memory buffer. *)
   val dispose : llmemorybuffer -> unit
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 80fa8c3670d..bd269acf834 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -1996,6 +1996,30 @@ CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
   return MemBuf;
 }
 
+/* ?name:string -> string -> llmemorybuffer */
+CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_string(value Name, value String) {
+  const char *NameCStr;
+  if(Name == Val_int(0))
+    NameCStr = "";
+  else
+    NameCStr = String_val(Field(Name, 0));
+
+  LLVMMemoryBufferRef MemBuf;
+  MemBuf = LLVMCreateMemoryBufferWithMemoryRangeCopy(
+                String_val(String), caml_string_length(String), NameCStr);
+
+  return MemBuf;
+}
+
+/* llmemorybuffer -> string */
+CAMLprim value llvm_memorybuffer_as_string(LLVMMemoryBufferRef MemBuf) {
+  value String = caml_alloc_string(LLVMGetBufferSize(MemBuf));
+  memcpy(String_val(String), LLVMGetBufferStart(MemBuf),
+         LLVMGetBufferSize(MemBuf));
+
+  return String;
+}
+
 /* llmemorybuffer -> unit */
 CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) {
   LLVMDisposeMemoryBuffer(MemBuf);
diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index 0c4d0d62638..2fb5272546e 100644
--- a/test/Bindings/Ocaml/vmcore.ml
+++ b/test/Bindings/Ocaml/vmcore.ml
@@ -1320,6 +1320,14 @@ let test_pass_manager () =
   end
 
 
+(*===-- Memory Buffer -----------------------------------------------------===*)
+
+let test_memory_buffer () =
+  group "memory buffer";
+  let buf = MemoryBuffer.of_string "foobar" in
+  insist ((MemoryBuffer.as_string buf) = "foobar")
+
+
 (*===-- Writer ------------------------------------------------------------===*)
 
 let test_writer () =
@@ -1350,5 +1358,6 @@ let _ =
   suite "instructions"     test_instructions;
   suite "builder"          test_builder;
   suite "pass manager"     test_pass_manager;
+  suite "memory buffer"    test_memory_buffer;
   suite "writer"           test_writer; (* Keep this last; it disposes m. *)
   exit !exit_status
-- 
2.34.1