blob: 11a69201e0d339a41a6328c4863467a42e304a68 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}
import GHC.Prim (StackSnapshot#)
import GHC.Stack.CloneStack
import Foreign
import Foreign.C.Types (CUInt)
import System.Mem
foreign import ccall "expectClosureTypes" expectClosureTypes:: StackSnapshot# -> Ptr CUInt -> Int -> IO ()
-- | Clone the stack and check that all expected closures are on it in order.
-- (The check is done by closure type.)
-- In the meanwhile enforce a garbage collection to ensure that the stack
-- snapshot is still valid afterwards (is not gc'ed while in use).
main :: IO ()
main = do
stackSnapshot <- cloneMyStack
performMajorGC
let (StackSnapshot stack) = stackSnapshot
let expectedClosureTypes = [ 30 -- RET_SMALL
, 30 -- RET_SMALL
, 34 -- CATCH_FRAME
, 36 -- STOP_FRAME
]
withArray expectedClosureTypes (\ptr -> expectClosureTypes stack ptr (length expectedClosureTypes))
|
