diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2016-01-11 18:30:29 +0000 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2016-01-13 13:06:07 +0000 |
| commit | 6cb860a9a154847906868ac0be93d750f99dac86 (patch) | |
| tree | 69ca27d0383e11137c02b3b6fdde50c26eb94a6e /libraries | |
| parent | 00c8076ecf441e6be5cacafc78a98f7ab38ddad4 (diff) | |
| download | haskell-6cb860a9a154847906868ac0be93d750f99dac86.tar.gz | |
Add -prof stack trace to assert
Summary:
So that assertion failures have full call stack information attached
when using `ghc -fexternal-interpreter -prof`. Here's one I just
collected by inserting a dummy assert in Happy:
```
*** Exception: Assertion failed
CallStack (from ImplicitParams):
assert, called at ./First.lhs:37:11 in main:First
CallStack (from -prof):
First.mkFirst (First.lhs:37:11-27)
First.mkFirst (First.lhs:37:11-93)
Main.main2.runParserGen.first (Main.lhs:107:48-56)
Main.main2.runParserGen.first (Main.lhs:107:27-57)
Main.main2.runParserGen (Main.lhs:(96,9)-(276,9))
Main.main2.runParserGen (Main.lhs:(90,9)-(276,10))
Main.main2.runParserGen (Main.lhs:(86,9)-(276,10))
Main.main2.runParserGen (Main.lhs:(85,9)-(276,10))
Main.main2 (Main.lhs:74:20-43)
Main.main2 (Main.lhs:(64,9)-(78,61))
Main.main (Main.lhs:57:9-18)
```
Test Plan: validate
Reviewers: erikd, hvr, austin, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1765
GHC Trac Issues: #11047
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/base/GHC/Exception.hs | 3 | ||||
| -rw-r--r-- | libraries/base/GHC/IO/Exception.hs | 12 | ||||
| -rw-r--r-- | libraries/base/GHC/Stack/CCS.hsc | 3 |
3 files changed, 13 insertions, 5 deletions
diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index 80761ada75..6c579f0372 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -28,7 +28,8 @@ module GHC.Exception , divZeroException, overflowException, ratioZeroDenomException , errorCallException, errorCallWithCallStackException -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, getCallStack, prettyCallStack + , CallStack, getCallStack, prettyCallStack, prettyCallStackLines + , showCCSStack , SrcLoc(..), prettySrcLoc ) where diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index 933ce943e6..c7bccb0077 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -51,6 +51,8 @@ import GHC.Show import GHC.Read import GHC.Exception import GHC.IO.Handle.Types +import GHC.OldList ( intercalate ) +import {-# SOURCE #-} GHC.Stack.CCS import Foreign.C.Types import Data.Typeable ( cast ) @@ -355,9 +357,13 @@ instance Show IOException where assertError :: (?callStack :: CallStack) => Bool -> a -> a assertError predicate v | predicate = lazy v - | otherwise = throw (AssertionFailed - ("Assertion failed\n" - ++ prettyCallStack ?callStack)) + | otherwise = unsafeDupablePerformIO $ do + ccsStack <- currentCallStack + let + implicitParamCallStack = prettyCallStackLines ?callStack + ccsCallStack = showCCSStack ccsStack + stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack + throwIO (AssertionFailed ("Assertion failed\n" ++ stack)) unsupportedOperation :: IOError unsupportedOperation = diff --git a/libraries/base/GHC/Stack/CCS.hsc b/libraries/base/GHC/Stack/CCS.hsc index d40d92dc91..bab9f7500b 100644 --- a/libraries/base/GHC/Stack/CCS.hsc +++ b/libraries/base/GHC/Stack/CCS.hsc @@ -116,4 +116,5 @@ whoCreated obj = do ccsToStrings ccs renderStack :: [String] -> String -renderStack strs = "Stack trace:" ++ concatMap ("\n "++) (reverse strs) +renderStack strs = + "CallStack (from -prof):" ++ concatMap ("\n "++) (reverse strs) |