[Git][ghc/ghc][wip/ghc-debug] Assert various fields of TSOClosure and StackClosure

[Sven Tennie]

Sven Tennie pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC


Commits:
bd2c787f by Sven Tennie at 2020-06-05T07:55:25+02:00
Assert various fields of TSOClosure and StackClosure

This makes sure ghc-heap decodes StgTSO and StgStack correctly.

To assert - otherwise dynamic - properties, a new, non-running TSO is
created in create_tso() (create_tso.c).

- - - - -


1 changed file:

- libraries/ghc-heap/tests/tso_and_stack_closures.hs


Changes:

=====================================
libraries/ghc-heap/tests/tso_and_stack_closures.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE ForeignFunctionInterface, MagicHash, CPP #-}
+{-# LANGUAGE ForeignFunctionInterface, MagicHash, CPP, BangPatterns #-}
 
 import Foreign
 import Foreign.C.Types
@@ -20,18 +20,48 @@ data FoolStgTSO
 
 main :: IO ()
 main = do
-    ptr <- c_create_tso
-    let wPtr = unpackWord# ptr
-    tso <- getClosureData ((unsafeCoerce# wPtr) :: FoolStgTSO)
-
+    tso <- createTSOClosure
     assertEqual (what_next tso) ThreadRunGHC
     assertEqual (why_blocked tso) NotBlocked
     assertEqual (saved_errno tso) 0
 
--- todo (sven): assert more?
-
     print $ "tso : "++ show tso
 
+    -- The newly created TSO should be on the end of the run queue.
+    let !_linkBox = _link tso
+    _linkClosure <- getBoxedClosureData _linkBox
+    assertEqual (name _linkClosure) "END_TSO_QUEUE"
+
+    let !global_linkBox = global_link tso
+    globalLinkClosure <- getBoxedClosureData global_linkBox
+    assertEqual (getClosureType globalLinkClosure) TSO
+
+    let !stackBox = tsoStack tso
+    stackClosure <- getBoxedClosureData stackBox
+    assertEqual (getClosureType stackClosure) STACK
+
+    let !stackPointerBox = stackPointer stackClosure
+    stackPointerClosure <- getBoxedClosureData stackPointerBox
+    assertEqual (getClosureType stackPointerClosure) RET_SMALL
+
+    let !trecBox = trec tso
+    trecClosure <- getBoxedClosureData trecBox
+    assertEqual (name trecClosure) "NO_TREC"
+
+    let !blockedExceptionsBox = blocked_exceptions tso
+    blockedExceptionsClosure <- getBoxedClosureData blockedExceptionsBox
+    assertEqual (name blockedExceptionsClosure) "END_TSO_QUEUE"
+
+    let !bqBox = bq tso
+    bqClosure <- getBoxedClosureData bqBox
+    assertEqual (name bqClosure) "END_TSO_QUEUE"
+
+createTSOClosure :: IO (GenClosure Box)
+createTSOClosure = do
+    ptr <- c_create_tso
+    let wPtr = unpackWord# ptr
+    getClosureData ((unsafeCoerce# wPtr) :: FoolStgTSO)
+
 unpackWord# :: Word -> Word#
 unpackWord# (W# w#) = w#
 
@@ -39,3 +69,6 @@ assertEqual :: (Show a, Eq a) => a -> a -> IO ()
 assertEqual a b
   | a /= b = error (show a ++ " /= " ++ show b)
   | otherwise = return ()
+
+getClosureType :: GenClosure b -> ClosureType
+getClosureType = tipe . info



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd2c787fb8dca38588d38a1c1a9d8255a239b726

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd2c787fb8dca38588d38a1c1a9d8255a239b726
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200605/cac0fa14/attachment-0001.html>