Drop NFData constraint from compact.
[ghc.git] / libraries / compact / tests / compact_loop.hs
1 module Main where
2
3 import Control.Exception
4 import System.Mem
5 import Text.Show
6
7 import Data.Compact
8 import Data.Compact.Internal
9
10 assertFail :: String -> IO ()
11 assertFail msg = throwIO $ AssertionFailed msg
12
13 assertEquals :: (Eq a, Show a) => a -> a -> IO ()
14 assertEquals expected actual =
15 if expected == actual then return ()
16 else assertFail $ "expected " ++ (show expected)
17 ++ ", got " ++ (show actual)
18
19 data Tree = Nil | Node Tree Tree Tree
20
21 instance Eq Tree where
22 Nil == Nil = True
23 Node _ l1 r1 == Node _ l2 r2 = l1 == l2 && r1 == r2
24 _ == _ = False
25
26 instance Show Tree where
27 showsPrec _ Nil = showString "Nil"
28 showsPrec _ (Node _ l r) = showString "(Node " . shows l .
29 showString " " . shows r . showString ")"
30
31 {-# NOINLINE test #-}
32 test x = do
33 let a = Node Nil x b
34 b = Node a Nil Nil
35 str <- compactSized 4096 True a
36
37 -- check the value in the compact
38 assertEquals a (getCompact str)
39 performMajorGC
40 -- check again the value in the compact
41 assertEquals a (getCompact str)
42
43 main = test Nil