Commits

Bryan O'Sullivan committed f06e804

Get UTF-16LE tested and working.

  • Participants
  • Parent commits 9b8776d

Comments (0)

Files changed (3)

File Data/Text/Encoding/Fusion.hs

           | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
           | otherwise = encodingError "UTF-16LE"
           where
-            x1    = (shiftL (idx (i + 1)) 8) + (idx i)
-            x2    = (shiftL (idx (i + 3)) 8) + (idx (i + 2))
+            x1    = (idx (i + 1) `shiftL` 8) + idx i
+            x2    = (idx (i + 3) `shiftL` 8) + idx (i + 2)
             idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16
 {-# INLINE [0] streamUtf16LE #-}
 
 
 restreamUtf16LE :: Stream Char -> Stream Word8
 restreamUtf16LE (Stream next0 s0 len) =
-    Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
+    Stream next (T4 s0 N N N) (len*2)
     where
       {-# INLINE next #-}
-      next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
+      next (T4 s N N N) = case next0 s of
           Done -> Done
-          Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
+          Skip s' -> Skip (T4 s' N N N)
           Yield x xs
-              | n < 0x10000 -> Yield (fromIntegral n) (T4 (Just xs) (Just (fromIntegral $ shiftR n 8)) Nothing Nothing)
-              | otherwise   -> Yield c1                          (T4 (Just xs) (Just c2) (Just c3) (Just c4))
+              | n < 0x10000 -> Yield (fromIntegral n) $
+                               T4 xs (J (fromIntegral $ shiftR n 8)) N N
+              | otherwise   -> Yield c1 $
+                               T4 xs (J c2) (J c3) (J c4)
               where
                 n  = ord x
                 n1 = n - 0x10000
                 n2 = n1 .&. 0x3FF
                 c4 = fromIntegral (shiftR n2 8 + 0xDC)
                 c3 = fromIntegral n2
-      next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
-      next (T4 (Just s) (Just x2) x3 Nothing)      = Yield x2 (T4 (Just s) x3 Nothing Nothing)
-      next (T4 (Just s) (Just x2) x3 x4)           = Yield x2 (T4 (Just s) x3 x4 Nothing)
+      next (T4 s (J x2) N N)   = Yield x2 (T4 s N N N)
+      next (T4 s (J x2) x3 N)  = Yield x2 (T4 s x3 N N)
+      next (T4 s (J x2) x3 x4) = Yield x2 (T4 s x3 x4 N)
       next _ = internalError "restreamUtf16LE"
 {-# INLINE restreamUtf16LE #-}
 

File Data/Text/Utf16.hs

 {-# INLINE chr2 #-}
 
 validate1    :: Word16 -> Bool
-validate1 x1 = (x1 >= 0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 < 0x10000)
+validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF
 {-# INLINE validate1 #-}
 
 validate2       ::  Word16 -> Word16 -> Bool

File tests/Properties.hs

 import qualified Data.Text as T
 import Data.Text (pack,unpack)
 import qualified Data.Text.Encoding as E
+import Control.Exception
 import qualified Data.Text.Fusion as S
 import Data.Text.Fusion (stream, unstream)
 import qualified Data.List as L
+import System.IO.Unsafe
+import Prelude hiding (catch)
 
 import QuickCheckUtils
 
+-- If a pure property threatens to crash, wrap it with this to keep
+-- QuickCheck from bombing out.
+crashy :: a -> a -> a
+{-# NOINLINE crashy #-}
+crashy onException p = unsafePerformIO $
+    (return $! p) `catch` \e ->
+    let types = e :: SomeException
+    in trace ("*** Exception: " ++ show e) return onException
+
 prop_pack_unpack s     = (unpack . pack) s == s
 prop_stream_unstream t = (unstream . stream) t == t
 prop_reverse_stream t  = (S.reverse . S.reverseStream) t == t
 prop_ascii t           = E.decodeASCII (E.encodeASCII a) == a
     where a            = T.map (\c -> chr (ord c `mod` 128)) t
 prop_utf8              = (E.decodeUtf8 . E.encodeUtf8) `eq` id
+prop_utf16LE           = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id
 
 -- Do two functions give the same answer?
 eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool
-eq a b s  = a s == b s
+eq a b s  = crashy False $ a s == b s
 -- What about with the RHS packed?
 eqP :: (Eq a, Show a) => (String -> a) -> (T.Text -> a) -> String -> Word8 -> Bool
 eqP a b s w  = eq "orig" (a s) (b t) &&
           m | l == 0    = n
             | otherwise = n `mod` l
           n             = fromIntegral w
-          eq s a b | a == b = True
+          eq s a b | crashy False $ a == b = True
                    | otherwise = trace (s ++ ": " ++ show a ++ " /= " ++ show b) False
 -- Or with the string non-empty, and the RHS packed?
 eqEP :: (Eq a) =>
 
   ("prop_ascii", mytest prop_ascii),
   ("prop_utf8", mytest prop_utf8),
+  ("prop_utf16LE", mytest prop_utf16LE),
 
   ("prop_cons", mytest prop_cons),
   ("prop_snoc", mytest prop_snoc),