fd39f6f · text · git.iko.soy

git.iko.soy/text

on master help sign in

Test ASCII and UTF-8 encoding roundtripping

fd39f6fBryan O'Sullivan18 years ago

Data/Text/Encoding/Fusion.hs+17−21

compare with master

unifiedsplit

@@ -56,7 +56,7 @@ import qualified Data.Text.Utf16 as U16

56import qualified Data.Text.Utf32 as U32

57import qualified Data.Text.Utf8 as U8

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

61streamASCII :: ByteString -> Stream Char

62streamASCII bs = Stream next 0 l

@@ -169,36 +169,32 @@ restreamASCII (Stream next0 s0 len) = Stream next s0 (len*2)

169 where x' = fromIntegral (ord x) :: Word8

170{-# INLINE restreamASCII #-}

171

172+data M = N | J {-# UNPACK #-} !Word8

173+ deriving (Eq, Ord, Show)

174+

172-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.

175-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.

173restreamUtf8 :: Stream Char -> Stream Word8

176restreamUtf8 :: Stream Char -> Stream Word8

174restreamUtf8 (Stream next0 s0 len) =

177restreamUtf8 (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)

176 where

179 where

177 {-# INLINE next #-}

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

179 Done -> Done

182 Done -> Done

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

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

181 Yield x xs

184 Yield x xs

182− | n <= 0x7F -> Yield c (T4 (Just xs) Nothing Nothing Nothing)

185+ | n <= 0x7F -> Yield c (T4 xs N N N)

183− | n <= 0x07FF -> Yield (fst c2) (T4 (Just xs) (Just $ snd c2) Nothing Nothing)

186+ | n <= 0x07FF -> Yield a2 (T4 xs (J b2) N N)

184− | n <= 0xFFFF -> Yield (fst3 c3) (T4 (Just xs) (Just $ snd3 c3) (Just $ trd3 c3) Nothing)

187+ | n <= 0xFFFF -> Yield a3 (T4 xs (J b3) (J c3) N)

185− | otherwise -> Yield (fst4 c4) (T4 (Just xs) (Just $ snd4 c4) (Just $ trd4 c4) (Just $ fth4 c4))

188+ | otherwise -> Yield a4 (T4 xs (J b4) (J c4) (J d4))

186 where

189 where

187 n = ord x

190 n = ord x

188 c = fromIntegral n

191 c = fromIntegral n

189− c2 = U8.ord2 x

192+ (a2,b2) = U8.ord2 x

190− c3 = U8.ord3 x

193+ (a3,b3,c3) = U8.ord3 x

191− c4 = U8.ord4 x

194+ (a4,b4,c4,d4) = 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)

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

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

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

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

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

202 next _ = internalError "restreamUtf8"

198 next _ = internalError "restreamUtf8"

203{-# INLINE restreamUtf8 #-}

199{-# INLINE restreamUtf8 #-}

204

200

Data/Text/Utf8.hs+16−13

@@ -30,11 +30,14 @@ module Data.Text.Utf8

30 , validate4

31 ) where

33+import Control.Exception (assert)

33import Data.Char (ord)

34import Data.Char (ord)

34import Data.Bits (shiftR, (.&.))

35import Data.Bits (shiftR, (.&.))

35import GHC.Exts

36import GHC.Exts

36import GHC.Word (Word8(..))

37import GHC.Word (Word8(..))

39+default(Int)

40+

38between :: Word8 -- ^ byte to check

41between :: Word8 -- ^ byte to check

39 -> Word8 -- ^ lower bound

42 -> Word8 -- ^ lower bound

40 -> Word8 -- ^ upper bound

43 -> Word8 -- ^ upper bound

@@ -43,28 +46,28 @@ between x y z = x >= y && x <= z

43{-# INLINE between #-}

46{-# INLINE between #-}

45ord2 :: Char -> (Word8,Word8)

48ord2 :: Char -> (Word8,Word8)

46−ord2 c = (x1,x2)

49+ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)

47 where

50 where

48 n = ord c

51 n = ord c

49− x1 = fromIntegral $ (shiftR n 6) + (0xC0 :: Int) :: Word8

52+ x1 = fromIntegral $ (n `shiftR` 6) + 0xC0

50− x2 = fromIntegral $ (n .&. 0x3F) + (0x80 :: Int) :: Word8

53+ x2 = fromIntegral $ (n .&. 0x3F) + 0x80

52ord3 :: Char -> (Word8,Word8,Word8)

55ord3 :: Char -> (Word8,Word8,Word8)

53−ord3 c = (x1,x2,x3)

56+ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)

54 where

57 where

55 n = ord c

58 n = ord c

56− x1 = fromIntegral $ (shiftR n 12) + (0xE0::Int) :: Word8

59+ x1 = fromIntegral $ (n `shiftR` 12) + 0xE0

57− x2 = fromIntegral $ ((shiftR n 6) .&. (0x3F::Int)) + (0x80::Int) :: Word8

60+ x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

58− x3 = fromIntegral $ (n .&. (0x3F::Int)) + (0x80::Int) :: Word8

61+ x3 = fromIntegral $ (n .&. 0x3F) + 0x80

60ord4 :: Char -> (Word8,Word8,Word8,Word8)

63ord4 :: Char -> (Word8,Word8,Word8,Word8)

61−ord4 c = (x1,x2,x3,x4)

64+ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)

62 where

65 where

63 n = ord c

66 n = ord c

64− x1 = fromIntegral $ (shiftR n 18) + (0xF0::Int) :: Word8

67+ x1 = fromIntegral $ (n `shiftR` 18) + 0xF0

65− x2 = fromIntegral $ ((shiftR n 12) .&. (0x3F::Int)) + (0x80::Int) :: Word8

68+ x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80

66− x3 = fromIntegral $ ((shiftR n 6) .&. (0x3F::Int)) + (0x80::Int) :: Word8

69+ x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

67− x4 = fromIntegral $ (n .&. (0x3F::Int)) + (0x80::Int) :: Word8

70+ x4 = fromIntegral $ (n .&. 0x3F) + 0x80

69chr2 :: Word8 -> Word8 -> Char

72chr2 :: Word8 -> Word8 -> Char

70chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))

73chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))

@@ -72,7 +75,7 @@ chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))

72 y1# = word2Int# x1#

75 y1# = word2Int# x1#

73 y2# = word2Int# x2#

76 y2# = word2Int# x2#

74 z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#

77 z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#

75− z2# = y2# -# 0x8F#

78+ z2# = y2# -# 0x80#

76{-# INLINE chr2 #-}

79{-# INLINE chr2 #-}

78chr3 :: Word8 -> Word8 -> Word8 -> Char

81chr3 :: Word8 -> Word8 -> Word8 -> Char

tests/Properties.hs+13−4

@@ -3,6 +3,7 @@

3import Test.QuickCheck

4import Text.Show.Functions

6+import Data.Char

6import Debug.Trace

7import Debug.Trace

7import Text.Printf

8import Text.Printf

8import System.Environment

9import System.Environment

@@ -10,19 +11,24 @@ import Control.Applicative

10import Control.Arrow

11import Control.Arrow

11import Control.Monad

12import Control.Monad

12import Data.Word

13import Data.Word

14+import qualified Data.ByteString as B

13import qualified Data.Text as T

15import qualified Data.Text as T

14import Data.Text (pack,unpack)

16import Data.Text (pack,unpack)

17+import qualified Data.Text.Encoding as E

15import qualified Data.Text.Fusion as S

18import qualified Data.Text.Fusion as S

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

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

17import qualified Data.List as L

20import qualified Data.List as L

19−

20import QuickCheckUtils

22import QuickCheckUtils

22−prop_pack_unpack s = (unpack . pack) s == s

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

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

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

24−prop_reverse_stream t = (S.reverse . S.reverseStream) t == t

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

25−prop_singleton c = [c] == (unpack . T.singleton) c

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

27-- Do two functions give the same answer?

33-- Do two functions give the same answer?

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

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

@@ -211,6 +217,9 @@ tests = [

211 ("prop_reverse_stream", mytest prop_reverse_stream),

217 ("prop_reverse_stream", mytest prop_reverse_stream),

212 ("prop_singleton", mytest prop_singleton),

218 ("prop_singleton", mytest prop_singleton),

213

219

220+ ("prop_ascii", mytest prop_ascii),

221+ ("prop_utf8", mytest prop_utf8),

222+

214 ("prop_cons", mytest prop_cons),

223 ("prop_cons", mytest prop_cons),

215 ("prop_snoc", mytest prop_snoc),

224 ("prop_snoc", mytest prop_snoc),

216 ("prop_append", mytest prop_append),

225 ("prop_append", mytest prop_append),

tests/QuickCheckUtils.hs+11−2

@@ -8,6 +8,7 @@ import qualified Data.Text as T

8import System.IO

9import System.Random

10import Test.QuickCheck

11+import qualified Data.ByteString as B

12integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

13integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

13integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

14integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

@@ -15,13 +16,17 @@ integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

15 (x,g) -> (fromIntegral x, g)

16 (x,g) -> (fromIntegral x, g)

17instance Random Word8 where

18instance Random Word8 where

18− randomR = integralRandomR

19+ randomR = integralRandomR

19− random = randomR (minBound,maxBound)

20+ random = randomR (minBound,maxBound)

21instance Arbitrary Word8 where

22instance Arbitrary Word8 where

22 arbitrary = choose (minBound,maxBound)

23 arbitrary = choose (minBound,maxBound)

23 coarbitrary c = variant (fromEnum c `rem` 4)

24 coarbitrary c = variant (fromEnum c `rem` 4)

26+instance Arbitrary B.ByteString where

27+ arbitrary = B.pack `fmap` arbitrary

28+ coarbitrary s = coarbitrary (B.unpack s)

29+

25instance Random Word16 where

30instance Random Word16 where

26 randomR = integralRandomR

31 randomR = integralRandomR

27 random = randomR (minBound,maxBound)

32 random = randomR (minBound,maxBound)

@@ -52,6 +57,10 @@ instance Arbitrary (NotEmpty T.Text) where

52 arbitrary = (fmap T.pack) `fmap` arbitrary

57 arbitrary = (fmap T.pack) `fmap` arbitrary

53 coarbitrary = coarbitrary . notEmpty

58 coarbitrary = coarbitrary . notEmpty

60+instance Arbitrary (NotEmpty B.ByteString) where

61+ arbitrary = (fmap B.pack) `fmap` arbitrary

62+ coarbitrary = coarbitrary . notEmpty

63+

55debug = False

64debug = False

57mytest :: Testable a => a -> Int -> IO (Bool, Int)

66mytest :: Testable a => a -> Int -> IO (Bool, Int)