Add test for fix_string (#443)

dune-project

@@ -25,4 +25,5 @@
   lwt_react
   (zed (>= 3.2.0))
   (react (>= 1.0.0))
-  (cppo (>= 1.1.2))))
+  (cppo (>= 1.1.2))
+  (alcotest :with-test)))

src/lib/uTop.ml

@@ -845,3 +845,27 @@ let new_prompt_hooks = LTerm_dlist.create ()
 let at_new_prompt f = ignore (LTerm_dlist.add_l f new_prompt_hooks)
 let prompt_continue = ref (S.const [| |])
 let prompt_comment = ref (S.const [| |])
+
+module Private = struct
+  let fix_string str =
+    let len = String.length str in
+    let ofs, _, _ = Zed_utf8.next_error str 0 in
+    if ofs = len then
+      str
+    else begin
+      let buf = Buffer.create (len + 128) in
+      if ofs > 0 then Buffer.add_substring buf str 0 ofs;
+      let rec loop ofs =
+        Zed_utf8.add buf (Uchar.of_char str.[ofs]);
+        let ofs1 = ofs + 1 in
+        let ofs2, _, _ = Zed_utf8.next_error str ofs1 in
+        if ofs1 < ofs2 then
+          Buffer.add_substring buf str ofs1 (ofs2 - ofs1);
+        if ofs2 < len then
+          loop ofs2
+        else
+          Buffer.contents buf
+      in
+      loop ofs
+    end
+end

src/lib/uTop.mli

@@ -365,3 +365,7 @@ val new_prompt_hooks : (unit -> unit) LTerm_dlist.t
 
 val at_new_prompt : (unit -> unit) -> unit
 [@@deprecated]
+
+module Private : sig
+  val fix_string : string -> string
+end

src/lib/uTop_main.ml

@@ -18,6 +18,7 @@ open UTop_compat
 open UTop_token
 open UTop_styles
 open UTop_private
+open UTop.Private
 
 let return, (>>=) = Lwt.return, Lwt.(>>=)
 
@@ -407,32 +408,6 @@ end = struct
       scan_summary last_summary' summary
 end
 
-(* +-----------------------------------------------------------------+
-   | Out phrase printing                                             |
-   +-----------------------------------------------------------------+ *)
-
-let fix_string str =
-  let len = String.length str in
-  let ofs, _, _ = Zed_utf8.next_error str 0 in
-  if ofs = len then
-    str
-  else begin
-    let buf = Buffer.create (len + 128) in
-    if ofs > 0 then Buffer.add_substring buf str 0 ofs;
-    let rec loop ofs =
-      Zed_utf8.add buf (Uchar.of_char str.[ofs]);
-      let ofs1 = ofs + 1 in
-      let ofs2, _, _ = Zed_utf8.next_error str ofs1 in
-      if ofs1 < ofs2 then
-        Buffer.add_substring buf str ofs1 (ofs2 - ofs1);
-      if ofs2 < len then
-        loop ofs2
-      else
-        Buffer.contents buf
-    in
-    loop ofs
-  end
-
 let render_out_phrase term string =
   if String.length string >= 100 * 1024 then
     LTerm.fprint term string

test/dune

@@ -0,0 +1,4 @@
+(test
+ (name test_lib)
+ (modes byte)
+ (libraries alcotest utop))

test/test_lib.ml

@@ -0,0 +1,13 @@
+let test_fix_string =
+  let test ~name input ~expected =
+    (name, `Quick, fun () ->
+       let got = UTop.Private.fix_string input in
+       Alcotest.check Alcotest.string __LOC__ expected got
+    )
+  in
+  ( "fix_string"
+  , [ test ~name:"small" "x" ~expected:"x"
+    ]
+  )
+
+let () = Alcotest.run "utop" [test_fix_string]

test/test_lib.mli

@@ -0,0 +1 @@
+(* empty *)

utop.opam

@@ -22,6 +22,7 @@ depends: [
   "zed" {>= "3.2.0"}
   "react" {>= "1.0.0"}
   "cppo" {>= "1.1.2"}
+  "alcotest" {with-test}
 ]
 build: [
   ["dune" "subst"] {pinned}