Add Format.kasprintf and fix Misc.fatal_errorf to use it

5 files changed, 11 insertions, 8 deletions

diff --git a/boot/ocamlc b/boot/ocamlc
index 60b4364878..23d35765fa 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index b422042c2e..45dd88241a 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/stdlib/format.ml b/stdlib/format.ml
index 194d3fcd3e..4ab6bed07a 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -1199,15 +1199,17 @@ let ksprintf k (Format (fmt, _)) =
 
 let sprintf fmt = ksprintf (fun s -> s) fmt;;
 
-let asprintf (Format (fmt, _)) =
+let kasprintf k (Format (fmt, _)) =
   let b = Buffer.create 512 in
   let ppf = formatter_of_buffer b in
   let k ppf acc =
     output_acc ppf acc;
-    flush_buffer_formatter b ppf in
+    k (flush_buffer_formatter b ppf) in
   make_printf k ppf End_of_acc fmt
 ;;
 
+let asprintf fmt = kasprintf (fun s -> s) fmt;;
+
 (**************************************************************
 
   Deprecated stuff.
diff --git a/stdlib/format.mli b/stdlib/format.mli
index 1092a2fb21..0af04f29c4 100644
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -714,6 +714,12 @@ val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
 (** Same as [sprintf] above, but instead of returning the string,
   passes it to the first argument. *)
 
+val kasprintf : (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b
+(** Same as [asprintf] above, but instead of returning the string,
+  passes it to the first argument.
+  @since 4.03
+*)
+
 (** {6 Deprecated} *)
 
 val bprintf : Buffer.t -> ('a, formatter, unit) format -> 'a
diff --git a/utils/misc.ml b/utils/misc.ml
index 57da5665d3..d3305b739f 100644
--- a/utils/misc.ml
+++ b/utils/misc.ml
@@ -17,12 +17,7 @@ exception Fatal_error
 let fatal_error msg =
   prerr_string ">> Fatal error: "; prerr_endline msg; raise Fatal_error
 
-let fatal_errorf fmt =
-  let (_ : string) = Format.flush_str_formatter () in
-  Format.kfprintf (fun ppf ->
-      fatal_error (Format.flush_str_formatter ()))
-    Format.str_formatter
-    fmt
+let fatal_errorf fmt = Format.kasprintf fatal_error fmt
 
 (* Exceptions *)