diff options
Diffstat (limited to 'libraries/compact/tests')
28 files changed, 256 insertions, 20 deletions
diff --git a/libraries/compact/tests/.gitignore b/libraries/compact/tests/.gitignore index c20cf7d4be..8887a1bbea 100644 --- a/libraries/compact/tests/.gitignore +++ b/libraries/compact/tests/.gitignore @@ -1,6 +1,3 @@ -*.stderr -!compact_serialize.stderr -*.stdout .hpc.* *.eventlog *.genscript diff --git a/libraries/compact/tests/all.T b/libraries/compact/tests/all.T index fd543142e9..bdcf522cf6 100644 --- a/libraries/compact/tests/all.T +++ b/libraries/compact/tests/all.T @@ -1,6 +1,19 @@ -test('compact_simple', omit_ways(['ghci']), compile_and_run, ['']) -test('compact_loop', omit_ways(['ghci']), compile_and_run, ['']) -test('compact_append', omit_ways(['ghci']), compile_and_run, ['']) -test('compact_autoexpand', omit_ways(['ghci']), compile_and_run, ['']) -test('compact_simple_array', omit_ways(['ghci']), compile_and_run, ['']) -test('compact_serialize', omit_ways(['ghci']), compile_and_run, [''])
\ No newline at end of file +setTestOpts(extra_ways(['sanity'])) + +test('compact_simple', normal, compile_and_run, ['']) +test('compact_loop', normal, compile_and_run, ['']) +test('compact_append', normal, compile_and_run, ['']) +test('compact_autoexpand', normal, compile_and_run, ['']) +test('compact_simple_array', normal, compile_and_run, ['']) +test('compact_huge_array', normal, compile_and_run, ['']) +test('compact_serialize', normal, compile_and_run, ['']) +test('compact_largemap', normal, compile_and_run, ['']) +test('compact_threads', [ extra_run_opts('1000') ], compile_and_run, ['']) +test('compact_cycle', extra_run_opts('+RTS -K1m'), compile_and_run, ['']) +test('compact_function', exit_code(1), compile_and_run, ['']) +test('compact_mutable', exit_code(1), compile_and_run, ['']) +test('compact_pinned', exit_code(1), compile_and_run, ['']) +test('compact_gc', normal, compile_and_run, ['']) +test('compact_share', normal, compile_and_run, ['']) +test('compact_bench', [ ignore_stdout, extra_run_opts('100') ], + compile_and_run, ['']) diff --git a/libraries/compact/tests/compact_append.hs b/libraries/compact/tests/compact_append.hs index 59f86777b7..e61262eea6 100644 --- a/libraries/compact/tests/compact_append.hs +++ b/libraries/compact/tests/compact_append.hs @@ -16,10 +16,10 @@ assertEquals expected actual = main = do let val = ("hello", Just 42) :: (String, Maybe Int) - str <- newCompact 4096 val + str <- compactWithSharing val let val2 = ("world", 42) :: (String, Int) - str2 <- appendCompact str val2 + str2 <- compactAddWithSharing str val2 -- check that values where not corrupted assertEquals ("hello", Just 42) val diff --git a/libraries/compact/tests/compact_autoexpand.hs b/libraries/compact/tests/compact_autoexpand.hs index 5db0bbc55f..5134380777 100644 --- a/libraries/compact/tests/compact_autoexpand.hs +++ b/libraries/compact/tests/compact_autoexpand.hs @@ -4,6 +4,7 @@ import Control.Exception import System.Mem import Data.Compact +import Data.Compact.Internal assertFail :: String -> IO () assertFail msg = throwIO $ AssertionFailed msg @@ -21,7 +22,7 @@ main = do -- so total 3072 words, 12288 bytes on x86, 24576 on x86_64 -- it should not fit in one block let val = replicate 4096 7 :: [Int] - str <- newCompact 1 val + str <- compactSized 1 True val assertEquals val (getCompact str) performMajorGC assertEquals val (getCompact str) diff --git a/libraries/compact/tests/compact_bench.hs b/libraries/compact/tests/compact_bench.hs new file mode 100644 index 0000000000..3764c3e3e1 --- /dev/null +++ b/libraries/compact/tests/compact_bench.hs @@ -0,0 +1,28 @@ +import Control.Exception +import Data.Compact +import Data.Compact.Internal +import qualified Data.Map as Map +import Data.Time.Clock +import Text.Printf +import System.Environment +import System.Mem +import Control.DeepSeq + +-- Benchmark compact against compactWithSharing. e.g. +-- ./compact_bench 1000000 + +main = do + [n] <- map read <$> getArgs + let m = Map.fromList [(x,[x*1000..x*1000+10]) | x <- [1..(n::Integer)]] + evaluate (force m) + timeIt "compact" $ compact m >>= compactSize >>= print + timeIt "compactWithSharing" $ compactWithSharing m >>= compactSize >>= print + +timeIt :: String -> IO a -> IO a +timeIt str io = do + performMajorGC + t0 <- getCurrentTime + a <- io + t1 <- getCurrentTime + printf "%s: %.2f\n" str (realToFrac (t1 `diffUTCTime` t0) :: Double) + return a diff --git a/libraries/compact/tests/compact_bytestring.hs b/libraries/compact/tests/compact_bytestring.hs new file mode 100644 index 0000000000..16c486ba58 --- /dev/null +++ b/libraries/compact/tests/compact_bytestring.hs @@ -0,0 +1,8 @@ +import qualified Data.ByteString.Char8 as B +import Data.Compact +import Data.Compact.Internal +import qualified Data.Map as Map + +main = do + c <- compact (Map.fromList [(B.pack (show x), x) | x <- [1..(10000::Int)]]) + print (getCompact c) diff --git a/libraries/compact/tests/compact_cycle.hs b/libraries/compact/tests/compact_cycle.hs new file mode 100644 index 0000000000..4c771a1d34 --- /dev/null +++ b/libraries/compact/tests/compact_cycle.hs @@ -0,0 +1,10 @@ +import Control.Exception +import Data.Compact +import Data.Compact.Internal +import qualified Data.Map as Map +import System.Exit + +main = do + c <- compactWithSharing (cycle "abc") -- magic! + print (length (show (take 100 (getCompact c)))) + print =<< compactSize c diff --git a/libraries/compact/tests/compact_cycle.stdout b/libraries/compact/tests/compact_cycle.stdout new file mode 100644 index 0000000000..6fc8a53046 --- /dev/null +++ b/libraries/compact/tests/compact_cycle.stdout @@ -0,0 +1,2 @@ +102 +32768 diff --git a/libraries/compact/tests/compact_function.hs b/libraries/compact/tests/compact_function.hs new file mode 100644 index 0000000000..fc4f4ca172 --- /dev/null +++ b/libraries/compact/tests/compact_function.hs @@ -0,0 +1,10 @@ +import Control.DeepSeq +import Control.Exception +import Data.Compact + +data HiddenFunction = HiddenFunction (Int -> Int) + +instance NFData HiddenFunction where + rnf x = x `seq` () -- ignore the function inside + +main = compact (HiddenFunction (+1)) diff --git a/libraries/compact/tests/compact_function.stderr b/libraries/compact/tests/compact_function.stderr new file mode 100644 index 0000000000..197da0460b --- /dev/null +++ b/libraries/compact/tests/compact_function.stderr @@ -0,0 +1 @@ +compact_function: compaction failed: cannot compact functions diff --git a/libraries/compact/tests/compact_gc.hs b/libraries/compact/tests/compact_gc.hs new file mode 100644 index 0000000000..a88e87d958 --- /dev/null +++ b/libraries/compact/tests/compact_gc.hs @@ -0,0 +1,12 @@ +import Control.Monad +import Data.Compact +import Data.Compact.Internal +import qualified Data.Map as Map + +main = do + let m = Map.fromList [(x,show x) | x <- [1..(10000::Int)]] + c <- compactWithSharing m + print =<< compactSize c + c <- foldM (\c _ -> do c <- compactWithSharing (getCompact c); print =<< compactSize c; return c) c [1..10] + print (length (show (getCompact c))) + print =<< compactSize c diff --git a/libraries/compact/tests/compact_gc.stdout b/libraries/compact/tests/compact_gc.stdout new file mode 100644 index 0000000000..c44d58836d --- /dev/null +++ b/libraries/compact/tests/compact_gc.stdout @@ -0,0 +1,13 @@ +2228224 +2228224 +2228224 +2228224 +2228224 +2228224 +2228224 +2228224 +2228224 +2228224 +2228224 +137798 +2228224 diff --git a/libraries/compact/tests/compact_huge_array.hs b/libraries/compact/tests/compact_huge_array.hs new file mode 100644 index 0000000000..8a8374297b --- /dev/null +++ b/libraries/compact/tests/compact_huge_array.hs @@ -0,0 +1,61 @@ +module Main where + +import Control.Exception +import Control.Monad +import System.Mem + +import Control.Monad.ST +import Data.Array +import Data.Array.ST +import qualified Data.Array.Unboxed as U +import Control.DeepSeq + +import Data.Compact +import Data.Compact.Internal + +assertFail :: String -> IO () +assertFail msg = throwIO $ AssertionFailed msg + +assertEquals :: (Eq a, Show a) => a -> a -> IO () +assertEquals expected actual = + if expected == actual then return () + else assertFail $ "expected " ++ (show expected) + ++ ", got " ++ (show actual) + +arrTest :: (Monad m, MArray a e m, Num e) => m (a Int e) +arrTest = do + arr <- newArray (1, 10) 0 + forM_ [1..10] $ \j -> do + writeArray arr j (fromIntegral $ 2*j + 1) + return arr + +instance NFData (U.UArray i e) where + rnf x = seq x () + +-- test :: (Word -> a -> IO (Maybe (Compact a))) -> IO () +test func = do + let fromList :: Array Int Int + fromList = listArray (1, 300000) [1..] + frozen :: Array Int Int + frozen = runST $ do + arr <- arrTest :: ST s (STArray s Int Int) + freeze arr + stFrozen :: Array Int Int + stFrozen = runSTArray arrTest + unboxedFrozen :: U.UArray Int Int + unboxedFrozen = runSTUArray arrTest + + let val = (fromList, frozen, stFrozen, unboxedFrozen) + str <- func val + + -- check that val is still good + assertEquals (fromList, frozen, stFrozen, unboxedFrozen) val + -- check the value in the compact + assertEquals val (getCompact str) + performMajorGC + -- check again the value in the compact + assertEquals val (getCompact str) + +main = do + test (compactSized 4096 True) + test (compactSized 4096 False) diff --git a/libraries/compact/tests/compact_largemap.hs b/libraries/compact/tests/compact_largemap.hs new file mode 100644 index 0000000000..0c72a32c75 --- /dev/null +++ b/libraries/compact/tests/compact_largemap.hs @@ -0,0 +1,10 @@ +import Data.Compact +import Data.Compact.Internal +import qualified Data.Map as Map + +main = do + let m = Map.fromList [(x,show x) | x <- [1..(10000::Integer)]] + c <- compactWithSharing m + print (length (show (getCompact c))) + c <- compact m + print (length (show (getCompact c))) diff --git a/libraries/compact/tests/compact_largemap.stdout b/libraries/compact/tests/compact_largemap.stdout new file mode 100644 index 0000000000..4825984a93 --- /dev/null +++ b/libraries/compact/tests/compact_largemap.stdout @@ -0,0 +1,2 @@ +137798 +137798 diff --git a/libraries/compact/tests/compact_loop.hs b/libraries/compact/tests/compact_loop.hs index 0111fc1bdb..c8991b05d0 100644 --- a/libraries/compact/tests/compact_loop.hs +++ b/libraries/compact/tests/compact_loop.hs @@ -6,6 +6,7 @@ import System.Mem import Text.Show import Data.Compact +import Data.Compact.Internal assertFail :: String -> IO () assertFail msg = throwIO $ AssertionFailed msg @@ -36,7 +37,7 @@ instance NFData Tree where test x = do let a = Node Nil x b b = Node a Nil Nil - str <- newCompact 4096 a + str <- compactSized 4096 True a -- check the value in the compact assertEquals a (getCompact str) diff --git a/libraries/compact/tests/compact_mutable.hs b/libraries/compact/tests/compact_mutable.hs new file mode 100644 index 0000000000..2d1a7f2572 --- /dev/null +++ b/libraries/compact/tests/compact_mutable.hs @@ -0,0 +1,13 @@ +import Control.Concurrent +import Control.DeepSeq +import Control.Exception +import Data.Compact + +data HiddenMVar = HiddenMVar (MVar ()) + +instance NFData HiddenMVar where + rnf x = x `seq` () -- ignore the function inside + +main = do + m <- newEmptyMVar + compact (HiddenMVar m) diff --git a/libraries/compact/tests/compact_mutable.stderr b/libraries/compact/tests/compact_mutable.stderr new file mode 100644 index 0000000000..9a4bd2892e --- /dev/null +++ b/libraries/compact/tests/compact_mutable.stderr @@ -0,0 +1 @@ +compact_mutable: compaction failed: cannot compact mutable objects diff --git a/libraries/compact/tests/compact_pinned.hs b/libraries/compact/tests/compact_pinned.hs new file mode 100644 index 0000000000..a2a45bb7b9 --- /dev/null +++ b/libraries/compact/tests/compact_pinned.hs @@ -0,0 +1,6 @@ +import Control.DeepSeq +import Control.Exception +import qualified Data.ByteString.Char8 as B +import Data.Compact + +main = compact (B.pack "abc") diff --git a/libraries/compact/tests/compact_pinned.stderr b/libraries/compact/tests/compact_pinned.stderr new file mode 100644 index 0000000000..1f470a0d49 --- /dev/null +++ b/libraries/compact/tests/compact_pinned.stderr @@ -0,0 +1 @@ +compact_pinned: compaction failed: cannot compact pinned objects diff --git a/libraries/compact/tests/compact_serialize.hs b/libraries/compact/tests/compact_serialize.hs index e4ba88ea9e..2b831e048c 100644 --- a/libraries/compact/tests/compact_serialize.hs +++ b/libraries/compact/tests/compact_serialize.hs @@ -10,6 +10,7 @@ import Foreign.Ptr import Control.DeepSeq import Data.Compact +import Data.Compact.Internal import Data.Compact.Serialized assertFail :: String -> IO () @@ -23,7 +24,7 @@ assertEquals expected actual = serialize :: NFData a => a -> IO (SerializedCompact a, [ByteString]) serialize val = do - cnf <- newCompact 4096 val + cnf <- compactSized 4096 True val bytestrref <- newIORef undefined scref <- newIORef undefined diff --git a/libraries/compact/tests/compact_share.hs b/libraries/compact/tests/compact_share.hs new file mode 100644 index 0000000000..73654e430b --- /dev/null +++ b/libraries/compact/tests/compact_share.hs @@ -0,0 +1,14 @@ +import Data.Compact +import Data.Compact.Internal +import qualified Data.Map as Map + +main = do + let m1 = Map.fromList [(x,show x) | x <- [1..(10000::Integer)]] + m2 = Map.fromList [(x,y) | x <- [1..(10000::Integer)], + Just y <- [Map.lookup x m1]] + c <- compact (m1,m2) + print (length (show (getCompact c))) + print =<< compactSize c + c <- compactWithSharing (m1,m2) + print (length (show (getCompact c))) + print =<< compactSize c diff --git a/libraries/compact/tests/compact_share.stdout b/libraries/compact/tests/compact_share.stdout new file mode 100644 index 0000000000..0969fdf956 --- /dev/null +++ b/libraries/compact/tests/compact_share.stdout @@ -0,0 +1,4 @@ +275599 +3801088 +275599 +2228224 diff --git a/libraries/compact/tests/compact_simple.hs b/libraries/compact/tests/compact_simple.hs index c4cfbbd151..83b24da4e7 100644 --- a/libraries/compact/tests/compact_simple.hs +++ b/libraries/compact/tests/compact_simple.hs @@ -18,7 +18,7 @@ assertEquals expected actual = test func = do let val = ("hello", 1, 42, 42, Just 42) :: (String, Int, Int, Integer, Maybe Int) - str <- func 4096 val + str <- func val -- check that val is still good assertEquals ("hello", 1, 42, 42, Just 42) val @@ -30,6 +30,8 @@ test func = do -- check again the value in the compact assertEquals ("hello", 1, 42, 42, Just 42) (getCompact str) + print =<< compactSize str + main = do - test newCompact - test newCompactNoShare + test compactWithSharing + test compact diff --git a/libraries/compact/tests/compact_simple.stdout b/libraries/compact/tests/compact_simple.stdout new file mode 100644 index 0000000000..5549a58580 --- /dev/null +++ b/libraries/compact/tests/compact_simple.stdout @@ -0,0 +1,2 @@ +32768 +32768 diff --git a/libraries/compact/tests/compact_simple_array.hs b/libraries/compact/tests/compact_simple_array.hs index 7b194867de..69421c5137 100644 --- a/libraries/compact/tests/compact_simple_array.hs +++ b/libraries/compact/tests/compact_simple_array.hs @@ -11,6 +11,7 @@ import qualified Data.Array.Unboxed as U import Control.DeepSeq import Data.Compact +import Data.Compact.Internal assertFail :: String -> IO () assertFail msg = throwIO $ AssertionFailed msg @@ -45,7 +46,7 @@ test func = do unboxedFrozen = runSTUArray arrTest let val = (fromList, frozen, stFrozen, unboxedFrozen) - str <- func 4096 val + str <- func val -- check that val is still good assertEquals (fromList, frozen, stFrozen, unboxedFrozen) val @@ -56,5 +57,5 @@ test func = do assertEquals val (getCompact str) main = do - test newCompact - test newCompactNoShare + test (compactSized 4096 True) + test (compactSized 4096 False) diff --git a/libraries/compact/tests/compact_threads.hs b/libraries/compact/tests/compact_threads.hs new file mode 100644 index 0000000000..99d6fe2409 --- /dev/null +++ b/libraries/compact/tests/compact_threads.hs @@ -0,0 +1,21 @@ +import Control.Concurrent +import Control.Monad +import Data.Compact +import Data.Compact.Internal +import qualified Data.Map as Map +import Data.Maybe +import System.Environment + +main = do + [n] <- map read <$> getArgs + c <- compact () + as <- forM [1..(n::Int)] $ \i -> async (compactAdd c (Just i)) + bs <- forM as $ \a -> async (getCompact <$> takeMVar a) + xs <- mapM takeMVar bs + print (sum (catMaybes xs)) + +async :: IO a -> IO (MVar a) +async io = do + m <- newEmptyMVar + forkIO (io >>= putMVar m) + return m diff --git a/libraries/compact/tests/compact_threads.stdout b/libraries/compact/tests/compact_threads.stdout new file mode 100644 index 0000000000..837e12b406 --- /dev/null +++ b/libraries/compact/tests/compact_threads.stdout @@ -0,0 +1 @@ +500500 |