ghcup-hs/3rdparty/lzma/src-tests/lzma-tests.hs
2020-05-10 13:12:39 +02:00

99 lines
3.8 KiB
Haskell

module Main (main) where
import Control.Applicative
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.List
import Data.Monoid
import Prelude
import Test.Tasty
import Test.Tasty.QuickCheck as QC
import Test.Tasty.HUnit
import Codec.Compression.Lzma as Lzma
main :: IO ()
main = defaultMain tests
-- this is supposed to be equivalent to 'id'
codecompress :: BL.ByteString -> BL.ByteString
codecompress = decompress . compress
newtype ZeroBS = ZeroBS BL.ByteString
instance Show ZeroBS where
show (ZeroBS s) | BL.length s > 0 = "ZeroBS (replicate " ++ show (BL.length s) ++ " " ++ show (BL.head s) ++ ")"
| otherwise = "ZeroBS (empty)"
instance Arbitrary ZeroBS where
arbitrary = do
len <- choose (0, 1*1024*1024) -- up to 1MiB
return $ (ZeroBS $ BL.replicate len 0)
-- shrink (ABS bs) = map ABS $ shrinks bs
randBS :: Int -> Gen BS.ByteString
randBS n = BS.pack `fmap` vectorOf n (choose (0, 255))
randBL :: Gen BL.ByteString
randBL = do
ns <- arbitrary
chunks <- mapM (randBS . (`mod` 10240)) ns
return $ BL.fromChunks chunks
newtype RandBLSm = RandBLSm BL.ByteString
deriving Show
newtype RandBL = RandBL BL.ByteString
deriving Show
instance Arbitrary RandBL where
arbitrary = RandBL <$> randBL
instance Arbitrary RandBLSm where
arbitrary = do
n <- choose (0,1024)
RandBLSm . BL.fromChunks . (:[]) <$> randBS n
tests :: TestTree
tests = testGroup "ByteString API" [unitTests, properties]
where
unitTests = testGroup "testcases"
[ testCase "decode-empty" $ decompress nullxz @?= BL.empty
, testCase "encode-empty" $ codecompress BL.empty @?= BL.empty
, testCase "encode-hello" $ codecompress (BL8.pack "hello") @?= BL8.pack "hello"
, testCase "encode-hello2" $ codecompress (singletonChunked $ BL8.pack "hello") @?= BL8.pack "hello"
, testCase "decode-sample" $ decompress samplexz @?= sampleref
, testCase "decode-sample2" $ decompress (singletonChunked samplexz) @?= sampleref
, testCase "encode-sample" $ codecompress sampleref @?= sampleref
, testCase "encode-empty^50" $ (iterate decompress (iterate (compressWith lowProf) (BL8.pack "") !! 50) !! 50) @?= BL8.pack ""
, testCase "encode-10MiB-zeros" $ let z = BL.replicate (10*1024*1024) 0 in codecompress z @?= z
]
properties = testGroup "properties"
[ QC.testProperty "decompress . compress === id (zeros)" $
\(ZeroBS bs) -> codecompress bs == bs
, QC.testProperty "decompress . compress === id (chunked)" $
\(RandBL bs) -> codecompress bs == bs
, QC.testProperty "decompress . (compress a <> compress b) === a <> b" $
\(RandBLSm a) (RandBLSm b) -> decompress (compress a `mappend` compress b) == a `mappend` b
]
lowProf = defaultCompressParams { compressLevel = CompressionLevel0 }
nullxz :: BL.ByteString
nullxz = BL.pack [253,55,122,88,90,0,0,4,230,214,180,70,0,0,0,0,28,223,68,33,31,182,243,125,1,0,0,0,0,4,89,90]
samplexz :: BL.ByteString
samplexz = BL.pack [253,55,122,88,90,0,0,4,230,214,180,70,2,0,33,1,16,0,0,0,168,112,142,134,224,1,149,0,44,93,0,42,26,9,39,100,25,234,181,131,189,58,102,36,15,228,64,252,88,41,53,203,78,255,4,93,168,153,174,39,186,76,120,56,49,148,191,144,96,136,20,247,240,0,0,0,157,204,158,16,53,174,37,20,0,1,72,150,3,0,0,0,130,33,173,108,177,196,103,251,2,0,0,0,0,4,89,90]
singletonChunked :: BL.ByteString -> BL.ByteString
singletonChunked = BL.fromChunks . map BS.singleton . BL.unpack
sampleref :: BL.ByteString
sampleref = BL.concat (intersperse (BL8.pack " ") $ replicate 11 $ BL8.pack "This sentence occurs multiple times.")