7e1dd4e · text · git.iko.soy

git.iko.soy/text

Get UTF-16LE tested and working.

--HG-- extra : convert_revision : 1fd996f7df5243365ea5c24cdee0359df76c46b9

commit7e1dd4e4cf793963fe5a78d7aba13f8456d05b9b authorBryan O'Sullivan <bos@serpentine.com> dateTue 24 Feb 2009, 05:47 (18 years ago) parent8b0a14b

3 files changed+29−13

compare with master

unifiedsplit

Data/Text/Encoding/Fusion.hs+12−10 Data/Text/Utf16.hs+1−1 tests/Properties.hs+16−2

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

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

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

103103 | otherwise = encodingError "UTF-16LE"

104104 where

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

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

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

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

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

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

109109

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

225225

226226restreamUtf16LE :: Stream Char -> Stream Word8

227227restreamUtf16LE (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)

229229 where

230230 {-# 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

232232 Done -> Done

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

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

234234 Yield x xs

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

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

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

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

237+ | otherwise -> Yield c1 $

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

237239 where

238240 n = ord x

239241 n1 = n - 0x10000

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

242244 n2 = n1 .&. 0x3FF

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

244246 c3 = fromIntegral n2

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

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

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

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

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

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

248250 next _ = internalError "restreamUtf16LE"

249251{-# INLINE restreamUtf16LE #-}

250252

Data/Text/Utf16.hs+1−1

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

3333{-# INLINE chr2 #-}

3434

3535validate1 :: Word16 -> Bool

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

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

3737{-# INLINE validate1 #-}

3838

3939validate2 :: Word16 -> Word16 -> Bool

tests/Properties.hs+16−2

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

1515import qualified Data.Text as T

1616import Data.Text (pack,unpack)

1717import qualified Data.Text.Encoding as E

18+import Control.Exception

1819import qualified Data.Text.Fusion as S

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

2021import qualified Data.List as L

22+import System.IO.Unsafe

23+import Prelude hiding (catch)

2124

2225import QuickCheckUtils

2326

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+

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

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

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

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

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

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

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

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

3245

3346-- Do two functions give the same answer?

3447eq :: (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

3649-- What about with the RHS packed?

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

3851eqP 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) &&

4558 m | l == 0 = n

4659 | otherwise = n `mod` l

4760 n = fromIntegral w

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

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

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

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

5164eqEP :: (Eq a) =>

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

219232

220233 ("prop_ascii", mytest prop_ascii),

221234 ("prop_utf8", mytest prop_utf8),

235+ ("prop_utf16LE", mytest prop_utf16LE),

222236

223237 ("prop_cons", mytest prop_cons),

224238 ("prop_snoc", mytest prop_snoc),