Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
obsidiansystems
GHC
Commits
ba14f04d
Commit
ba14f04d
authored
Nov 26, 2015
by
Ben Gamari
🐢
Browse files
Libdw: Handle failure to grab session for location lookup
This one slipped through testing.
parent
1712a9ed
Changes
2
Hide whitespace changes
Inline
Side-by-side
libraries/base/GHC/ExecutionStack.hs
View file @
ba14f04d
...
...
@@ -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
libraries/base/GHC/ExecutionStack/Internal.hsc
View file @
ba14f04d
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment