Add tests for heapview

4 files changed, 88 insertions, 0 deletions

diff --git a/libraries/heapview/tests/Makefile b/libraries/heapview/tests/Makefile
new file mode 100644
index 0000000000..6a0abcf1cf
--- /dev/null
+++ b/libraries/heapview/tests/Makefile
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/libraries/heapview/tests/all.T b/libraries/heapview/tests/all.T
new file mode 100644
index 0000000000..63b757173b
--- /dev/null
+++ b/libraries/heapview/tests/all.T
@@ -0,0 +1,3 @@
+setTestOpts(extra_ways(['sanity']))
+
+test('heapview_all', normal, compile_and_run, [''])
diff --git a/libraries/heapview/tests/heapview_all.hs b/libraries/heapview/tests/heapview_all.hs
new file mode 100644
index 0000000000..7e4b773888
--- /dev/null
+++ b/libraries/heapview/tests/heapview_all.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE MagicHash, BangPatterns #-}
+{-# OPTIONS_GHC -Wall #-}
+
+import GHC.Exts
+import GHC.HeapView
+import Control.DeepSeq
+
+import System.Environment
+import System.Mem
+
+import Control.Monad
+
+main :: IO ()
+main = do
+    args <- map length `fmap` getArgs
+    let list2 = 4:list
+    (list ++ list2 ++ args) `deepseq` pure ()
+
+    let x = list ++ list2 ++ args
+    performGC
+    getClosureAssert list >>= \ cl ->
+        unless (name cl == ":") $ fail "Wrong name"
+
+    getClosureAssert list2 >>= \ cl -> do
+        eq <- areBoxesEqual (ptrArgs cl !! 1) (asBox list)
+        unless eq $ fail "Doesn't reference list"
+
+    getClosureData args >>= \ cl ->
+        unless (tipe (info cl) == CONSTR_0_1) $
+            fail $ "Not a CONSTR_0_1"
+
+    getClosureData x >>= \ cl ->
+        unless (tipe (info cl) == THUNK_2_0) $ do
+            fail "Not a THUNK_2_0"
+
+
+    let !(I# m) = length args + 42
+    let !(I# m') = length args + 23
+    let f = \ y n -> take (I# m + I# y) n ++ args
+        t = f m' list2
+
+    getClosureData f >>= \ cl -> do
+        unless (tipe (info cl) == FUN_1_1) $ do
+            fail "Not a FUN_1_1"
+        unless (dataArgs cl == [42]) $ do
+            fail "Wrong data arg"
+
+    getClosureData t >>= \ cl -> do
+        unless (tipe (info cl) == THUNK) $ do
+            fail "Not a THUNK"
+        unless (dataArgs cl == [23]) $ do
+            fail "Wrong data arg"
+
+        eq <- areBoxesEqual (ptrArgs cl !! 1) (asBox f)
+        unless eq $ fail "t doesnt reference f"
+
+    let z = id (:) () z
+    z `seq` pure ()
+    performGC
+    getClosureAssert z >>= \ cl -> do
+        eq <- areBoxesEqual (ptrArgs cl !! 1) (asBox z)
+        unless eq $
+            fail "z doesnt reference itself"
+
+    putStrLn "Done. No errors."
+
+
+list :: [Int]
+list = [1,2,3]
+
+
+getClosureAssert :: a -> IO Closure
+getClosureAssert x = do
+    cl <- getClosureData x
+    case cl of
+        ConsClosure {} -> pure cl
+        _ -> fail "Expected ConsClosure"
diff --git a/libraries/heapview/tests/heapview_all.stdout b/libraries/heapview/tests/heapview_all.stdout
new file mode 100644
index 0000000000..b747b9bd7b
--- /dev/null
+++ b/libraries/heapview/tests/heapview_all.stdout
@@ -0,0 +1 @@
+Done. No errors.