diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,8 +1,14 @@ Significant and compatibility-breaking changes. +Version 0.5.2: + - Fixed https://github.com/Quid2/flat/issues/28 that could cause an undetected overflow when decoding out of range Int/Word values + - Added UTF16Text and Data.ByteString.Short support for ghcjs + - Improved speed and accuracy of encoded Text size calculation (for encoding) + - [**breaking**] Removed `textBytes` from Flat.Encoder.Size (breaking but insignificant) + Version 0.5: - Compatibility with ghc 9.0.2 & 9.2.4 & 9.4.2 - - Compatibility with text-2.0 + - Compatibility with text-2.0 (GHC) - Fixed https://github.com/Quid2/flat/issues/23 that could cause an encoding failure for non byte aligned Arrays - Fixed https://github.com/Quid2/flat/pull/26 that could cause the decoder to read beyond the end of the decoding buffer (causing a SEGFAULT on ghcjs) - Merged https://github.com/Quid2/flat/pull/22 - fails correctly on invalid UTF-8 text diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -30,7 +30,7 @@ Use **flat** to encode: ```haskell -flat $ [North,South] +flat [North,South] -> "\149" ``` @@ -38,15 +38,15 @@ and **unflat** to decode: ```haskell -unflat (flat $ [North,South]) :: Decoded [Direction] +unflat (flat [North,South]) :: Decoded [Direction] -> Right [ North , South ] ``` -And thanks to Flat's bit-encoding, this little list fits in a single byte (rather than the five that would be required by a traditional byte encoding): +And thanks to Flat's bit-encoding, this list fits in 1 byte (rather than the 5 bytes that would be required by a traditional byte encoding): ```haskell -flatBits $ [North,South] +flatBits [North,South] -> "10010101" ``` @@ -70,7 +70,6 @@ * [Flat Format Specification](http://quid2.org/docs/Flat.pdf) - ### Installation Get the latest stable version from [hackage](https://hackage.haskell.org/package/flat). @@ -82,27 +81,22 @@ * [GHC](https://www.haskell.org/ghc/) 7.10.3 to 9.4.2 (x64) -* [GHCJS](https://github.com/ghcjs/ghcjs) - - * Note: versions of `flat` prior to 0.33 encode `Double` values incorrectly when they are not aligned with a byte boundary. - +* [GHCJS](https://github.com/ghcjs/ghcjs) version 8.6.0.1 (GHC 8.6.2) ### Known Bugs and Infelicities -* Data types with more than 512 constructors are currently unsupported +* Data types with more than 512 constructors are currently unsupported (but support could be easily added if necessary) * Longish compilation times - * `flat` relies more than other serialisation libraries on extensive inlining for its good performance, this unfortunately leads to longer compilation times. - - If you have many data types or very large ones this might become an issue. + * To improve performance, `flat` relies on extensive inlining. This unfortunately leads to longer compilation times. - A couple of good practices that will eliminate or mitigate this problem are: + If you have many data types or very large ones, you might want to: * During development, turn optimisations off (`stack --fast` or `-O0` in the cabal file). - * Keep your serialisation code in a separate module or modules. + * Keep your serialisation code in separate modules. * See also the [full list of open issues](https://github.com/Quid2/flat/issues). diff --git a/flat.cabal b/flat.cabal --- a/flat.cabal +++ b/flat.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: flat -version: 0.5 +version: 0.5.2 homepage: http://quid2.org synopsis: Principled and efficient bit-oriented binary serialization. description: Reference implementation of `flat`, a principled and efficient binary serialization format. @@ -133,35 +133,7 @@ semigroups < 0.19 , hashable >=1.2.4.0 && <=1.2.7.0 else - build-depends: hashable >= 1.4.0.2 - - --- test-suite ref --- type: exitcode-stdio-1.0 --- main-is: Reference.hs --- hs-source-dirs: test --- other-modules: --- Test.Data --- Test.Data.Arbitrary --- Test.Data.Flat --- Test.Data.Values --- Test.Data2 --- Test.Data2.Flat --- Test.E --- Test.E.Arbitrary --- Test.E.Flat - --- default-language: Haskell2010 --- build-depends: --- base --- , flat --- , zm --- , ghc-prim --- , quickcheck-text --- , tasty-hunit --- , tasty-quickcheck --- , text - + build-depends: hashable >= 1.4.0.1 test-suite spec type: exitcode-stdio-1.0 @@ -228,8 +200,8 @@ , text , QuickCheck >= 2.14.2 --- -- dynamic doctests and generation of static doctests --- -- Usable only with recent versions of ghc (no ghcjs or eta) +-- dynamic doctests and generation of static doctests +-- Usable only with recent versions of ghc (no ghcjs or eta) -- test-suite doc -- type: exitcode-stdio-1.0 @@ -245,7 +217,6 @@ -- , QuickCheck >= 2.14.2 -- static doctests (faster, useful for test coverage and to test ghcjs and eta) - test-suite doc-static type: exitcode-stdio-1.0 main-is: DocTests.hs @@ -306,9 +277,22 @@ ghc-options: -rtsopts --- test-suite ghcjs-cons +-- test-suite text -- type: exitcode-stdio-1.0 --- main-is: Cons.hs +-- main-is: TextSize.hs +-- hs-source-dirs: test +-- default-language: Haskell2010 +-- build-depends: +-- base +-- , flat +-- , text <2 + +-- ghc-options: -rtsopts + + +-- test-suite ghcjs +-- type: exitcode-stdio-1.0 +-- main-is: GHCJS.hs -- hs-source-dirs: test -- default-language: Haskell2010 -- build-depends: diff --git a/src/Data/FloatCast.hs b/src/Data/FloatCast.hs --- a/src/Data/FloatCast.hs +++ b/src/Data/FloatCast.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE Trustworthy ,NoMonomorphismRestriction#-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Trustworthy #-} {- | Primitives to convert between Float\/Double and Word32\/Word64. @@ -20,18 +21,10 @@ ) where -import Data.Word ( Word32 - , Word64 - ) -import Data.Array.ST ( newArray - , readArray - , MArray - , STUArray - ) -import Data.Array.Unsafe ( castSTUArray ) -import GHC.ST ( runST - , ST - ) +import Data.Array.ST (MArray, STUArray, newArray, readArray) +import Data.Array.Unsafe (castSTUArray) +import Data.Word (Word32, Word64) +import GHC.ST (ST, runST) -- import Flat.Endian @@ -93,22 +86,10 @@ wordToDouble x = runST (cast x) -- wordToDouble x = runST (cast $ fix64 x) --- | +-- | -- >>> runST (cast (0xF0F1F2F3F4F5F6F7::Word64)) == (0xF0F1F2F3F4F5F6F7::Word64) -- True cast :: (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) => a -> ST s b cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0 {-# INLINE cast #-} - --- Required for older versions of ghcjs --- #ifdef ghcjs_HOST_OS --- doubleToWord x = (`rotateR` 32) $ runST (cast x) --- #else --- doubleToWord x = runST (cast x) --- #endif --- #ifdef ghcjs_HOST_OS --- wordToDouble x = runST (cast $ x `rotateR` 32) --- #else --- wordToDouble x = runST (cast x) --- #endif diff --git a/src/Flat/Decoder.hs b/src/Flat/Decoder.hs --- a/src/Flat/Decoder.hs +++ b/src/Flat/Decoder.hs @@ -10,7 +10,7 @@ dLazyByteString, dShortByteString, dShortByteString_, -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) +#if! defined (ETA_VERSION) dUTF16, #endif dUTF8, diff --git a/src/Flat/Decoder/Prim.hs b/src/Flat/Decoder/Prim.hs --- a/src/Flat/Decoder/Prim.hs +++ b/src/Flat/Decoder/Prim.hs @@ -40,11 +40,6 @@ Storable (peek), castPtr, plusPtr, ptrToIntPtr) -#ifdef ghcjs_HOST_OS -import Foreign (shift) -#else -#endif - -- $setup -- >>> :set -XBinaryLiterals -- >>> import Data.Word @@ -137,13 +132,13 @@ consBits_ (ConsState w usedBits) numBits mask = let usedBits' = numBits+usedBits w' = w `unsafeShiftL` numBits - in (ConsState w' usedBits', (w `shR` (wordSize - numBits)) .&. mask) + in (ConsState w' usedBits', (w `unsafeShiftR` (wordSize - numBits)) .&. mask) #endif #ifdef CONS_STA consBits_ (ConsState w usedBits) numBits mask = let usedBits' = numBits+usedBits - in (ConsState w usedBits', (w `shR` (wordSize - usedBits')) .&. mask) + in (ConsState w usedBits', (w `unsafeShiftR` (wordSize - usedBits')) .&. mask) #endif wordSize :: Int @@ -170,7 +165,7 @@ let (bytes,bits) = (n+usedBits s) `divMod` 8 -- let -- n' = n+usedBits s - -- bytes = n' `shR` 3 + -- bytes = n' `unsafeShiftR` 3 -- bits = n' .|. 7 in S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits} @@ -184,7 +179,7 @@ then notEnoughSpace endPtr s else do !w <- peek (currPtr s) - let !b = 0 /= (w .&. (128 `shR` usedBits s)) + let !b = 0 /= (w .&. (128 `unsafeShiftR` usedBits s)) let !s' = if usedBits s == 7 then s { currPtr = currPtr s `plusPtr` 1, usedBits = 0 } else s { usedBits = usedBits s + 1 } @@ -250,12 +245,12 @@ -- | n <= 8 - usedBits s = do -- w <- peek (currPtr s) -- let (bytes,bits) = (n+usedBits s) `divMod` 8 --- return $ GetResult (S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits}) ((w `unsafeShiftL` usedBits s) `shR` (8 - n)) +-- return $ GetResult (S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits}) ((w `unsafeShiftL` usedBits s) `unsafeShiftR` (8 - n)) -- -- two different bytes -- | n <= 8 = do -- w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s) --- return $ GetResult (S {currPtr=currPtr s `plusPtr` 1,usedBits=(usedBits s + n) `mod` 8}) (fromIntegral $ (w `unsafeShiftL` usedBits s) `shR` (16 - n)) +-- return $ GetResult (S {currPtr=currPtr s `plusPtr` 1,usedBits=(usedBits s + n) `mod` 8}) (fromIntegral $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (16 - n)) -- | otherwise = error $ unwords ["take8: cannot take",show n,"bits"] @@ -270,10 +265,10 @@ if n <= 8 - usedBits s then do -- all bits in the same byte w <- peek (currPtr s) - return $ (w `unsafeShiftL` usedBits s) `shR` (8 - n) + return $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (8 - n) else do -- two different bytes w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s) - return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `shR` (16 - n) + return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (16 - n) | otherwise = badOp $ unwords ["read8: cannot read",show n,"bits"] -- {-# INLINE dropBits8 #-} -- -- Assume n <= 8 @@ -301,10 +296,10 @@ -- r <- case bytes of -- 0 -> do -- w <- peek (currPtr s) --- return . fromIntegral $ ((w `unsafeShiftL` usedBits s) `shR` (8 - n)) +-- return . fromIntegral $ ((w `unsafeShiftL` usedBits s) `unsafeShiftR` (8 - n)) -- 1 -> do -- w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s) --- return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `shR` (16 - n) +-- return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (16 - n) -- 2 -> do -- let r = 0 -- w1 <- fromIntegral <$> r8 s @@ -329,7 +324,7 @@ then return w1 else do !w2 <- peek (currPtr s `plusPtr` 1) - return $ (w1 `unsafeShiftL` usedBits s) .|. (w2 `shR` (8-usedBits s)) + return $ (w1 `unsafeShiftL` usedBits s) .|. (w2 `unsafeShiftR` (8-usedBits s)) return $ GetResult (s {currPtr=currPtr s `plusPtr` 1}) w {-# INLINE dBE16 #-} @@ -342,7 +337,7 @@ then return w1 else do !(w2::Word8) <- peek (currPtr s `plusPtr` 2) - return $ w1 `unsafeShiftL` usedBits s .|. fromIntegral (w2 `shR` (8-usedBits s)) + return $ w1 `unsafeShiftL` usedBits s .|. fromIntegral (w2 `unsafeShiftR` (8-usedBits s)) return $ GetResult (s {currPtr=currPtr s `plusPtr` 2}) w {-# INLINE dBE32 #-} @@ -355,7 +350,7 @@ then return w1 else do !(w2::Word8) <- peek (currPtr s `plusPtr` 4) - return $ w1 `unsafeShiftL` usedBits s .|. fromIntegral (w2 `shR` (8-usedBits s)) + return $ w1 `unsafeShiftL` usedBits s .|. fromIntegral (w2 `unsafeShiftR` (8-usedBits s)) return $ GetResult (s {currPtr=currPtr s `plusPtr` 4}) w {-# INLINE dBE64 #-} @@ -369,7 +364,7 @@ then return w1 else do !(w2::Word8) <- peek (currPtr s `plusPtr` 8) - return $ w1 `unsafeShiftL` usedBits s .|. fromIntegral (w2 `shR` (8-usedBits s)) + return $ w1 `unsafeShiftL` usedBits s .|. fromIntegral (w2 `unsafeShiftR` (8-usedBits s)) return $ GetResult (s {currPtr=currPtr s `plusPtr` 8}) w where -- {-# INLINE peek64 #-} @@ -415,23 +410,3 @@ when (usedBits s /=0) $ badEncoding endPtr s "usedBits /= 0" (currPtr',ns) <- getChunks (currPtr s) id return $ GetResult (s {currPtr=currPtr'}) (currPtr s `plusPtr` 1,ns) - --- Fix for ghcjs bug: https://github.com/ghcjs/ghcjs/issues/706 --- TODO: verify if actually needed here and if also needed in encoder --- {- | --- Shift right with sign extension. - --- >>> shR (0b1111111111111111::Word16) 3 == 0b0001111111111111 --- True - --- >>> shR (-1::Int16) 3 --- -1 --- -} -{-# INLINE shR #-} -shR :: Bits a => a -> Int -> a -#ifdef ghcjs_HOST_OS -shR val 0 = val -shR val n = shift val (-n) -#else -shR = unsafeShiftR -#endif diff --git a/src/Flat/Decoder/Strict.hs b/src/Flat/Decoder/Strict.hs --- a/src/Flat/Decoder/Strict.hs +++ b/src/Flat/Decoder/Strict.hs @@ -9,7 +9,7 @@ , dLazyByteString , dShortByteString , dShortByteString_ -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) +#if! defined (ETA_VERSION) , dUTF16 #endif , dUTF8 @@ -44,7 +44,7 @@ import Flat.Decoder.Prim import Flat.Decoder.Types -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) && ! MIN_VERSION_text(2,0,0) +#if! defined (ETA_VERSION) && ! MIN_VERSION_text(2,0,0) import qualified Data.Text.Array as TA import qualified Data.Text.Internal as T #endif @@ -158,7 +158,7 @@ 42 (wordStep 49 - (wordStep 56 (wordStep 63 (wordStep 70 (lastStep 77))))))))))) + (wordStep 56 (lastStep 63))))))))) 0 {-# INLINE dChar #-} @@ -237,18 +237,20 @@ if tw == w then return (v, shl) else dUnsigned_ (shl + 7) v + --encode = encode . blob UTF8Encoding . L.fromStrict . T.encodeUtf8 --decode = T.decodeUtf8 . L.toStrict . (unblob :: BLOB UTF8Encoding -> L.ByteString) <$> decode -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) + +#if ! defined (ETA_VERSION) -- BLOB UTF16Encoding dUTF16 :: Get T.Text dUTF16 = do _ <- dFiller #if MIN_VERSION_text(2,0,0) - -- Checked decoding + -- Checked decoding (from UTF-8) T.decodeUtf16LE <$> dByteString_ #else - -- Unchecked decoding + -- Unchecked decoding (already UTF16) (ByteArray array, lengthInBytes) <- dByteArray_ return (T.Text (TA.Array array) 0 (lengthInBytes `div` 2)) #endif diff --git a/src/Flat/Encoder.hs b/src/Flat/Encoder.hs --- a/src/Flat/Encoder.hs +++ b/src/Flat/Encoder.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP ,NoMonomorphismRestriction #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoMonomorphismRestriction #-} -- |Encoder and encoding primitives module Flat.Encoder ( Encoding, @@ -24,7 +25,7 @@ eTrue, eFalse, eBytes, -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) +#if ! defined (ETA_VERSION) eUTF16, #endif eLazyBytes, @@ -58,9 +59,7 @@ sBytes, sLazyBytes, sShortBytes, -#ifndef ghcjs_HOST_OS sUTF16, -#endif sFillerMax, sBool, sUTF8Max, @@ -70,11 +69,11 @@ #endif ) where -import Flat.Encoder.Prim ( eTrueF, eFalseF ) -import Flat.Encoder.Size(arrayBits) +import Flat.Encoder.Prim (eFalseF, eTrueF) +import Flat.Encoder.Size (arrayBits) import Flat.Encoder.Strict -import Flat.Encoder.Types ( NumBits, Size ) +import Flat.Encoder.Types (NumBits, Size) #if ! MIN_VERSION_base(4,11,0) -import Data.Semigroup((<>)) +import Data.Semigroup ((<>)) #endif diff --git a/src/Flat/Encoder/Prim.hs b/src/Flat/Encoder/Prim.hs --- a/src/Flat/Encoder/Prim.hs +++ b/src/Flat/Encoder/Prim.hs @@ -12,7 +12,7 @@ , eBitsF , eFloatF , eDoubleF -#if ! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) +#if ! defined (ETA_VERSION) , eUTF16F #endif , eUTF8F @@ -63,7 +63,7 @@ import Flat.Memory import Flat.Types -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) && ! MIN_VERSION_text(2,0,0) +#if ! defined (ETA_VERSION) && ! MIN_VERSION_text(2,0,0) import qualified Data.Text.Array as TA import qualified Data.Text.Internal as TI -- import Data.FloatCast @@ -252,16 +252,11 @@ low7 t = fromIntegral t .&. 0x7F -- | Encode text as UTF8 and encode the result as an array of bytes --- --- PROB: encodeUtf8 calls a C primitive, not compatible with GHCJS (fixed in latest versions of GHCJS?) eUTF8F :: T.Text -> Prim eUTF8F = eBytesF . TE.encodeUtf8 -- | Encode text as UTF16 and encode the result as an array of bytes --- --- PROB: Not compatible with GHCJS or ETA (that is big endian and writes contents in reverse order) -#if ! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) - +#if ! defined (ETA_VERSION) eUTF16F :: T.Text -> Prim #if MIN_VERSION_text(2,0,0) eUTF16F = eBytesF . TE.encodeUtf16LE diff --git a/src/Flat/Encoder/Size.hs b/src/Flat/Encoder/Size.hs --- a/src/Flat/Encoder/Size.hs +++ b/src/Flat/Encoder/Size.hs @@ -9,14 +9,12 @@ import qualified Data.ByteString.Short.Internal as SBS import Data.Char (ord) import qualified Data.Text as T +import qualified Data.Text.Internal as TI +import Data.ZigZag (ZigZag (zigZag)) import Flat.Encoder.Prim (w7l) import Flat.Types (Int16, Int32, Int64, Natural, NumBits, Text, Word16, Word32, Word64) -#ifndef ghcjs_HOST_OS -import qualified Data.Text.Internal as TI -#endif -import Data.ZigZag #include "MachDeps.h" -- A filler can take anything from 1 to 8 bits sFillerMax :: NumBits @@ -117,17 +115,34 @@ let vs = w7l t in length vs * 8 ---sUTF8 :: T.Text -> NumBits ---sUTF8 t = fold --- TOFIX: Wildly pessimistic and also slow as T.length is O(n) {-# INLINE sUTF8Max #-} sUTF8Max :: Text -> NumBits -sUTF8Max = blobBits . (4 *) . T.length -#ifndef ghcjs_HOST_OS -{-# INLINE sUTF16 #-} -sUTF16 :: T.Text -> NumBits -sUTF16 = blobBits . textBytes +sUTF8Max (TI.Text _ _ lenInUnits) = + let len = +#if MIN_VERSION_text(2,0,0) + -- UTF-8 encoding, units are bytes + lenInUnits +#else + -- UTF-16 encoding, units are 16 bits words + -- worst case: a utf-16 unit becomes a 3 bytes utf-8 encoding + lenInUnits * 3 #endif + in blobBits len + +{-# INLINE sUTF16Max #-} +sUTF16Max :: T.Text -> NumBits +sUTF16Max (TI.Text _ _ lenInUnits) = + let len = +#if MIN_VERSION_text(2,0,0) + -- UTF-8 encoding + -- worst case, a 1 byte UTF-8 char becomes a 2 bytes UTF-16 (ascii) + lenInUnits * 2 +#else + -- UTF-16 encoding + lenInUnits * 2 +#endif + in blobBits len + {-# INLINE sBytes #-} sBytes :: B.ByteString -> NumBits sBytes = blobBits . B.length @@ -139,18 +154,6 @@ {-# INLINE sShortBytes #-} sShortBytes :: SBS.ShortByteString -> NumBits sShortBytes = blobBits . SBS.length - -#ifndef ghcjs_HOST_OS --- We are not interested in the number of unicode chars (returned by T.length, an O(n) operation) --- just the number of bytes --- > T.length (T.pack "\x1F600") --- 1 --- > textBytes (T.pack "\x1F600") --- 4 -{-# INLINE textBytes #-} -textBytes :: T.Text -> Int -textBytes (TI.Text _ _ w16Len) = w16Len * 2 -#endif {-# INLINE bitsToBytes #-} bitsToBytes :: Int -> Int diff --git a/src/Flat/Encoder/Strict.hs b/src/Flat/Encoder/Strict.hs --- a/src/Flat/Encoder/Strict.hs +++ b/src/Flat/Encoder/Strict.hs @@ -167,11 +167,13 @@ {-# INLINE eFalse #-} eChar :: Char -> Encoding eChar = Encoding . eCharF -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) + +#if! defined (ETA_VERSION) {-# INLINE eUTF16 #-} eUTF16 :: Text -> Encoding eUTF16 = Encoding . eUTF16F #endif + eUTF8 :: Text -> Encoding eUTF8 = Encoding . eUTF8F @@ -309,13 +311,12 @@ sInteger :: Size Integer sInteger = vsize S.sInteger --- sUTF8 = vsize S.sUTF8 sUTF8Max :: Size Text sUTF8Max = vsize S.sUTF8Max -#ifndef ghcjs_HOST_OS + sUTF16 :: Size Text -sUTF16 = vsize S.sUTF16 -#endif +sUTF16 = vsize S.sUTF16Max + sFillerMax :: Size a sFillerMax = csize S.sFillerMax diff --git a/src/Flat/Endian.hs b/src/Flat/Endian.hs --- a/src/Flat/Endian.hs +++ b/src/Flat/Endian.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -- | Endian utilities --- +-- -- Exported for testing purposes, but not meant to be used outside this package. module Flat.Endian ( @@ -70,16 +70,3 @@ #else toBE16 = byteSwap16 #endif - --- Required for older versions of ghcjs --- | Fix issue with `ghcjs` (different order of 32 bit halves of 64 values with respect to `ghc`) --- fix64 :: Word64 -> Word64 --- fix64 = id - --- #ifdef ghcjs_HOST_OS --- fix64 = (`rotateR` 32) --- {-# NOINLINE fix64 #-} --- #else --- fix64 = id --- {-# INLINE fix64 #-} --- #endif diff --git a/src/Flat/Instances/Base.hs b/src/Flat/Instances/Base.hs --- a/src/Flat/Instances/Base.hs +++ b/src/Flat/Instances/Base.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE StandaloneDeriving #-} -- | Flat instances for the base library @@ -44,7 +44,7 @@ {- ORMOLU_DISABLE -} -- $setup --- >>> :set -XNegativeLiterals +-- >>> :set -XNegativeLiterals -XTypeApplications -- >>> import Flat.Instances.Test -- >>> import Data.Fixed -- >>> import Data.Int @@ -298,6 +298,66 @@ >>> all (test (3::Word) ==) [test (3::Word16),test (3::Word32),test (3::Word64)] True + + +Word/Int decoders return an error if the encoded value is outside their valid range: + +>>> unflat @Word16 (flat @Word32 $ fromIntegral @Word16 maxBound) +Right 65535 + +>>> unflat @Word16 (flat @Word32 $ fromIntegral @Word16 maxBound + 1) +Left (BadEncoding ... + +>>> unflat @Word32 (flat @Word64 $ fromIntegral @Word32 maxBound) +Right 4294967295 + +>>> unflat @Word32 (flat @Word64 $ fromIntegral @Word32 maxBound + 1) +Left (BadEncoding ... + +>>> unflat @Word64 (flat @Natural $ fromIntegral @Word64 maxBound) +Right 18446744073709551615 + +>>> unflat @Word64 (flat @Natural $ fromIntegral @Word64 maxBound + 1) +Left (BadEncoding ... + + + +>>> unflat @Int16 (flat @Int32 $ fromIntegral @Int16 maxBound) +Right 32767 + +>>> unflat @Int16 (flat @Int32 $ fromIntegral @Int16 maxBound + 1) +Left (BadEncoding ... + +>>> unflat @Int32 (flat @Int64 $ fromIntegral @Int32 maxBound) +Right 2147483647 + +>>> unflat @Int32 (flat @Int64 $ fromIntegral @Int32 maxBound + 1) +Left (BadEncoding ... + +>>> unflat @Int64 (flat @Integer $ fromIntegral @Int64 maxBound) +Right 9223372036854775807 + +>>> unflat @Int64 (flat @Integer $ fromIntegral @Int64 maxBound + 1) +Left (BadEncoding ... + + +>>> unflat @Int16 (flat @Int32 $ fromIntegral @Int16 minBound) +Right (-32768) + +>>> unflat @Int16 (flat @Int32 $ fromIntegral @Int16 minBound - 1) +Left (BadEncoding ... + +>>> unflat @Int32 (flat @Int64 $ fromIntegral @Int32 minBound) +Right (-2147483648) + +>>> unflat @Int32 (flat @Int64 $ fromIntegral @Int32 minBound - 1) +Left (BadEncoding ... + +>>> unflat @Int64 (flat @Integer $ fromIntegral @Int64 minBound) +Right (-9223372036854775808) + +>>> unflat @Int64 (flat @Integer $ fromIntegral @Int64 minBound - 1) +Left (BadEncoding ... -} instance Flat Word where size = sWord diff --git a/src/Flat/Instances/Test.hs b/src/Flat/Instances/Test.hs --- a/src/Flat/Instances/Test.hs +++ b/src/Flat/Instances/Test.hs @@ -13,7 +13,7 @@ import Control.Monad ((>=>)) import Data.Word import Flat.Bits (Bits, asBytes, bits, - paddedBits, takeBits) + paddedBits, takeBits,toBools) import Flat.Class (Flat (..)) import Flat.Encoder.Prim (eFillerF) import Flat.Encoder.Strict (Encoding (Encoding), @@ -24,7 +24,7 @@ -- | Returns: result of flat/unflat test, encoding size in bits, byte encoding tst :: (Eq a, Flat a) => a -> (Bool, NumBits, [Word8]) -tst v = (unflat (flat v) == Right v, size v 0, showBytes v) +tst v = (unflat (flat v) == Right v && size v 0 >= length (toBools (bits v)), size v 0, showBytes v) -- | Returns: result of flat/unflat test, encoding size in bits, bits encoding tstBits :: (Eq a, Flat a) => a -> (Bool, NumBits, String) diff --git a/src/Flat/Instances/Text.hs b/src/Flat/Instances/Text.hs --- a/src/Flat/Instances/Text.hs +++ b/src/Flat/Instances/Text.hs @@ -3,40 +3,41 @@ -- | Flat instances for the text library module Flat.Instances.Text( UTF8Text(..) -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) && ! defined (ETA) +#if! defined (ETA_VERSION) && ! defined (ETA) ,UTF16Text(..) #endif ) where +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import Flat.Instances.Util -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -- $setup -- >>> import Flat.Instances.Base() -- >>> import Flat.Instances.Test -- >>> import qualified Data.Text as T -- >>> import qualified Data.Text.Lazy as TL --- >>> import Data.Word +-- >>> import Data.Word +-- >>> tt t = let (ts,_,bs) = tst t in (ts,bs) -{-| +{- | Text (and Data.Text.Lazy) is encoded as a byte aligned array of bytes corresponding to its UTF8 encoding. ->>> tst $ T.pack "" -(True,16,[1,0]) +>>> tt $ T.pack "" +(True,[1,0]) ->>> tst $ T.pack "aaa" -(True,120,[1,3,97,97,97,0]) +>>> tt $ T.pack "aaa" +(True,[1,3,97,97,97,0]) ->>> tst $ T.pack "¢¢¢" -(True,120,[1,6,194,162,194,162,194,162,0]) +>>> tt $ T.pack "¢¢¢" +(True,[1,6,194,162,194,162,194,162,0]) ->>> tst $ T.pack "日日日" -(True,120,[1,9,230,151,165,230,151,165,230,151,165,0]) +>>> tt $ T.pack "日日日" +(True,[1,9,230,151,165,230,151,165,230,151,165,0]) #ifndef ETA ->>> tst $ T.pack "𐍈𐍈𐍈" -(True,120,[1,12,240,144,141,136,240,144,141,136,240,144,141,136,0]) +>>> tt $ T.pack "𐍈𐍈𐍈" +(True,[1,12,240,144,141,136,240,144,141,136,240,144,141,136,0]) #endif Strict and Lazy Text have the same encoding: @@ -62,7 +63,7 @@ >>> tst (UTF8Text $ T.pack "日日日") == tst (T.pack "日日日") True -} --- |A wrapper to encode/decode Text as UTF8 (slower but more compact) +-- |A wrapper to encode/decode Text as UTF8 newtype UTF8Text = UTF8Text {unUTF8::T.Text} deriving (Eq,Ord,Show) instance Flat UTF8Text where @@ -70,22 +71,21 @@ encode (UTF8Text t) = eUTF8 t decode = UTF8Text <$> dUTF8 -#if ! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) && ! defined (ETA) +#if ! defined (ETA_VERSION) && ! defined (ETA) {-| ->>> tst (UTF16Text $ T.pack "aaa") -(True,72,[1,6,97,0,97,0,97,0,0]) +>>> tt (UTF16Text $ T.pack "aaa") +(True,[1,6,97,0,97,0,97,0,0]) ->>> tst (UTF16Text $ T.pack "𐍈𐍈𐍈") -(True,120,[1,12,0,216,72,223,0,216,72,223,0,216,72,223,0]) +>>> tt (UTF16Text $ T.pack "𐍈𐍈𐍈") +(True,[1,12,0,216,72,223,0,216,72,223,0,216,72,223,0]) -} --- |A wrapper to encode/decode Text as UTF16 (faster but bigger) +-- |A wrapper to encode/decode Text as UTF16 newtype UTF16Text = UTF16Text {unUTF16::T.Text} deriving (Eq,Ord,Show) instance Flat UTF16Text where size (UTF16Text t) = sUTF16 t encode (UTF16Text t) = eUTF16 t decode = UTF16Text <$> dUTF16 - #endif diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -22,22 +22,21 @@ - . # for test only - # - ../EXTERNAL/doctest + #- ../EXTERNAL/doctest extra-deps: # Modified doctest, used to generate static tests (run by doc-static) + - hashable-1.4.0.2@sha256:0cddd0229d1aac305ea0404409c0bbfab81f075817bd74b8b2929eff58333e55,5005 - git: https://github.com/tittoassini/doctest commit: 3954e94449901764e28cfed1c35490af970e9b01 - # - hashable-1.4.0.2@sha256:0cddd0229d1aac305ea0404409c0bbfab81f075817bd74b8b2929eff58333e55,5005 - # for ghcjs-cons # - jsaddle-0.9.8.2@sha256:e8c003801eb9364fcd6b1e0cda34f072a537bcfa767e6eb8c626836dae77ba04,4419 # - ref-tf-0.4.0.2@sha256:69de3550250e0cd69f45d080359cb314a9487c915024349c75b78732bbee9332,1134 # for text-2.0: - # - text-2.0 + # - text-2.0.1 # - Cabal-3.6.3.0@sha256:ff97c442b0c679c1c9876acd15f73ac4f602b973c45bde42b43ec28265ee48f4,12459 # - parsec-3.1.15.0@sha256:a162d4cc8884014ba35192545cad293af0529fe11497aad8834bbaaa3dfffc26,4429 - + # - hashable-1.4.1.0@sha256:50b2f002c68fe67730ee7a3cd8607486197dd99b084255005ad51ecd6970a41b,5019 allow-newer: true diff --git a/test/DocTest/Data/FloatCast.hs b/test/DocTest/Data/FloatCast.hs --- a/test/DocTest/Data/FloatCast.hs +++ b/test/DocTest/Data/FloatCast.hs @@ -8,4 +8,4 @@ import Data.Word tests :: IO TestTree -tests = testGroup "Data.FloatCast" <$> sequence [ DocTest.testProp "src/Data/FloatCast.hs:42" ( \f -> wordToFloat (floatToWord f ) == f ), DocTest.test "src/Data/FloatCast.hs:45" "[ExpectedLine [LineChunk \"3189768192\"]]" (DocTest.asPrint( floatToWord (-0.15625) )), DocTest.test "src/Data/FloatCast.hs:48" "[ExpectedLine [LineChunk \"-0.15625\"]]" (DocTest.asPrint( wordToFloat 3189768192 )), DocTest.test "src/Data/FloatCast.hs:51" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( floatToWord (-5.828125) == 0xC0BA8000 )), DocTest.testProp "src/Data/FloatCast.hs:70" ( \f -> wordToDouble (doubleToWord f ) == f ), DocTest.test "src/Data/FloatCast.hs:73" "[ExpectedLine [LineChunk \"\\\"3ff0000000000002\\\"\"]]" (DocTest.asPrint( showHex (doubleToWord 1.0000000000000004) "" )), DocTest.test "src/Data/FloatCast.hs:76" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( doubleToWord 1.0000000000000004 == 0x3FF0000000000002 )), DocTest.test "src/Data/FloatCast.hs:79" "[ExpectedLine [LineChunk \"\\\"bfc4000000000000\\\"\"]]" (DocTest.asPrint( showHex (doubleToWord (-0.15625)) "" )), DocTest.test "src/Data/FloatCast.hs:82" "[ExpectedLine [LineChunk \"-0.15625\"]]" (DocTest.asPrint( wordToDouble 0xbfc4000000000000 )), DocTest.test "src/Data/FloatCast.hs:97" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( runST (cast (0xF0F1F2F3F4F5F6F7::Word64)) == (0xF0F1F2F3F4F5F6F7::Word64) ))] +tests = testGroup "Data.FloatCast" <$> sequence [ DocTest.testProp "src/Data/FloatCast.hs:35" ( \f -> wordToFloat (floatToWord f ) == f ), DocTest.test "src/Data/FloatCast.hs:38" "[ExpectedLine [LineChunk \"3189768192\"]]" (DocTest.asPrint( floatToWord (-0.15625) )), DocTest.test "src/Data/FloatCast.hs:41" "[ExpectedLine [LineChunk \"-0.15625\"]]" (DocTest.asPrint( wordToFloat 3189768192 )), DocTest.test "src/Data/FloatCast.hs:44" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( floatToWord (-5.828125) == 0xC0BA8000 )), DocTest.testProp "src/Data/FloatCast.hs:63" ( \f -> wordToDouble (doubleToWord f ) == f ), DocTest.test "src/Data/FloatCast.hs:66" "[ExpectedLine [LineChunk \"\\\"3ff0000000000002\\\"\"]]" (DocTest.asPrint( showHex (doubleToWord 1.0000000000000004) "" )), DocTest.test "src/Data/FloatCast.hs:69" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( doubleToWord 1.0000000000000004 == 0x3FF0000000000002 )), DocTest.test "src/Data/FloatCast.hs:72" "[ExpectedLine [LineChunk \"\\\"bfc4000000000000\\\"\"]]" (DocTest.asPrint( showHex (doubleToWord (-0.15625)) "" )), DocTest.test "src/Data/FloatCast.hs:75" "[ExpectedLine [LineChunk \"-0.15625\"]]" (DocTest.asPrint( wordToDouble 0xbfc4000000000000 )), DocTest.test "src/Data/FloatCast.hs:90" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( runST (cast (0xF0F1F2F3F4F5F6F7::Word64)) == (0xF0F1F2F3F4F5F6F7::Word64) ))] diff --git a/test/DocTest/Flat/Decoder/Prim.hs b/test/DocTest/Flat/Decoder/Prim.hs --- a/test/DocTest/Flat/Decoder/Prim.hs +++ b/test/DocTest/Flat/Decoder/Prim.hs @@ -12,4 +12,4 @@ import Text.PrettyPrint.HughesPJClass (Pretty (pPrint)) tests :: IO TestTree -tests = testGroup "Flat.Decoder.Prim" <$> sequence [ DocTest.test "src/Flat/Decoder/Prim.hs:199" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unflatWith (dBEBits8 3) [0b11100001::Word8] == Right 0b00000111 )), DocTest.test "src/Flat/Decoder/Prim.hs:202" "[ExpectedLine [LineChunk \"Left (BadOp \\\"read8: cannot read 9 bits\\\")\"]]" (DocTest.asPrint( unflatWith (dBEBits8 9) [0b11100001::Word8,0b11111111] )), DocTest.test "src/Flat/Decoder/Prim.hs:215" "[ExpectedLine [LineChunk \"Right 00000101 10111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 11) [0b10110111::Word8,0b11100001] )), DocTest.test "src/Flat/Decoder/Prim.hs:220" "[ExpectedLine [LineChunk \"Right 00000111 11111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 19) [0b00000000::Word8,0b11111111,0b11100001] ))] +tests = testGroup "Flat.Decoder.Prim" <$> sequence [ DocTest.test "src/Flat/Decoder/Prim.hs:194" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unflatWith (dBEBits8 3) [0b11100001::Word8] == Right 0b00000111 )), DocTest.test "src/Flat/Decoder/Prim.hs:197" "[ExpectedLine [LineChunk \"Left (BadOp \\\"read8: cannot read 9 bits\\\")\"]]" (DocTest.asPrint( unflatWith (dBEBits8 9) [0b11100001::Word8,0b11111111] )), DocTest.test "src/Flat/Decoder/Prim.hs:210" "[ExpectedLine [LineChunk \"Right 00000101 10111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 11) [0b10110111::Word8,0b11100001] )), DocTest.test "src/Flat/Decoder/Prim.hs:215" "[ExpectedLine [LineChunk \"Right 00000111 11111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 19) [0b00000000::Word8,0b11111111,0b11100001] ))] diff --git a/test/DocTest/Flat/Encoder/Prim.hs b/test/DocTest/Flat/Encoder/Prim.hs --- a/test/DocTest/Flat/Encoder/Prim.hs +++ b/test/DocTest/Flat/Encoder/Prim.hs @@ -11,4 +11,4 @@ enc e = prettyShow $ encBits 256 (Encoding e) tests :: IO TestTree -tests = testGroup "Flat.Encoder.Prim" <$> sequence [ DocTest.test "src/Flat/Encoder/Prim.hs:376" "[ExpectedLine [LineChunk \"\\\"1\\\"\"]]" (DocTest.asPrint( enc eTrueF )), DocTest.test "src/Flat/Encoder/Prim.hs:384" "[ExpectedLine [LineChunk \"\\\"0\\\"\"]]" (DocTest.asPrint( enc eFalseF )), DocTest.test "src/Flat/Encoder/Prim.hs:394" "[ExpectedLine [LineChunk \"\\\"10000001\\\"\"]]" (DocTest.asPrint( enc $ eTrueF >=> eFillerF )), DocTest.test "src/Flat/Encoder/Prim.hs:397" "[ExpectedLine [LineChunk \"\\\"00000001\\\"\"]]" (DocTest.asPrint( enc eFillerF )), DocTest.test "src/Flat/Encoder/Prim.hs:430" "[ExpectedLine [LineChunk \"\\\"11111111\\\"\"]]" (DocTest.asPrint( enc $ \s-> eWord8F 0 s >>= updateWord8 255 s )), DocTest.test "src/Flat/Encoder/Prim.hs:433" "[ExpectedLine [LineChunk \"\\\"10000000 01111111 1\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eTrueF s0 >>= \s1 -> eWord8F 255 s1 >>= eWord8F 255 >>= updateWord8 0 s1 )), DocTest.test "src/Flat/Encoder/Prim.hs:436" "[ExpectedLine [LineChunk \"\\\"01111111 1\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eFalseF s0 >>= \s1 -> eWord8F 0 s1 >>= updateWord8 255 s1 )), DocTest.test "src/Flat/Encoder/Prim.hs:439" "[ExpectedLine [LineChunk \"\\\"01111111 10\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eFalseF s0 >>= \s1 -> eWord8F 0 s1 >>= updateWord8 255 s1 >>= eFalseF )), DocTest.test "src/Flat/Encoder/Prim.hs:442" "[ExpectedLine [LineChunk \"\\\"10000000 011\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eTrueF s0 >>= \s1 -> eWord8F 255 s1 >>= eTrueF >>= updateWord8 0 s1 >>= eTrueF ))] +tests = testGroup "Flat.Encoder.Prim" <$> sequence [ DocTest.test "src/Flat/Encoder/Prim.hs:371" "[ExpectedLine [LineChunk \"\\\"1\\\"\"]]" (DocTest.asPrint( enc eTrueF )), DocTest.test "src/Flat/Encoder/Prim.hs:379" "[ExpectedLine [LineChunk \"\\\"0\\\"\"]]" (DocTest.asPrint( enc eFalseF )), DocTest.test "src/Flat/Encoder/Prim.hs:389" "[ExpectedLine [LineChunk \"\\\"10000001\\\"\"]]" (DocTest.asPrint( enc $ eTrueF >=> eFillerF )), DocTest.test "src/Flat/Encoder/Prim.hs:392" "[ExpectedLine [LineChunk \"\\\"00000001\\\"\"]]" (DocTest.asPrint( enc eFillerF )), DocTest.test "src/Flat/Encoder/Prim.hs:425" "[ExpectedLine [LineChunk \"\\\"11111111\\\"\"]]" (DocTest.asPrint( enc $ \s-> eWord8F 0 s >>= updateWord8 255 s )), DocTest.test "src/Flat/Encoder/Prim.hs:428" "[ExpectedLine [LineChunk \"\\\"10000000 01111111 1\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eTrueF s0 >>= \s1 -> eWord8F 255 s1 >>= eWord8F 255 >>= updateWord8 0 s1 )), DocTest.test "src/Flat/Encoder/Prim.hs:431" "[ExpectedLine [LineChunk \"\\\"01111111 1\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eFalseF s0 >>= \s1 -> eWord8F 0 s1 >>= updateWord8 255 s1 )), DocTest.test "src/Flat/Encoder/Prim.hs:434" "[ExpectedLine [LineChunk \"\\\"01111111 10\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eFalseF s0 >>= \s1 -> eWord8F 0 s1 >>= updateWord8 255 s1 >>= eFalseF )), DocTest.test "src/Flat/Encoder/Prim.hs:437" "[ExpectedLine [LineChunk \"\\\"10000000 011\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eTrueF s0 >>= \s1 -> eWord8F 255 s1 >>= eTrueF >>= updateWord8 0 s1 >>= eTrueF ))] diff --git a/test/DocTest/Flat/Instances/Base.hs b/test/DocTest/Flat/Instances/Base.hs --- a/test/DocTest/Flat/Instances/Base.hs +++ b/test/DocTest/Flat/Instances/Base.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NegativeLiterals#-} +{-# LANGUAGE NegativeLiterals,TypeApplications#-} {-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules#-} module DocTest.Flat.Instances.Base where @@ -19,4 +19,4 @@ y = 33 tests :: IO TestTree -tests = testGroup "Flat.Instances.Base" <$> sequence [ DocTest.test "src/Flat/Instances/Base.hs:73" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w = Just (11::Word8); a = Alt w <> Alt (Just 24) in tst a == tst w )), DocTest.test "src/Flat/Instances/Base.hs:76" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w = Just (11::Word8); a = Alt Nothing <> Alt w in tst a == tst w )), DocTest.test "src/Flat/Instances/Base.hs:148" "[ExpectedLine [LineChunk \"(True,0,\\\"\\\")\"]]" (DocTest.asPrint( test () )), DocTest.test "src/Flat/Instances/Base.hs:161" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test False )), DocTest.test "src/Flat/Instances/Base.hs:164" "[ExpectedLine [LineChunk \"(True,1,\\\"1\\\")\"]]" (DocTest.asPrint( test True )), DocTest.test "src/Flat/Instances/Base.hs:179" "[ExpectedLine [LineChunk \"(True,8,\\\"01100001\\\")\"]]" (DocTest.asPrint( test 'a' )), DocTest.test "src/Flat/Instances/Base.hs:184" "[ExpectedLine [LineChunk \"(True,16,\\\"11001000 00000001\\\")\"]]" (DocTest.asPrint( test 'È' )), DocTest.test "src/Flat/Instances/Base.hs:187" "[ExpectedLine [LineChunk \"(True,24,\\\"10001101 10011100 00000001\\\")\"]]" (DocTest.asPrint( test '不' )), DocTest.test "src/Flat/Instances/Base.hs:203" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test (Nothing::Maybe Bool) )), DocTest.test "src/Flat/Instances/Base.hs:206" "[ExpectedLine [LineChunk \"(True,2,\\\"10\\\")\"]]" (DocTest.asPrint( test (Just False::Maybe Bool) )), DocTest.test "src/Flat/Instances/Base.hs:212" "[ExpectedLine [LineChunk \"(True,2,\\\"00\\\")\"]]" (DocTest.asPrint( test (Left False::Either Bool ()) )), DocTest.test "src/Flat/Instances/Base.hs:215" "[ExpectedLine [LineChunk \"(True,1,\\\"1\\\")\"]]" (DocTest.asPrint( test (Right ()::Either Bool ()) )), DocTest.test "src/Flat/Instances/Base.hs:221" "[ExpectedLine [LineChunk \"(True,16,\\\"11110110 00000001\\\")\"]]" (DocTest.asPrint( test (MkFixed 123 :: Fixed E0) )), DocTest.test "src/Flat/Instances/Base.hs:224" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( test (MkFixed 123 :: Fixed E0) == test (MkFixed 123 :: Fixed E2) )), DocTest.test "src/Flat/Instances/Base.hs:237" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Word8) )), DocTest.test "src/Flat/Instances/Base.hs:240" "[ExpectedLine [LineChunk \"(True,8,\\\"11111111\\\")\"]]" (DocTest.asPrint( test (255::Word8) )), DocTest.test "src/Flat/Instances/Base.hs:284" "[ExpectedLine [LineChunk \"(True,8,\\\"01111111\\\")\"]]" (DocTest.asPrint( test (127::Word) )), DocTest.test "src/Flat/Instances/Base.hs:289" "[ExpectedLine [LineChunk \"(True,16,\\\"11111110 00000001\\\")\"]]" (DocTest.asPrint( test (254::Word) )), DocTest.test "src/Flat/Instances/Base.hs:294" "[ExpectedLine [LineChunk \"(True,24,\\\"10000000 10000000 00000010\\\")\"]]" (DocTest.asPrint( test (32768::Word32) )), DocTest.test "src/Flat/Instances/Base.hs:299" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( all (test (3::Word) ==) [test (3::Word16),test (3::Word32),test (3::Word64)] )), DocTest.test "src/Flat/Instances/Base.hs:312" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Natural) )), DocTest.test "src/Flat/Instances/Base.hs:315" "[ExpectedLine [LineChunk \"(True,144,\\\"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000010\\\")\"]]" (DocTest.asPrint( test (2^120::Natural) )), DocTest.test "src/Flat/Instances/Base.hs:365" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int) )), DocTest.test "src/Flat/Instances/Base.hs:368" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Int) )), DocTest.test "src/Flat/Instances/Base.hs:371" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Int) )), DocTest.test "src/Flat/Instances/Base.hs:374" "[ExpectedLine [LineChunk \"(True,8,\\\"00000011\\\")\"]]" (DocTest.asPrint( test (-2::Int) )), DocTest.test "src/Flat/Instances/Base.hs:377" "[ExpectedLine [LineChunk \"(True,8,\\\"00000100\\\")\"]]" (DocTest.asPrint( test (2::Int) )), DocTest.test "src/Flat/Instances/Base.hs:390" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:393" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:396" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:399" "[ExpectedLine [LineChunk \"(True,8,\\\"00011111\\\")\"]]" (DocTest.asPrint( test (-(2^4)::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:402" "[ExpectedLine [LineChunk \"(True,8,\\\"00100000\\\")\"]]" (DocTest.asPrint( test (2^4::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:405" "[ExpectedLine [LineChunk \"(True,144,\\\"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (-(2^120)::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:408" "[ExpectedLine [LineChunk \"(True,144,\\\"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000100\\\")\"]]" (DocTest.asPrint( test (2^120::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:419" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int8) )), DocTest.test "src/Flat/Instances/Base.hs:422" "[ExpectedLine [LineChunk \"(True,8,\\\"11111110\\\")\"]]" (DocTest.asPrint( test (127::Int8) )), DocTest.test "src/Flat/Instances/Base.hs:425" "[ExpectedLine [LineChunk \"(True,8,\\\"11111111\\\")\"]]" (DocTest.asPrint( test (-128::Int8) )), DocTest.test "src/Flat/Instances/Base.hs:436" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:439" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:442" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:445" "[ExpectedLine [LineChunk \"(True,24,\\\"11111111 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (minBound::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:450" "[ExpectedLine [LineChunk \"(True,24,\\\"11111110 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (maxBound::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:463" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int32) )), DocTest.test "src/Flat/Instances/Base.hs:466" "[ExpectedLine [LineChunk \"(True,40,\\\"11111111 11111111 11111111 11111111 00001111\\\")\"]]" (DocTest.asPrint( test (minBound::Int32) )), DocTest.test "src/Flat/Instances/Base.hs:469" "[ExpectedLine [LineChunk \"(True,40,\\\"11111110 11111111 11111111 11111111 00001111\\\")\"]]" (DocTest.asPrint( test (maxBound::Int32) )), DocTest.test "src/Flat/Instances/Base.hs:480" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int64) )), DocTest.test "src/Flat/Instances/Base.hs:483" "[ExpectedLine [LineChunk \"(True,80,\\\"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001\\\")\"]]" (DocTest.asPrint( test (minBound::Int64) )), DocTest.test "src/Flat/Instances/Base.hs:486" "[ExpectedLine [LineChunk \"(True,80,\\\"11111110 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001\\\")\"]]" (DocTest.asPrint( test (maxBound::Int64) )), DocTest.test "src/Flat/Instances/Base.hs:505" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 00000000 00000000 00000000\\\")\"]]" (DocTest.asPrint( test (0::Float) )), DocTest.test "src/Flat/Instances/Base.hs:508" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 00000000 00000000 00000001\\\")\"]]" (DocTest.asPrint( test (1.4012984643E-45::Float) )), DocTest.test "src/Flat/Instances/Base.hs:511" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 01111111 11111111 11111111\\\")\"]]" (DocTest.asPrint( test (1.1754942107E-38::Float) )), DocTest.test "src/Flat/Instances/Base.hs:538" "[ExpectedLine [LineChunk \"(True,16,\\\"00000100 00000010\\\")\"]]" (DocTest.asPrint( test (4 :+ 2 :: Complex Word8) )), DocTest.test "src/Flat/Instances/Base.hs:546" "[ExpectedLine [LineChunk \"(True,16,\\\"00000011 00000100\\\")\"]]" (DocTest.asPrint( test (3%4::Ratio Word8) )), DocTest.test "src/Flat/Instances/Base.hs:558" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test ([]::[Bool]) )), DocTest.test "src/Flat/Instances/Base.hs:561" "[ExpectedLine [LineChunk \"(True,5,\\\"10100\\\")\"]]" (DocTest.asPrint( test [False,False] )), DocTest.test "src/Flat/Instances/Base.hs:595" "[ExpectedLine [LineChunk \"(True,2,\\\"10\\\")\"]]" (DocTest.asPrint( test (B.fromList [True]) )), DocTest.test "src/Flat/Instances/Base.hs:598" "[ExpectedLine [LineChunk \"(True,4,\\\"0100\\\")\"]]" (DocTest.asPrint( test (B.fromList [False,False]) )), DocTest.test "src/Flat/Instances/Base.hs:608" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test (False,()) )), DocTest.test "src/Flat/Instances/Base.hs:611" "[ExpectedLine [LineChunk \"(True,0,\\\"\\\")\"]]" (DocTest.asPrint( test ((),()) )), DocTest.test "src/Flat/Instances/Base.hs:616" "[ExpectedLine [LineChunk \"(True,7,\\\"0111011\\\")\"]]" (DocTest.asPrint( test (False,True,True,True,False,True,True) ))] +tests = testGroup "Flat.Instances.Base" <$> sequence [ DocTest.test "src/Flat/Instances/Base.hs:73" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w = Just (11::Word8); a = Alt w <> Alt (Just 24) in tst a == tst w )), DocTest.test "src/Flat/Instances/Base.hs:76" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w = Just (11::Word8); a = Alt Nothing <> Alt w in tst a == tst w )), DocTest.test "src/Flat/Instances/Base.hs:148" "[ExpectedLine [LineChunk \"(True,0,\\\"\\\")\"]]" (DocTest.asPrint( test () )), DocTest.test "src/Flat/Instances/Base.hs:161" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test False )), DocTest.test "src/Flat/Instances/Base.hs:164" "[ExpectedLine [LineChunk \"(True,1,\\\"1\\\")\"]]" (DocTest.asPrint( test True )), DocTest.test "src/Flat/Instances/Base.hs:179" "[ExpectedLine [LineChunk \"(True,8,\\\"01100001\\\")\"]]" (DocTest.asPrint( test 'a' )), DocTest.test "src/Flat/Instances/Base.hs:184" "[ExpectedLine [LineChunk \"(True,16,\\\"11001000 00000001\\\")\"]]" (DocTest.asPrint( test 'È' )), DocTest.test "src/Flat/Instances/Base.hs:187" "[ExpectedLine [LineChunk \"(True,24,\\\"10001101 10011100 00000001\\\")\"]]" (DocTest.asPrint( test '不' )), DocTest.test "src/Flat/Instances/Base.hs:191" "[ExpectedLine [LineChunk \"(True,26,\\\"11000000 01110110 00000011 10\\\")\"]]" (DocTest.asPrint( test "\x1F600" )), DocTest.test "src/Flat/Instances/Base.hs:203" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test (Nothing::Maybe Bool) )), DocTest.test "src/Flat/Instances/Base.hs:206" "[ExpectedLine [LineChunk \"(True,2,\\\"10\\\")\"]]" (DocTest.asPrint( test (Just False::Maybe Bool) )), DocTest.test "src/Flat/Instances/Base.hs:212" "[ExpectedLine [LineChunk \"(True,2,\\\"00\\\")\"]]" (DocTest.asPrint( test (Left False::Either Bool ()) )), DocTest.test "src/Flat/Instances/Base.hs:215" "[ExpectedLine [LineChunk \"(True,1,\\\"1\\\")\"]]" (DocTest.asPrint( test (Right ()::Either Bool ()) )), DocTest.test "src/Flat/Instances/Base.hs:221" "[ExpectedLine [LineChunk \"(True,16,\\\"11110110 00000001\\\")\"]]" (DocTest.asPrint( test (MkFixed 123 :: Fixed E0) )), DocTest.test "src/Flat/Instances/Base.hs:224" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( test (MkFixed 123 :: Fixed E0) == test (MkFixed 123 :: Fixed E2) )), DocTest.test "src/Flat/Instances/Base.hs:237" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Word8) )), DocTest.test "src/Flat/Instances/Base.hs:240" "[ExpectedLine [LineChunk \"(True,8,\\\"11111111\\\")\"]]" (DocTest.asPrint( test (255::Word8) )), DocTest.test "src/Flat/Instances/Base.hs:284" "[ExpectedLine [LineChunk \"(True,8,\\\"01111111\\\")\"]]" (DocTest.asPrint( test (127::Word) )), DocTest.test "src/Flat/Instances/Base.hs:289" "[ExpectedLine [LineChunk \"(True,16,\\\"11111110 00000001\\\")\"]]" (DocTest.asPrint( test (254::Word) )), DocTest.test "src/Flat/Instances/Base.hs:294" "[ExpectedLine [LineChunk \"(True,24,\\\"10000000 10000000 00000010\\\")\"]]" (DocTest.asPrint( test (32768::Word32) )), DocTest.test "src/Flat/Instances/Base.hs:299" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( all (test (3::Word) ==) [test (3::Word16),test (3::Word32),test (3::Word64)] )), DocTest.test "src/Flat/Instances/Base.hs:305" "[ExpectedLine [LineChunk \"Right 65535\"]]" (DocTest.asPrint( unflat @Word16 (flat @Word32 $ fromIntegral @Word16 maxBound) )), DocTest.test "src/Flat/Instances/Base.hs:308" "[ExpectedLine [LineChunk \"Left (BadEncoding \",WildCardChunk]]" (DocTest.asPrint( unflat @Word16 (flat @Word32 $ fromIntegral @Word16 maxBound + 1) )), DocTest.test "src/Flat/Instances/Base.hs:311" "[ExpectedLine [LineChunk \"Right 4294967295\"]]" (DocTest.asPrint( unflat @Word32 (flat @Word64 $ fromIntegral @Word32 maxBound) )), DocTest.test "src/Flat/Instances/Base.hs:314" "[ExpectedLine [LineChunk \"Left (BadEncoding \",WildCardChunk]]" (DocTest.asPrint( unflat @Word32 (flat @Word64 $ fromIntegral @Word32 maxBound + 1) )), DocTest.test "src/Flat/Instances/Base.hs:317" "[ExpectedLine [LineChunk \"Right 18446744073709551615\"]]" (DocTest.asPrint( unflat @Word64 (flat @Natural $ fromIntegral @Word64 maxBound) )), DocTest.test "src/Flat/Instances/Base.hs:320" "[ExpectedLine [LineChunk \"Left (BadEncoding \",WildCardChunk]]" (DocTest.asPrint( unflat @Word64 (flat @Natural $ fromIntegral @Word64 maxBound + 1) )), DocTest.test "src/Flat/Instances/Base.hs:325" "[ExpectedLine [LineChunk \"Right 32767\"]]" (DocTest.asPrint( unflat @Int16 (flat @Int32 $ fromIntegral @Int16 maxBound) )), DocTest.test "src/Flat/Instances/Base.hs:328" "[ExpectedLine [LineChunk \"Left (BadEncoding \",WildCardChunk]]" (DocTest.asPrint( unflat @Int16 (flat @Int32 $ fromIntegral @Int16 maxBound + 1) )), DocTest.test "src/Flat/Instances/Base.hs:331" "[ExpectedLine [LineChunk \"Right 2147483647\"]]" (DocTest.asPrint( unflat @Int32 (flat @Int64 $ fromIntegral @Int32 maxBound) )), DocTest.test "src/Flat/Instances/Base.hs:334" "[ExpectedLine [LineChunk \"Left (BadEncoding \",WildCardChunk]]" (DocTest.asPrint( unflat @Int32 (flat @Int64 $ fromIntegral @Int32 maxBound + 1) )), DocTest.test "src/Flat/Instances/Base.hs:337" "[ExpectedLine [LineChunk \"Right 9223372036854775807\"]]" (DocTest.asPrint( unflat @Int64 (flat @Integer $ fromIntegral @Int64 maxBound) )), DocTest.test "src/Flat/Instances/Base.hs:340" "[ExpectedLine [LineChunk \"Left (BadEncoding \",WildCardChunk]]" (DocTest.asPrint( unflat @Int64 (flat @Integer $ fromIntegral @Int64 maxBound + 1) )), DocTest.test "src/Flat/Instances/Base.hs:344" "[ExpectedLine [LineChunk \"Right (-32768)\"]]" (DocTest.asPrint( unflat @Int16 (flat @Int32 $ fromIntegral @Int16 minBound) )), DocTest.test "src/Flat/Instances/Base.hs:347" "[ExpectedLine [LineChunk \"Left (BadEncoding \",WildCardChunk]]" (DocTest.asPrint( unflat @Int16 (flat @Int32 $ fromIntegral @Int16 minBound - 1) )), DocTest.test "src/Flat/Instances/Base.hs:350" "[ExpectedLine [LineChunk \"Right (-2147483648)\"]]" (DocTest.asPrint( unflat @Int32 (flat @Int64 $ fromIntegral @Int32 minBound) )), DocTest.test "src/Flat/Instances/Base.hs:353" "[ExpectedLine [LineChunk \"Left (BadEncoding \",WildCardChunk]]" (DocTest.asPrint( unflat @Int32 (flat @Int64 $ fromIntegral @Int32 minBound - 1) )), DocTest.test "src/Flat/Instances/Base.hs:356" "[ExpectedLine [LineChunk \"Right (-9223372036854775808)\"]]" (DocTest.asPrint( unflat @Int64 (flat @Integer $ fromIntegral @Int64 minBound) )), DocTest.test "src/Flat/Instances/Base.hs:359" "[ExpectedLine [LineChunk \"Left (BadEncoding \",WildCardChunk]]" (DocTest.asPrint( unflat @Int64 (flat @Integer $ fromIntegral @Int64 minBound - 1) )), DocTest.test "src/Flat/Instances/Base.hs:372" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Natural) )), DocTest.test "src/Flat/Instances/Base.hs:375" "[ExpectedLine [LineChunk \"(True,144,\\\"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000010\\\")\"]]" (DocTest.asPrint( test (2^120::Natural) )), DocTest.test "src/Flat/Instances/Base.hs:425" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int) )), DocTest.test "src/Flat/Instances/Base.hs:428" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Int) )), DocTest.test "src/Flat/Instances/Base.hs:431" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Int) )), DocTest.test "src/Flat/Instances/Base.hs:434" "[ExpectedLine [LineChunk \"(True,8,\\\"00000011\\\")\"]]" (DocTest.asPrint( test (-2::Int) )), DocTest.test "src/Flat/Instances/Base.hs:437" "[ExpectedLine [LineChunk \"(True,8,\\\"00000100\\\")\"]]" (DocTest.asPrint( test (2::Int) )), DocTest.test "src/Flat/Instances/Base.hs:450" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:453" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:456" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:459" "[ExpectedLine [LineChunk \"(True,8,\\\"00011111\\\")\"]]" (DocTest.asPrint( test (-(2^4)::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:462" "[ExpectedLine [LineChunk \"(True,8,\\\"00100000\\\")\"]]" (DocTest.asPrint( test (2^4::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:465" "[ExpectedLine [LineChunk \"(True,144,\\\"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (-(2^120)::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:468" "[ExpectedLine [LineChunk \"(True,144,\\\"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000100\\\")\"]]" (DocTest.asPrint( test (2^120::Integer) )), DocTest.test "src/Flat/Instances/Base.hs:479" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int8) )), DocTest.test "src/Flat/Instances/Base.hs:482" "[ExpectedLine [LineChunk \"(True,8,\\\"11111110\\\")\"]]" (DocTest.asPrint( test (127::Int8) )), DocTest.test "src/Flat/Instances/Base.hs:485" "[ExpectedLine [LineChunk \"(True,8,\\\"11111111\\\")\"]]" (DocTest.asPrint( test (-128::Int8) )), DocTest.test "src/Flat/Instances/Base.hs:496" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:499" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:502" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:505" "[ExpectedLine [LineChunk \"(True,24,\\\"11111111 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (minBound::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:510" "[ExpectedLine [LineChunk \"(True,24,\\\"11111110 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (maxBound::Int16) )), DocTest.test "src/Flat/Instances/Base.hs:523" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int32) )), DocTest.test "src/Flat/Instances/Base.hs:526" "[ExpectedLine [LineChunk \"(True,40,\\\"11111111 11111111 11111111 11111111 00001111\\\")\"]]" (DocTest.asPrint( test (minBound::Int32) )), DocTest.test "src/Flat/Instances/Base.hs:529" "[ExpectedLine [LineChunk \"(True,40,\\\"11111110 11111111 11111111 11111111 00001111\\\")\"]]" (DocTest.asPrint( test (maxBound::Int32) )), DocTest.test "src/Flat/Instances/Base.hs:540" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int64) )), DocTest.test "src/Flat/Instances/Base.hs:543" "[ExpectedLine [LineChunk \"(True,80,\\\"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001\\\")\"]]" (DocTest.asPrint( test (minBound::Int64) )), DocTest.test "src/Flat/Instances/Base.hs:546" "[ExpectedLine [LineChunk \"(True,80,\\\"11111110 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001\\\")\"]]" (DocTest.asPrint( test (maxBound::Int64) )), DocTest.test "src/Flat/Instances/Base.hs:565" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 00000000 00000000 00000000\\\")\"]]" (DocTest.asPrint( test (0::Float) )), DocTest.test "src/Flat/Instances/Base.hs:568" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 00000000 00000000 00000001\\\")\"]]" (DocTest.asPrint( test (1.4012984643E-45::Float) )), DocTest.test "src/Flat/Instances/Base.hs:571" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 01111111 11111111 11111111\\\")\"]]" (DocTest.asPrint( test (1.1754942107E-38::Float) )), DocTest.test "src/Flat/Instances/Base.hs:598" "[ExpectedLine [LineChunk \"(True,16,\\\"00000100 00000010\\\")\"]]" (DocTest.asPrint( test (4 :+ 2 :: Complex Word8) )), DocTest.test "src/Flat/Instances/Base.hs:606" "[ExpectedLine [LineChunk \"(True,16,\\\"00000011 00000100\\\")\"]]" (DocTest.asPrint( test (3%4::Ratio Word8) )), DocTest.test "src/Flat/Instances/Base.hs:618" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test ([]::[Bool]) )), DocTest.test "src/Flat/Instances/Base.hs:621" "[ExpectedLine [LineChunk \"(True,5,\\\"10100\\\")\"]]" (DocTest.asPrint( test [False,False] )), DocTest.test "src/Flat/Instances/Base.hs:655" "[ExpectedLine [LineChunk \"(True,2,\\\"10\\\")\"]]" (DocTest.asPrint( test (B.fromList [True]) )), DocTest.test "src/Flat/Instances/Base.hs:658" "[ExpectedLine [LineChunk \"(True,4,\\\"0100\\\")\"]]" (DocTest.asPrint( test (B.fromList [False,False]) )), DocTest.test "src/Flat/Instances/Base.hs:668" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test (False,()) )), DocTest.test "src/Flat/Instances/Base.hs:671" "[ExpectedLine [LineChunk \"(True,0,\\\"\\\")\"]]" (DocTest.asPrint( test ((),()) )), DocTest.test "src/Flat/Instances/Base.hs:676" "[ExpectedLine [LineChunk \"(True,7,\\\"0111011\\\")\"]]" (DocTest.asPrint( test (False,True,True,True,False,True,True) ))] diff --git a/test/DocTest/Flat/Instances/Text.hs b/test/DocTest/Flat/Instances/Text.hs --- a/test/DocTest/Flat/Instances/Text.hs +++ b/test/DocTest/Flat/Instances/Text.hs @@ -9,6 +9,7 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Word +tt t = let (ts,_,bs) = tst t in (ts,bs) tests :: IO TestTree -tests = testGroup "Flat.Instances.Text" <$> sequence [ DocTest.test "src/Flat/Instances/Text.hs:25" "[ExpectedLine [LineChunk \"(True,16,[1,0])\"]]" (DocTest.asPrint( tst $ T.pack "" )), DocTest.test "src/Flat/Instances/Text.hs:28" "[ExpectedLine [LineChunk \"(True,120,[1,3,97,97,97,0])\"]]" (DocTest.asPrint( tst $ T.pack "aaa" )), DocTest.test "src/Flat/Instances/Text.hs:31" "[ExpectedLine [LineChunk \"(True,120,[1,6,194,162,194,162,194,162,0])\"]]" (DocTest.asPrint( tst $ T.pack "¢¢¢" )), DocTest.test "src/Flat/Instances/Text.hs:34" "[ExpectedLine [LineChunk \"(True,120,[1,9,230,151,165,230,151,165,230,151,165,0])\"]]" (DocTest.asPrint( tst $ T.pack "日日日" )), DocTest.test "src/Flat/Instances/Text.hs:44" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( tst (T.pack "abc") == tst (TL.pack "abc") )), DocTest.test "src/Flat/Instances/Text.hs:62" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( tst (UTF8Text $ T.pack "日日日") == tst (T.pack "日日日") ))] +tests = testGroup "Flat.Instances.Text" <$> sequence [ DocTest.test "src/Flat/Instances/Text.hs:26" "[ExpectedLine [LineChunk \"(True,[1,0])\"]]" (DocTest.asPrint( tt $ T.pack "" )), DocTest.test "src/Flat/Instances/Text.hs:29" "[ExpectedLine [LineChunk \"(True,[1,3,97,97,97,0])\"]]" (DocTest.asPrint( tt $ T.pack "aaa" )), DocTest.test "src/Flat/Instances/Text.hs:32" "[ExpectedLine [LineChunk \"(True,[1,6,194,162,194,162,194,162,0])\"]]" (DocTest.asPrint( tt $ T.pack "¢¢¢" )), DocTest.test "src/Flat/Instances/Text.hs:35" "[ExpectedLine [LineChunk \"(True,[1,9,230,151,165,230,151,165,230,151,165,0])\"]]" (DocTest.asPrint( tt $ T.pack "日日日" )), DocTest.test "src/Flat/Instances/Text.hs:39" "[ExpectedLine [LineChunk \"(True,[1,12,240,144,141,136,240,144,141,136,240,144,141,136,0])\"]]" (DocTest.asPrint( tt $ T.pack "𐍈𐍈𐍈" )), DocTest.test "src/Flat/Instances/Text.hs:45" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( tst (T.pack "abc") == tst (TL.pack "abc") )), DocTest.test "src/Flat/Instances/Text.hs:63" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( tst (UTF8Text $ T.pack "日日日") == tst (T.pack "日日日") )), DocTest.test "src/Flat/Instances/Text.hs:76" "[ExpectedLine [LineChunk \"(True,[1,6,97,0,97,0,97,0,0])\"]]" (DocTest.asPrint( tt (UTF16Text $ T.pack "aaa") )), DocTest.test "src/Flat/Instances/Text.hs:79" "[ExpectedLine [LineChunk \"(True,[1,12,0,216,72,223,0,216,72,223,0,216,72,223,0])\"]]" (DocTest.asPrint( tt (UTF16Text $ T.pack "𐍈𐍈𐍈") ))] diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,61 +1,61 @@ -{-# LANGUAGE BinaryLiterals #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Tests for the flat module module Main where import Control.Monad import Data.Bits -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Short as SBS import Data.Char import Data.Either -import Flat -import Flat.Bits -import Flat.Decoder -import qualified Flat.Encoder as E -import qualified Flat.Encoder.Prim as E -import qualified Flat.Encoder.Strict as E +import Data.FloatCast import Data.Int import Data.Proxy -import qualified Data.Sequence as Seq -import Data.String (fromString) -import qualified Data.Text as T +import qualified Data.Sequence as Seq +import Data.String (fromString) +import qualified Data.Text as T +import Data.Text.Arbitrary import Data.Word +import Flat +import Flat.Bits +import Flat.Decoder +import qualified Flat.Encoder as E +import qualified Flat.Encoder.Prim as E +import qualified Flat.Encoder.Strict as E +import Flat.Endian import Numeric.Natural import System.Exit import Test.Data -import Test.Data.Arbitrary () +import Test.Data.Arbitrary () import Test.Data.Flat -import Test.Data.Values hiding (lbs, ns) +import Test.Data.Values hiding (lbs, ns) import Test.E -import Test.E.Arbitrary () +import Test.E.Arbitrary () import Test.E.Flat import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC hiding (getSize) -import Flat.Endian -import Data.FloatCast -import Data.Text.Arbitrary -- import Test.QuickCheck.Arbitrary -import qualified Data.Complex as B -import qualified Data.Ratio as B -import qualified Data.Map as C -import qualified Data.Map.Strict as CS -import qualified Data.Map.Lazy as CL -import qualified Data.IntMap.Strict as CS -import qualified Data.IntMap.Lazy as CL +import qualified Data.Complex as B +import qualified Data.IntMap.Lazy as CL +import qualified Data.IntMap.Strict as CS +import qualified Data.Map as C +import qualified Data.Map.Lazy as CL +import qualified Data.Map.Strict as CS +import qualified Data.Ratio as B -- import Data.List -- import Data.Ord #if MIN_VERSION_base(4,9,0) -import qualified Data.List.NonEmpty as BI +import qualified Data.List.NonEmpty as BI #endif instance Arbitrary UTF8Text where @@ -63,7 +63,7 @@ shrink t = UTF8Text <$> shrink (unUTF8 t) -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) +#if! defined (ETA_VERSION) instance Arbitrary UTF16Text where arbitrary = UTF16Text <$> arbitrary @@ -74,9 +74,6 @@ -- instance Flat [Word8] -- instance Flat [Bool] main = do - -- #ifdef ghcjs_HOST_OS - -- print "GHCJS" - -- #endif -- printInfo -- print $ flat asciiStrT mainTest @@ -96,16 +93,15 @@ tests = testGroup "Tests" [testPrimitives, testEncDec, testFlat] testPrimitives = - testGroup "conversion/memory primitives" [testEndian, testFloatingConvert] + testGroup "conversion/memory primitives" [testEndian, testFloatingConvert,testShifts ] - --,testShifts -- ghcjs fails this testEncDec = testGroup "encode/decode primitives" [ testEncodingPrim , testDecodingPrim -#ifdef TEST_DECBITS +#ifdef TEST_DECBITS , testDecBits -#endif +#endif ] testFlat = testGroup @@ -141,7 +137,6 @@ (unwords ["conv", sshow v, showB . flat $ v, "to", sshow e]) $ f v @?= e --- ghcjs bug on shiftR 0, see: https://github.com/ghcjs/ghcjs/issues/706 testShifts = testGroup "Shifts" $ map tst [0 .. 33] where tst n = testCase ("shiftR " ++ show n) @@ -262,7 +257,7 @@ return r -- we expect the first numBitsToTake bits of the value expectedD@(Right expected) :: Decoded a = Right - $ val `shR` (sz - numBitsToTake) -- ghcjs: shiftR fails, see: https://github.com/ghcjs/ghcjs/issues/706 + $ val `shR` (sz - numBitsToTake) actualD@(Right actual) :: Decoded a = unflatRawWith dec vs in testCase (unwords @@ -312,25 +307,31 @@ , sz bs (4 + 3 * 8) , sz stBS bsSize , sz lzBS bsSize -#ifndef ghcjs_HOST_OS , sz shBS bsSize -#endif , sz tx utf8Size , sz (UTF8Text tx) utf8Size -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) +#if ! defined (ETA_VERSION) , sz (UTF16Text tx) utf16Size #endif ] where tx = T.pack "txt" - utf8Size = 8 + 8 + 3 * 32 + 8 - +#if MIN_VERSION_text(2,0,0) + utf8Size = 8 + 8 + (3 * 8) + 8 +#else + utf8Size = 8 + 8 + (3 * 3 * 8) + 8 +#endif utf16Size = 8 + 8 + 3 * 16 + 8 bsSize = 8 + 8 + 3 * 8 + 8 -sz v e = [testCase (unwords ["size of", sshow v]) $ getSize v @?= e] +sz v e = let calculated = getSize v + actual = B.length (flat v) * 8 - 1 -- FIX + in + [testCase (unwords ["size of", sshow v]) $ calculated @?= e + -- ,testCase (unwords ["calculated size <= actual", sshow v]) $ actual <= calculated @? unwords ["calculated size",show calculated,"actual",show actual] + ] -- E258_256 = 11111110 _257 = 111111110 _258 = 111111111 testLargeEnum = testGroup "test enum with more than 256 constructors" @@ -371,7 +372,7 @@ , rt "String" (prop_Flat_roundtrip :: RT String) #if MIN_VERSION_base(4,9,0) , rt "NonEmpty" (prop_Flat_roundtrip :: RT (BI.NonEmpty Bool)) -#endif +#endif , rt "Maybe N" (prop_Flat_roundtrip :: RT (Maybe N)) , rt "Ratio" (prop_Flat_roundtrip :: RT (B.Ratio Int32)) , rt "Word8" (prop_Flat_Large_roundtrip :: RTL Word8) @@ -385,14 +386,12 @@ , rt "Double" (prop_Flat_roundtrip :: RT Double) , rt "Text" (prop_Flat_roundtrip :: RT T.Text) , rt "UTF8 Text" (prop_Flat_roundtrip :: RT UTF8Text) -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) +#if! defined (ETA_VERSION) , rt "UTF16 Text" (prop_Flat_roundtrip :: RT UTF16Text) #endif , rt "ByteString" (prop_Flat_roundtrip :: RT B.ByteString) , rt "Lazy ByteString" (prop_Flat_roundtrip :: RT L.ByteString) -#ifndef ghcjs_HOST_OS , rt "Short ByteString" (prop_Flat_roundtrip :: RT SBS.ShortByteString) -#endif , rt "Map.Strict" (prop_Flat_roundtrip :: RT (CS.Map Int Bool)) , rt "Map.Lazy" (prop_Flat_roundtrip :: RT (CL.Map Int Bool)) , rt "IntMap.Strict" (prop_Flat_roundtrip :: RT (CS.IntMap Bool)) @@ -635,13 +634,13 @@ , [trip (T.pack "abc")] , [trip unicodeText] , [trip unicodeTextUTF8T] - , [trip longBS, trip longLBS] -#ifndef ghcjs_HOST_OS - , [trip longSBS] -#endif -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) + , [trip chineseTextUTF8T] +#if ! defined (ETA_VERSION) + , [trip chineseTextUTF16T] , [trip unicodeTextUTF16T] #endif + , [trip longBS, trip longLBS] + , [trip longSBS] ] --al = (1:) -- prealign where @@ -732,11 +731,9 @@ nsI_ = [((-) (2 ^ (((-) i 1) * 7)) 1, fromIntegral (8 * i)) | i <- [1 .. 10]] -#ifndef ghcjs_HOST_OS shBS = SBS.toShort stBS longSBS = SBS.toShort longBS -#endif sshow = take 80 . show @@ -797,7 +794,7 @@ -- b1 :: BLOB UTF8 -- b1 = BLOB UTF8 (preAligned (List255 [97,98,99])) -- -- b1 = BLOB (preAligned (UTF8 (List255 [97,98,99]))) - - - - + + + + diff --git a/test/Test/Data/Values.hs b/test/Test/Data/Values.hs --- a/test/Test/Data/Values.hs +++ b/test/Test/Data/Values.hs @@ -11,10 +11,10 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Short.Internal as SBS import Data.Char -import Flat import Data.Foldable import Data.Int import qualified Data.IntMap as IM +import Flat -- import qualified Data.IntSet as IS -- import Data.List import qualified Data.Map as M @@ -191,9 +191,16 @@ unicodeTextUTF8T = ("unicodeTextUTF8",UTF8Text unicodeText) -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) +chineseTextUTF8T = ("chineseTextUTF8",UTF8Text chineseText) + +#if ! defined (ETA_VERSION) unicodeTextUTF16T = ("unicodeTextUTF16",UTF16Text unicodeText) +chineseTextUTF16T = ("chineseTextUTF16",UTF16Text chineseText) #endif + +-- chineseTextT = ("chineseText",chinesText) +chineseText = T.pack $ longS chinese + unicodeTextT = ("unicodeText",unicodeText) unicodeText = T.pack unicodeStr