Index: test/test_bd_UTF8_001.ml =================================================================== --- test/test_bd_UTF8_001.ml (revision 0) +++ test/test_bd_UTF8_001.ml (revision 0) @@ -0,0 +1,115 @@ +let substring_inputs = +[ + [| + ""; + "⟿"; + "⟿ቄ"; + "⟿ቄş"; + "⟿ቄş龟"; + "⟿ቄş龟¯"; + |]; + [| + ""; + "ç"; + "çe"; + "çek"; + "çeko"; + "çekos"; + "çekosl"; + "çekoslo"; + "çekoslov"; + "çekoslova"; + "çekoslovak"; + "çekoslovaky"; + "çekoslovakya"; + "çekoslovakyal"; + "çekoslovakyala"; + "çekoslovakyalaş"; + "çekoslovakyalaşt"; + "çekoslovakyalaştı"; + "çekoslovakyalaştır"; + "çekoslovakyalaştıra"; + "çekoslovakyalaştıram"; + "çekoslovakyalaştırama"; + "çekoslovakyalaştıramad"; + "çekoslovakyalaştıramadı"; + "çekoslovakyalaştıramadık"; + "çekoslovakyalaştıramadıkl"; + "çekoslovakyalaştıramadıkla"; + "çekoslovakyalaştıramadıklar"; + "çekoslovakyalaştıramadıkları"; + "çekoslovakyalaştıramadıklarım"; + "çekoslovakyalaştıramadıklarımı"; + "çekoslovakyalaştıramadıklarımız"; + "çekoslovakyalaştıramadıklarımızd"; + "çekoslovakyalaştıramadıklarımızda"; + "çekoslovakyalaştıramadıklarımızdan"; + "çekoslovakyalaştıramadıklarımızdanm"; + "çekoslovakyalaştıramadıklarımızdanmı"; + "çekoslovakyalaştıramadıklarımızdanmıs"; + "çekoslovakyalaştıramadıklarımızdanmısı"; + "çekoslovakyalaştıramadıklarımızdanmısın"; + "çekoslovakyalaştıramadıklarımızdanmısını"; + "çekoslovakyalaştıramadıklarımızdanmısınız"; + |] +] + +let test_substring () = + let test a = + let m = Array.length a - 1 in + let v = a.(m) in + assert(UTF8.length v = m); + for i = 0 to m do + assert(a.(i) = UTF8.substring v 0 i); + done; + for i = 0 to m - 1 do + for j = i to m - 1 do + let u = UTF8.substring v i (j - i + 1) in + UTF8.validate u + done + done + in + List.iter test substring_inputs + +let split_inputs = [ + "", []; + "de ne me", ["de";"ne";"me"]; + "yoğurtun tadı ılık iken pek güzel olmaz", ["yoğurtun";"tadı";"ılık";"iken";"pek";"güzel";"olmaz"] +] + +let split_at f u = + let m = UTF8.eof u in + let b = UTF8.Buf.create m in + let rec loop0 r i = + if i >= m then + List.rev r + else + if f (UTF8.look u i) then + loop0 r (UTF8.next u i) + else + loop1 r i + and loop1 r i = + if i = m || f (UTF8.look u i) then + begin + let x = UTF8.Buf.contents b in + UTF8.Buf.clear b; + loop0 (x::r) (UTF8.next u i) + end + else + begin + UTF8.Buf.add_char b (UTF8.look u i); + loop1 r (UTF8.next u i) + end + in + loop0 [] 0 + +let test_split () = + List.iter + (fun (u, ul) -> + let space = UChar.of_char ' ' in + assert(ul = split_at ((=) space) u)) + split_inputs + +let test () = + Util.run_test ~test_name:"bd_UTF.substring" test_substring; + Util.run_test ~test_name:"bd_UTF.split" test_split Index: extlib/uTF8.mli =================================================================== --- extlib/uTF8.mli (revision 381) +++ extlib/uTF8.mli (working copy) @@ -62,10 +62,18 @@ (** The position of the head of the last Unicode character. *) val last : t -> index +(** The (invalid) position of the head after the last Unicode character. + [next (last u i) = eof i] *) +val eof : t -> index + (** [look s i] returns the Unicode character of the location [i] in the string [s]. *) val look : t -> index -> uchar +(** [substring s i m] returns the substring made of the Unicode locations [i] to [i + m - 1] inclusive. + The string is always copied *) +val substring : t -> int -> int -> t + (** [out_of_range s i] tests whether [i] is a position inside of [s]. *) val out_of_range : t -> index -> bool @@ -113,6 +121,9 @@ a negative integer if [s1] < [s2]. *) val compare : t -> t -> int +(** Output the given char in UTF8 format over a binary channel *) +val output_uchar : out_channel -> uchar -> unit + (** Buffer module for UTF-8 strings *) module Buf : sig (** Buffers for UTF-8 strings. *) Index: extlib/uTF8.ml =================================================================== --- extlib/uTF8.ml (revision 381) +++ extlib/uTF8.ml (working copy) @@ -76,6 +76,7 @@ search_head s (i + 1) let next s i = + if i >= String.length s then i else let n = Char.code s.[i] in if n < 0x80 then i + 1 else if n < 0xc0 then search_head s (i + 1) else @@ -108,14 +109,56 @@ let nth s n = nth_aux s 0 n +let substring s i n = + let j = nth s i in + let j' = (nth_aux s j n) - 1 in + String.sub s j (j' - j + 1) + let last s = search_head_backward s (String.length s - 1) +let eof s = String.length s + let out_of_range s i = i < 0 || i >= String.length s let compare_index _ i j = i - j let get s n = look s (nth s n) +let generic_output_uchar f oc u = + let masq = 0b111111 in + let f = f oc in + let k = int_of_uchar u in + if k < 0 || k >= 0x4000000 then begin + f (0xfc + (k lsr 30)); + f (0x80 lor ((k lsr 24) land masq)); + f (0x80 lor ((k lsr 18) land masq)); + f (0x80 lor ((k lsr 12) land masq)); + f (0x80 lor ((k lsr 6) land masq)); + f (0x80 lor (k land masq)) + end else if k <= 0x7f then + f k + else if k <= 0x7ff then begin + f (0xc0 lor (k lsr 6)); + f (0x80 lor (k land masq)) + end else if k <= 0xffff then begin + f (0xe0 lor (k lsr 12)); + f (0x80 lor ((k lsr 6) land masq)); + f (0x80 lor (k land masq)) + end else if k <= 0x1fffff then begin + f (0xf0 + (k lsr 18)); + f (0x80 lor ((k lsr 12) land masq)); + f (0x80 lor ((k lsr 6) land masq)); + f (0x80 lor (k land masq)) + end else begin + f (0xf8 + (k lsr 24)); + f (0x80 lor ((k lsr 18) land masq)); + f (0x80 lor ((k lsr 12) land masq)); + f (0x80 lor ((k lsr 6) land masq)); + f (0x80 lor (k land masq)) + end + +let output_uchar oc u = generic_output_uchar output_byte oc u + let add_uchar buf u = let masq = 0b111111 in let k = int_of_uchar u in