diff --git a/dune-project b/dune-project index 5e0c918..51d781b 100644 --- a/dune-project +++ b/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))) diff --git a/src/lib/uTop.ml b/src/lib/uTop.ml index b222ffc..1afc1c2 100644 --- a/src/lib/uTop.ml +++ b/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 diff --git a/src/lib/uTop.mli b/src/lib/uTop.mli index 3a86cbe..14c4053 100644 --- a/src/lib/uTop.mli +++ b/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 diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml index 6af1527..6b2620a 100644 --- a/src/lib/uTop_main.ml +++ b/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 diff --git a/test/dune b/test/dune new file mode 100644 index 0000000..69e4948 --- /dev/null +++ b/test/dune @@ -0,0 +1,4 @@ +(test + (name test_lib) + (modes byte) + (libraries alcotest utop)) diff --git a/test/test_lib.ml b/test/test_lib.ml new file mode 100644 index 0000000..8f6bbe2 --- /dev/null +++ b/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] diff --git a/test/test_lib.mli b/test/test_lib.mli new file mode 100644 index 0000000..e790aeb --- /dev/null +++ b/test/test_lib.mli @@ -0,0 +1 @@ +(* empty *) diff --git a/utop.opam b/utop.opam index 5c932c1..ad8b4b3 100644 --- a/utop.opam +++ b/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}