Drop NFData constraint from compact.
[ghc.git] / libraries / compact / tests / compact_simple_array.hs
1 module Main where
2
3 import Control.Exception
4 import Control.Monad
5 import System.Mem
6
7 import Control.Monad.ST
8 import Data.Array
9 import Data.Array.ST
10 import qualified Data.Array.Unboxed as U
11
12 import Data.Compact
13 import Data.Compact.Internal
14
15 assertFail :: String -> IO ()
16 assertFail msg = throwIO $ AssertionFailed msg
17
18 assertEquals :: (Eq a, Show a) => a -> a -> IO ()
19 assertEquals expected actual =
20 if expected == actual then return ()
21 else assertFail $ "expected " ++ (show expected)
22 ++ ", got " ++ (show actual)
23
24 arrTest :: (Monad m, MArray a e m, Num e) => m (a Int e)
25 arrTest = do
26 arr <- newArray (1, 10) 0
27 forM_ [1..10] $ \j -> do
28 writeArray arr j (fromIntegral $ 2*j + 1)
29 return arr
30
31 -- test :: (Word -> a -> IO (Maybe (Compact a))) -> IO ()
32 test func = do
33 let fromList :: Array Int Int
34 fromList = listArray (1, 10) [1..]
35 frozen :: Array Int Int
36 frozen = runST $ do
37 arr <- arrTest :: ST s (STArray s Int Int)
38 freeze arr
39 stFrozen :: Array Int Int
40 stFrozen = runSTArray arrTest
41 unboxedFrozen :: U.UArray Int Int
42 unboxedFrozen = runSTUArray arrTest
43
44 let val = (fromList, frozen, stFrozen, unboxedFrozen)
45 str <- func val
46
47 -- check that val is still good
48 assertEquals (fromList, frozen, stFrozen, unboxedFrozen) val
49 -- check the value in the compact
50 assertEquals val (getCompact str)
51 performMajorGC
52 -- check again the value in the compact
53 assertEquals val (getCompact str)
54
55 main = do
56 test (compactSized 4096 True)
57 test (compactSized 4096 False)