7e1dd4e · text · git.iko.soy

git.iko.soy/text

on master help sign in

Get UTF-16LE tested and working.

7e1dd4eBryan O'Sullivan18 years ago

Data/Text/Encoding/Fusion.hs+12−10

compare with master

unifiedsplit

@@ -102,8 +102,8 @@ streamUtf16LE bs = Stream next 0 l

102 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)

103 | otherwise = encodingError "UTF-16LE"

104 where

105− x1 = (shiftL (idx (i + 1)) 8) + (idx i)

105+ x1 = (idx (i + 1) `shiftL` 8) + idx i

106− x2 = (shiftL (idx (i + 3)) 8) + (idx (i + 2))

106+ x2 = (idx (i + 3) `shiftL` 8) + idx (i + 2)

107 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16

108{-# INLINE [0] streamUtf16LE #-}

109

@@ -225,15 +225,17 @@ restreamUtf16BE (Stream next0 s0 len) =

225

226restreamUtf16LE :: Stream Char -> Stream Word8

227restreamUtf16LE (Stream next0 s0 len) =

228− Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)

228+ Stream next (T4 s0 N N N) (len*2)

229 where

230 {-# INLINE next #-}

231− next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of

231+ next (T4 s N N N) = case next0 s of

232 Done -> Done

233− Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)

233+ Skip s' -> Skip (T4 s' N N N)

234 Yield x xs

235− | n < 0x10000 -> Yield (fromIntegral n) (T4 (Just xs) (Just (fromIntegral $ shiftR n 8)) Nothing Nothing)

235+ | n < 0x10000 -> Yield (fromIntegral n) $

236+ T4 xs (J (fromIntegral $ shiftR n 8)) N N

236− | otherwise -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just c4))

237+ | otherwise -> Yield c1 $

238+ T4 xs (J c2) (J c3) (J c4)

237 where

239 where

238 n = ord x

240 n = ord x

239 n1 = n - 0x10000

241 n1 = n - 0x10000

@@ -242,9 +244,9 @@ restreamUtf16LE (Stream next0 s0 len) =

242 n2 = n1 .&. 0x3FF

244 n2 = n1 .&. 0x3FF

243 c4 = fromIntegral (shiftR n2 8 + 0xDC)

245 c4 = fromIntegral (shiftR n2 8 + 0xDC)

244 c3 = fromIntegral n2

246 c3 = fromIntegral n2

245− next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)

247+ next (T4 s (J x2) N N) = Yield x2 (T4 s N N N)

246− next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)

248+ next (T4 s (J x2) x3 N) = Yield x2 (T4 s x3 N N)

247− next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)

249+ next (T4 s (J x2) x3 x4) = Yield x2 (T4 s x3 x4 N)

248 next _ = internalError "restreamUtf16LE"

250 next _ = internalError "restreamUtf16LE"

249{-# INLINE restreamUtf16LE #-}

251{-# INLINE restreamUtf16LE #-}

250

252

Data/Text/Utf16.hs+1−1

@@ -33,7 +33,7 @@ chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))

33{-# INLINE chr2 #-}

35validate1 :: Word16 -> Bool

36−validate1 x1 = (x1 >= 0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 < 0x10000)

36+validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF

37{-# INLINE validate1 #-}

39validate2 :: Word16 -> Word16 -> Bool

tests/Properties.hs+16−2

@@ -15,12 +15,24 @@ import qualified Data.ByteString as B

15import qualified Data.Text as T

16import Data.Text (pack,unpack)

17import qualified Data.Text.Encoding as E

18+import Control.Exception

18import qualified Data.Text.Fusion as S

19import qualified Data.Text.Fusion as S

19import Data.Text.Fusion (stream, unstream)

20import Data.Text.Fusion (stream, unstream)

20import qualified Data.List as L

21import qualified Data.List as L

22+import System.IO.Unsafe

23+import Prelude hiding (catch)

22import QuickCheckUtils

25import QuickCheckUtils

27+-- If a pure property threatens to crash, wrap it with this to keep

28+-- QuickCheck from bombing out.

29+crashy :: a -> a -> a

30+{-# NOINLINE crashy #-}

31+crashy onException p = unsafePerformIO $

32+ (return $! p) `catch` \e ->

33+ let types = e :: SomeException

34+ in trace ("*** Exception: " ++ show e) return onException

35+

24prop_pack_unpack s = (unpack . pack) s == s

36prop_pack_unpack s = (unpack . pack) s == s

25prop_stream_unstream t = (unstream . stream) t == t

37prop_stream_unstream t = (unstream . stream) t == t

26prop_reverse_stream t = (S.reverse . S.reverseStream) t == t

38prop_reverse_stream t = (S.reverse . S.reverseStream) t == t

@@ -29,10 +41,11 @@ prop_singleton c = [c] == (unpack . T.singleton) c

29prop_ascii t = E.decodeASCII (E.encodeASCII a) == a

41prop_ascii t = E.decodeASCII (E.encodeASCII a) == a

30 where a = T.map (\c -> chr (ord c `mod` 128)) t

42 where a = T.map (\c -> chr (ord c `mod` 128)) t

31prop_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id

43prop_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id

44+prop_utf16LE = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id

33-- Do two functions give the same answer?

46-- Do two functions give the same answer?

34eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool

47eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool

35−eq a b s = a s == b s

48+eq a b s = crashy False $ a s == b s

36-- What about with the RHS packed?

49-- What about with the RHS packed?

37eqP :: (Eq a, Show a) => (String -> a) -> (T.Text -> a) -> String -> Word8 -> Bool

50eqP :: (Eq a, Show a) => (String -> a) -> (T.Text -> a) -> String -> Word8 -> Bool

38eqP a b s w = eq "orig" (a s) (b t) &&

51eqP a b s w = eq "orig" (a s) (b t) &&

@@ -45,7 +58,7 @@ eqP a b s w = eq "orig" (a s) (b t) &&

45 m | l == 0 = n

58 m | l == 0 = n

46 | otherwise = n `mod` l

59 | otherwise = n `mod` l

47 n = fromIntegral w

60 n = fromIntegral w

48− eq s a b | a == b = True

61+ eq s a b | crashy False $ a == b = True

49 | otherwise = trace (s ++ ": " ++ show a ++ " /= " ++ show b) False

62 | otherwise = trace (s ++ ": " ++ show a ++ " /= " ++ show b) False

50-- Or with the string non-empty, and the RHS packed?

63-- Or with the string non-empty, and the RHS packed?

51eqEP :: (Eq a) =>

64eqEP :: (Eq a) =>

@@ -219,6 +232,7 @@ tests = [

219

232

220 ("prop_ascii", mytest prop_ascii),

233 ("prop_ascii", mytest prop_ascii),

221 ("prop_utf8", mytest prop_utf8),

234 ("prop_utf8", mytest prop_utf8),

235+ ("prop_utf16LE", mytest prop_utf16LE),

222

236

223 ("prop_cons", mytest prop_cons),

237 ("prop_cons", mytest prop_cons),

224 ("prop_snoc", mytest prop_snoc),

238 ("prop_snoc", mytest prop_snoc),