git.iko.soy/text
on master help sign in
Test ASCII and UTF-8 encoding roundtripping

--HG-- extra : convert_revision : b476a0d78f1cbf0f23abbbf1f05a0eeed6d919b4

commitfd39f6f7c73eecfbd5ab68786829c05074e5ce93 authorBryan O'Sullivan <bos@serpentine.com> dateMon 23 Feb 2009, 03:26 (18 years ago) parent112f417
4 files changed+57−40
compare with master
unifiedsplit
Data/Text/Encoding/Fusion.hs+17−21 Data/Text/Utf8.hs+16−13 tests/Properties.hs+13−4 tests/QuickCheckUtils.hs+11−2
Data/Text/Encoding/Fusion.hs+17−21
@@ -56,7 +56,7 @@ import qualified Data.Text.Utf16 as U16
5656import qualified Data.Text.Utf32 as U32
5757import qualified Data.Text.Utf8 as U8
5858
59−data T4 a b c d = T4 !a !b !c !d
59+data T4 a b c d = T4 {-# UNPACK #-} !a {-# UNPACK #-} !b {-# UNPACK #-} !c {-# UNPACK #-} !d
6060
6161streamASCII :: ByteString -> Stream Char
6262streamASCII bs = Stream next 0 l
@@ -169,36 +169,32 @@ restreamASCII (Stream next0 s0 len) = Stream next s0 (len*2)
169169 where x' = fromIntegral (ord x) :: Word8
170170{-# INLINE restreamASCII #-}
171171
172+data M = N | J {-# UNPACK #-} !Word8
173+ deriving (Eq, Ord, Show)
174+
172175-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
173176restreamUtf8 :: Stream Char -> Stream Word8
174177restreamUtf8 (Stream next0 s0 len) =
175− Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
178+ Stream next (T4 s0 N N N) (len*2)
176179 where
177180 {-# INLINE next #-}
178− next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
181+ next (T4 s N N N) = case next0 s of
179182 Done -> Done
180− Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
183+ Skip s' -> Skip (T4 s' N N N)
181184 Yield x xs
182− | n <= 0x7F -> Yield c (T4 (Just xs) Nothing Nothing Nothing)
183− | n <= 0x07FF -> Yield (fst c2) (T4 (Just xs) (Just $ snd c2) Nothing Nothing)
184− | n <= 0xFFFF -> Yield (fst3 c3) (T4 (Just xs) (Just $ snd3 c3) (Just $ trd3 c3) Nothing)
185− | otherwise -> Yield (fst4 c4) (T4 (Just xs) (Just $ snd4 c4) (Just $ trd4 c4) (Just $ fth4 c4))
185+ | n <= 0x7F -> Yield c (T4 xs N N N)
186+ | n <= 0x07FF -> Yield a2 (T4 xs (J b2) N N)
187+ | n <= 0xFFFF -> Yield a3 (T4 xs (J b3) (J c3) N)
188+ | otherwise -> Yield a4 (T4 xs (J b4) (J c4) (J d4))
186189 where
187190 n = ord x
188191 c = fromIntegral n
189− c2 = U8.ord2 x
190− c3 = U8.ord3 x
191− c4 = U8.ord4 x
192− fst3 (x1,_,_) = x1
193− snd3 (_,x2,_) = x2
194− trd3 (_,_,x3) = x3
195− fst4 (x1,_,_,_) = x1
196− snd4 (_,x2,_,_) = x2
197− trd4 (_,_,x3,_) = x3
198− fth4 (_,_,_,x4) = x4
199− next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
200− next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
201− next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
192+ (a2,b2) = U8.ord2 x
193+ (a3,b3,c3) = U8.ord3 x
194+ (a4,b4,c4,d4) = U8.ord4 x
195+ next (T4 s (J x2) N N) = Yield x2 (T4 s N N N)
196+ next (T4 s (J x2) x3 N) = Yield x2 (T4 s x3 N N)
197+ next (T4 s (J x2) x3 x4) = Yield x2 (T4 s x3 x4 N)
202198 next _ = internalError "restreamUtf8"
203199{-# INLINE restreamUtf8 #-}
204200
Data/Text/Utf8.hs+16−13
@@ -30,11 +30,14 @@ module Data.Text.Utf8
3030 , validate4
3131 ) where
3232
33+import Control.Exception (assert)
3334import Data.Char (ord)
3435import Data.Bits (shiftR, (.&.))
3536import GHC.Exts
3637import GHC.Word (Word8(..))
3738
39+default(Int)
40+
3841between :: Word8 -- ^ byte to check
3942 -> Word8 -- ^ lower bound
4043 -> Word8 -- ^ upper bound
@@ -43,28 +46,28 @@ between x y z = x >= y && x <= z
4346{-# INLINE between #-}
4447
4548ord2 :: Char -> (Word8,Word8)
46−ord2 c = (x1,x2)
49+ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)
4750 where
4851 n = ord c
49− x1 = fromIntegral $ (shiftR n 6) + (0xC0 :: Int) :: Word8
50− x2 = fromIntegral $ (n .&. 0x3F) + (0x80 :: Int) :: Word8
52+ x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
53+ x2 = fromIntegral $ (n .&. 0x3F) + 0x80
5154
5255ord3 :: Char -> (Word8,Word8,Word8)
53−ord3 c = (x1,x2,x3)
56+ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)
5457 where
5558 n = ord c
56− x1 = fromIntegral $ (shiftR n 12) + (0xE0::Int) :: Word8
57− x2 = fromIntegral $ ((shiftR n 6) .&. (0x3F::Int)) + (0x80::Int) :: Word8
58− x3 = fromIntegral $ (n .&. (0x3F::Int)) + (0x80::Int) :: Word8
59+ x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
60+ x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
61+ x3 = fromIntegral $ (n .&. 0x3F) + 0x80
5962
6063ord4 :: Char -> (Word8,Word8,Word8,Word8)
61−ord4 c = (x1,x2,x3,x4)
64+ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)
6265 where
6366 n = ord c
64− x1 = fromIntegral $ (shiftR n 18) + (0xF0::Int) :: Word8
65− x2 = fromIntegral $ ((shiftR n 12) .&. (0x3F::Int)) + (0x80::Int) :: Word8
66− x3 = fromIntegral $ ((shiftR n 6) .&. (0x3F::Int)) + (0x80::Int) :: Word8
67− x4 = fromIntegral $ (n .&. (0x3F::Int)) + (0x80::Int) :: Word8
67+ x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
68+ x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
69+ x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
70+ x4 = fromIntegral $ (n .&. 0x3F) + 0x80
6871
6972chr2 :: Word8 -> Word8 -> Char
7073chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
@@ -72,7 +75,7 @@ chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
7275 y1# = word2Int# x1#
7376 y2# = word2Int# x2#
7477 z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
75− z2# = y2# -# 0x8F#
78+ z2# = y2# -# 0x80#
7679{-# INLINE chr2 #-}
7780
7881chr3 :: Word8 -> Word8 -> Word8 -> Char
tests/Properties.hs+13−4
@@ -3,6 +3,7 @@
33import Test.QuickCheck
44import Text.Show.Functions
55
6+import Data.Char
67import Debug.Trace
78import Text.Printf
89import System.Environment
@@ -10,19 +11,24 @@ import Control.Applicative
1011import Control.Arrow
1112import Control.Monad
1213import Data.Word
14+import qualified Data.ByteString as B
1315import qualified Data.Text as T
1416import Data.Text (pack,unpack)
17+import qualified Data.Text.Encoding as E
1518import qualified Data.Text.Fusion as S
1619import Data.Text.Fusion (stream, unstream)
1720import qualified Data.List as L
1821
19−
2022import QuickCheckUtils
2123
22−prop_pack_unpack s = (unpack . pack) s == s
24+prop_pack_unpack s = (unpack . pack) s == s
2325prop_stream_unstream t = (unstream . stream) t == t
24−prop_reverse_stream t = (S.reverse . S.reverseStream) t == t
25−prop_singleton c = [c] == (unpack . T.singleton) c
26+prop_reverse_stream t = (S.reverse . S.reverseStream) t == t
27+prop_singleton c = [c] == (unpack . T.singleton) c
28+
29+prop_ascii t = E.decodeASCII (E.encodeASCII a) == a
30+ where a = T.map (\c -> chr (ord c `mod` 128)) t
31+prop_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id
2632
2733-- Do two functions give the same answer?
2834eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool
@@ -211,6 +217,9 @@ tests = [
211217 ("prop_reverse_stream", mytest prop_reverse_stream),
212218 ("prop_singleton", mytest prop_singleton),
213219
220+ ("prop_ascii", mytest prop_ascii),
221+ ("prop_utf8", mytest prop_utf8),
222+
214223 ("prop_cons", mytest prop_cons),
215224 ("prop_snoc", mytest prop_snoc),
216225 ("prop_append", mytest prop_append),
tests/QuickCheckUtils.hs+11−2
@@ -8,6 +8,7 @@ import qualified Data.Text as T
88import System.IO
99import System.Random
1010import Test.QuickCheck
11+import qualified Data.ByteString as B
1112
1213integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
1314integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
@@ -15,13 +16,17 @@ integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
1516 (x,g) -> (fromIntegral x, g)
1617
1718instance Random Word8 where
18− randomR = integralRandomR
19− random = randomR (minBound,maxBound)
19+ randomR = integralRandomR
20+ random = randomR (minBound,maxBound)
2021
2122instance Arbitrary Word8 where
2223 arbitrary = choose (minBound,maxBound)
2324 coarbitrary c = variant (fromEnum c `rem` 4)
2425
26+instance Arbitrary B.ByteString where
27+ arbitrary = B.pack `fmap` arbitrary
28+ coarbitrary s = coarbitrary (B.unpack s)
29+
2530instance Random Word16 where
2631 randomR = integralRandomR
2732 random = randomR (minBound,maxBound)
@@ -52,6 +57,10 @@ instance Arbitrary (NotEmpty T.Text) where
5257 arbitrary = (fmap T.pack) `fmap` arbitrary
5358 coarbitrary = coarbitrary . notEmpty
5459
60+instance Arbitrary (NotEmpty B.ByteString) where
61+ arbitrary = (fmap B.pack) `fmap` arbitrary
62+ coarbitrary = coarbitrary . notEmpty
63+
5564debug = False
5665
5766mytest :: Testable a => a -> Int -> IO (Bool, Int)