diff options
author | Matthew Craven <5086-clyring@users.noreply.gitlab.haskell.org> | 2022-06-02 19:24:00 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-06-22 08:22:12 -0400 |
commit | 2004e3c87b6b1e486d83fefb6d187039ad461093 (patch) | |
tree | 6c8f4c98da8e8721899c3aa1a4b5dbfdd1bdfccf | |
parent | 4ccefc6ea83073319c59690e340916175087dace (diff) | |
download | haskell-2004e3c87b6b1e486d83fefb6d187039ad461093.tar.gz |
Add a basic test for ByteArray's Monoid instance
-rw-r--r-- | testsuite/tests/lib/base/Monoid_ByteArray.hs | 83 | ||||
-rw-r--r-- | testsuite/tests/lib/base/all.T | 1 |
2 files changed, 84 insertions, 0 deletions
diff --git a/testsuite/tests/lib/base/Monoid_ByteArray.hs b/testsuite/tests/lib/base/Monoid_ByteArray.hs new file mode 100644 index 0000000000..0fe9e91a8b --- /dev/null +++ b/testsuite/tests/lib/base/Monoid_ByteArray.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DerivingVia, TypeApplications, OverloadedLists #-} + +module Main where + +import Control.Exception +import Control.Monad +import Data.Array.Byte +import Data.Bits +import Data.Either +import Data.List (tails) +import Data.Ord +import Data.Semigroup +import GHC.Exts (IsList(..)) + + +newtype Tricky = Tricky Int + deriving (Eq, Num, Real, Enum, Integral) via Int + deriving Ord via Down Int + +smallArrs :: [ByteArray] +-- 40 arrays, of total length 600 +smallArrs = [[], [3,8,1], [0], [255], [1,6,1,8,2]] ++ + map fromList (replicate 29 0 : tails [0..32]) + +shouldError :: a -> IO () -> IO () +shouldError val ifNoError = do + res <- try @ErrorCall (evaluate val) + when (isRight res) ifNoError + +testConcat :: [ByteArray] -> IO () +testConcat arrs = do + let lis = map toList arrs + expected = mconcat lis + actual = toList (mconcat arrs) + when (expected /= actual) $ + putStrLn $ unwords ["mconcat", show lis, "/=", show actual] + +main :: IO () +main = do + when (toList @ByteArray mempty /= []) $ + putStrLn "mempty /= []" + + -- test <> + forM_ smallArrs $ \x -> do + let xli = toList x + forM_ smallArrs $ \y -> do + let yli = toList y + expected = xli <> yli + actual = toList (x <> y) + when (expected /= actual) $ + putStrLn $ unwords [show xli, "<>", show yli, "/=", show actual] + + -- test stimes + forM_ smallArrs $ \x -> do + let xli = toList x + shouldError (stimes (-1 :: Integer) x) $ + putStrLn $ unwords ["stimes (-1 :: Integer)", show xli, "didn't fail??"] + shouldError (stimes (-1 :: Tricky) x) $ + putStrLn $ unwords ["stimes (-1 :: Tricky)", show xli, "didn't fail??"] + when (length xli > 1) $ shouldError (stimes (maxBound @Int) x) $ + putStrLn $ unwords ["stimes (maxBound @Int)", show xli, "didn't fail??"] + forM_ (10000 : [0 :: Int .. 32]) $ \n -> do + let expected = stimes n xli + actual = toList (stimes n x) + when (expected /= actual) $ + putStrLn $ unwords ["stimes", show n, show xli, "/=", show actual] + evaluate $ stimes @ByteArray @Int maxBound [] + evaluate $ stimes @ByteArray @Integer (10^100) [] + + -- test mconcat + testConcat [] + forM_ smallArrs $ \x -> do + testConcat [x] + forM_ smallArrs $ \y -> do + testConcat [x, y] + forM_ smallArrs $ \z -> do -- OK, 40^3 = 64K + testConcat [x, y, z] + + -- test mconcat's overflow-handling + let bigArr = stimes (bit 18 :: Int) [0] :: ByteArray + when (finiteBitSize @Int 0 == 32) $ + shouldError (mconcat $ replicate (bit 14) bigArr) $ + putStrLn "Impossible mconcat succeeded???" diff --git a/testsuite/tests/lib/base/all.T b/testsuite/tests/lib/base/all.T index 18c3f5814f..5e3cf28f68 100644 --- a/testsuite/tests/lib/base/all.T +++ b/testsuite/tests/lib/base/all.T @@ -7,3 +7,4 @@ test('T19691', normal, compile, ['']) test('executablePath', extra_run_opts(config.os), compile_and_run, ['']) test('T17472', normal, compile_and_run, ['']) test('T19569b', normal, compile_and_run, ['']) +test('Monoid_ByteArray', normal, compile_and_run, ['']) |