Libdw: Handle failure to grab session for location lookup
authorBen Gamari <ben@smart-cactus.org>
Thu, 26 Nov 2015 11:12:32 +0000 (12:12 +0100)
committerBen Gamari <ben@smart-cactus.org>
Thu, 26 Nov 2015 13:48:51 +0000 (14:48 +0100)
This one slipped through testing.

libraries/base/GHC/ExecutionStack.hs
libraries/base/GHC/ExecutionStack/Internal.hsc

index 245b996..11f8c9e 100644 (file)
@@ -36,14 +36,15 @@ module GHC.ExecutionStack (
   , showStackTrace
   ) where
 
+import Control.Monad (join)
 import GHC.ExecutionStack.Internal
 
 -- | Get a trace of the current execution stack state.
 --
 -- Returns @Nothing@ if stack trace support isn't available on host machine.
 getStackTrace :: IO (Maybe [Location])
-getStackTrace = fmap stackFrames `fmap` collectStackTrace
+getStackTrace = (join . fmap stackFrames) `fmap` collectStackTrace
 
 -- | Get a string representation of the current execution stack state.
 showStackTrace :: IO (Maybe String)
-showStackTrace = fmap (flip showStackFrames "") `fmap` getStackTrace
+showStackTrace = fmap (\st -> showStackFrames st "") `fmap` getStackTrace
index 7a30fea..e966e17 100644 (file)
@@ -31,6 +31,7 @@ module GHC.ExecutionStack.Internal (
   , invalidateDebugCache
   ) where
 
+import Control.Monad (join)
 import Data.Word
 import Foreign.C.Types
 import Foreign.C.String (peekCString, CString)
@@ -66,11 +67,14 @@ newtype StackTrace = StackTrace (ForeignPtr StackTrace)
 -- | An address
 type Addr = Ptr ()
 
-withSession :: (ForeignPtr Session -> IO a) -> IO a
+withSession :: (ForeignPtr Session -> IO a) -> IO (Maybe a)
 withSession action = do
     ptr <- libdw_pool_take
-    fptr <- newForeignPtr libdw_pool_release ptr
-    action fptr
+    if | nullPtr == ptr -> return Nothing
+       | otherwise      -> do
+           fptr <- newForeignPtr libdw_pool_release ptr
+           ret <- action fptr
+           return $ Just ret
 
 -- | How many stack frames in the given 'StackTrace'
 stackDepth :: StackTrace -> Int
@@ -126,7 +130,7 @@ locationSize :: Int
 locationSize = (#const sizeof(Location))
 
 -- | List the frames of a stack trace.
-stackFrames :: StackTrace -> [Location]
+stackFrames :: StackTrace -> Maybe [Location]
 stackFrames st@(StackTrace fptr) = unsafePerformIO $ withSession $ \sess -> do
     chunks <- chunksList st
     go sess (reverse chunks)
@@ -197,7 +201,7 @@ foreign import ccall unsafe "&backtraceFree"
 
 -- | Get an execution stack.
 collectStackTrace :: IO (Maybe StackTrace)
-collectStackTrace = withSession $ \sess -> do
+collectStackTrace = fmap join $ withSession $ \sess -> do
     st <- withForeignPtr sess libdw_get_backtrace
     if | st == nullPtr -> return Nothing
        | otherwise     -> Just . StackTrace <$> newForeignPtr backtrace_free st