Fix: emitter buffer could move under its feet because of GC

ffi/bindings/yaml_bindings.ml

@@ -57,7 +57,7 @@ module M (F : Ctypes.FOREIGN) = struct
     foreign "yaml_emitter_set_output_string"
       C.(
         ptr T.Emitter.t
-        @-> ocaml_bytes
+        @-> ptr char
         @-> size_t
         @-> ptr size_t
         @-> returning void)

lib/stream.ml

@@ -261,7 +261,7 @@ let do_parse { p; event } =
 type emitter = {
   e : T.Emitter.t Ctypes.structure Ctypes.ptr;
   event : T.Event.t Ctypes.structure Ctypes.ptr;
-  buf : Bytes.t;
+  buf : char Ctypes.ptr;
   written : Unsigned.size_t Ctypes.ptr;
 }
 
@@ -273,15 +273,16 @@ let emitter ?(len = 65535 * 4) () =
   let event = Ctypes.(allocate_n T.Event.t ~count:1) in
   let written = Ctypes.allocate_n Ctypes.size_t ~count:1 in
   let r = B.emitter_init e in
-  let buf = Bytes.create len in
-  let len = Bytes.length buf |> Unsigned.Size_t.of_int in
-  B.emitter_set_output_string e (Ctypes.ocaml_bytes_start buf) len written;
+  let buf = Ctypes.(allocate_n Ctypes.char ~count:len) in
+  let len = Unsigned.Size_t.of_int len in
+  B.emitter_set_output_string e buf len written;
   match r with
   | 1 -> Ok { e; event; written; buf }
   | n -> Error (`Msg ("error initialising emitter: " ^ string_of_int n))
 
 let emitter_buf { buf; written } =
-  Ctypes.(!@written) |> Unsigned.Size_t.to_int |> Bytes.sub buf 0
+  let length = Ctypes.(!@written) |> Unsigned.Size_t.to_int in
+  Ctypes.string_from_ptr buf ~length
 
 let check l a =
   match a with

lib/yaml.ml

@@ -115,7 +115,7 @@ let to_string ?len ?(encoding = `Utf8) ?scalar_style ?layout_style (v : value) =
   document_end t >>= fun () ->
   stream_end t >>= fun () ->
   let r = Stream.emitter_buf t in
-  Ok (Bytes.to_string r)
+  Ok r
 
 let to_string_exn ?len ?encoding ?scalar_style ?layout_style s =
   match to_string ?len ?encoding ?scalar_style ?layout_style s with
@@ -151,7 +151,7 @@ let yaml_to_string ?len ?(encoding = `Utf8) ?scalar_style ?layout_style v =
   document_end t >>= fun () ->
   stream_end t >>= fun () ->
   let r = Stream.emitter_buf t in
-  Ok (Bytes.to_string r)
+  Ok r
 
 let yaml_of_string s =
   let open Event in

lib/yaml.mli

@@ -278,7 +278,7 @@ module Stream : sig
       buffer that the output is written into is. In the future, [len] will be
       redundant as the buffer will be dynamically allocated. *)
 
-  val emitter_buf : emitter -> Bytes.t
+  val emitter_buf : emitter -> string
   val emit : emitter -> Event.t -> unit res
   val document_start : ?version:version -> ?implicit:bool -> emitter -> unit res
   val document_end : ?implicit:bool -> emitter -> unit res

tests/test_emit.ml

@@ -43,5 +43,5 @@ let v () =
   S.stream_end t >>= fun () ->
   Printf.printf "written: %d\n%!" (S.emitter_written t);
   let r = S.emitter_buf t in
-  print_endline (Bytes.to_string r);
+  print_endline r;
   Ok ()

tests/test_reflect.ml

@@ -31,5 +31,5 @@ let v file =
   iter_until_done (reflect e) >>= fun () ->
   let r = Yaml.Stream.emitter_buf e in
   print_endline buf;
-  print_endline (Bytes.to_string r);
+  print_endline r;
   Ok ()