1 files changed, 38 insertions, 0 deletions
diff --git a/libraries/ghc-compact/tests/compact_append.hs b/libraries/ghc-compact/tests/compact_append.hs
new file mode 100644
index 0000000000..274c0bf429
--- /dev/null
+++ b/libraries/ghc-compact/tests/compact_append.hs
@@ -0,0 +1,38 @@
+module Main where
+
+import Control.Exception
+import System.Mem
+
+import GHC.Compact
+
+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)
+
+main = do
+  let val = ("hello", Just 42) :: (String, Maybe Int)
+  str <- compactWithSharing val
+
+  let val2 = ("world", 42) :: (String, Int)
+  str2 <- compactAddWithSharing str val2
+
+  -- check that values where not corrupted
+  assertEquals ("hello", Just 42) val
+  assertEquals ("world", 42) val2
+  -- check the values in the compact
+  assertEquals ("hello", Just 42) (getCompact str)
+  assertEquals ("world", 42) (getCompact str2)
+
+  performMajorGC
+
+  -- same checks again
+  assertEquals ("hello", Just 42) val
+  assertEquals ("world", 42) val2
+  -- check the values in the compact
+  assertEquals ("hello", Just 42) (getCompact str)
+  assertEquals ("world", 42) (getCompact str2)