Camlinternalformat: remove faulty check_open_box function

- Currently the check is a no-op, because the "emit a warning if the
  check fails" was never implemented. (It would actually require some
  work to pass a source location there to emit a warning, so it's not
  trivial.)

- The check is implemented by calling `open_box_of_string` and
  catching the `Failure _` exception if that function fails. This is
  just wrong: `Failure _` should be reserved to fatal program errors,
  and should not be caught for control-flow.

- The current implement is buggy (it fails all the time, but we don't
  notice because no warning is emitted):
  CamlinternalFormat.open_box_of_string expects a string of the form
  "v 3", but check_open_box would pass a string of the form "<v 3>"
  (or an empty string), which is the payload of the format value. So
  the check always fails.

- The idea of the check is wrong: "@[<x>foo@]" is an incorrect format
  string to pass to Format (the box indication does not make sense),
  but it is a perfectly fine format string to pass to Printf, where it
  just prints "@[<x>foo@]" on the output. So we cannot complain to the
  user at type-checking time, when we don't know how the format string
  will be used, whether the boxes will be interpreted as actual boxes
  or string literals.

1 files changed, 2 insertions, 11 deletions

diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml
index b10fba81ad..49bf66a017 100644
--- a/stdlib/camlinternalFormat.ml
+++ b/stdlib/camlinternalFormat.ml
@@ -2629,14 +2629,6 @@ let fmt_ebb_of_string ?legacy_behavior str =
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
         Fmt_EBB (Formatting_lit (Scan_indic c, fmt_rest))
 
-  and check_open_box : type a b c d e f . (a, b, c, d, e, f) fmt -> unit =
-  fun fmt -> match fmt with
-    | String_literal (str, End_of_format) -> (
-      try ignore (open_box_of_string str) with Failure _ ->
-        ((* Emit warning: invalid open box *))
-    )
-    | _ -> ()
-
   (* Try to read the optional <name> after "@{" or "@[". *)
   and parse_tag : type e f . bool -> int -> int -> (_, _, e, f) fmt_ebb =
   fun is_open_tag str_ind end_ind ->
@@ -2650,9 +2642,8 @@ let fmt_ebb_of_string ?legacy_behavior str =
         let Fmt_EBB fmt_rest = parse (ind + 1) end_ind in
         let Fmt_EBB sub_fmt = parse str_ind (ind + 1) in
         let sub_format = Format (sub_fmt, sub_str) in
-        let formatting = if is_open_tag then Open_tag sub_format else (
-          check_open_box sub_fmt;
-          Open_box sub_format) in
+        let formatting =
+          if is_open_tag then Open_tag sub_format else Open_box sub_format in
         Fmt_EBB (Formatting_gen (formatting, fmt_rest))
       | _ ->
         raise Not_found