+
+createMemoryManager :: Property
+createMemoryManager = monadicIO $ run f >>= (assert . (==0))
+ where f :: IO Int
+ f = do twoSpace <- initTwoSpace 0x10000
+ evalStateT heapSize twoSpace
+
+
+createObject :: Int -> IO (Ptr a)
+createObject children = do mem <- mallocBytes (0x10 + 0x4 * children)
+ pokeArray mem [0,fromIntegral children,0::Int32,0]
+ fields <- replicateM children (createObject 0)
+ pokeArray (mem `plusPtr` fieldsOff) (fields :: [Ptr Int32])
+ return $ cast mem
+
+data ObjectTree = Node [ObjectTree] deriving Show
+
+instance Arbitrary ObjectTree where
+ arbitrary = resize 8 ( sized $ \n ->
+ do empty <- choose (0,100) :: Gen Int-- [True,False]
+ if empty < 80 then return $ Node []
+ else do k <- choose (0,n)
+ liftM Node $ sequence [ arbitrary | _ <- [1..k] ] )
+
+createObjects :: ObjectTree -> IO (Ptr a)
+createObjects (Node xs) = do let children = length xs
+ mem <- mallocBytes (0x10 + 0x4 * children)
+ pokeArray mem [0,fromIntegral children,0::Int32,0]
+ fields <- mapM createObjects xs
+ pokeArray (mem `plusPtr` fieldsOff) (fields :: [Ptr Int32])
+ return $ cast mem
+
+
+testObjectTree :: ObjectTree -> Property
+testObjectTree objTree = monadicIO $ run f >>= (assert . (==0))
+ where f :: IO Int
+ f = do root <- createObjects objTree
+ twoSpace <- initTwoSpace 0x1000
+ let collection = performCollection [root]
+ runStateT collection twoSpace
+ evalStateT heapSize twoSpace