Ensure that GHC.Stack.callStack doesn't fail
authorBen Gamari <bgamari.foss@gmail.com>
Fri, 28 Jul 2017 22:25:35 +0000 (18:25 -0400)
committerBen Gamari <ben@smart-cactus.org>
Fri, 28 Jul 2017 22:25:37 +0000 (18:25 -0400)
Test Plan: Validate, ensure the `f7` program of `IPLocation` doesn't
crash.

Reviewers: gridaphobe, austin, hvr

Reviewed By: gridaphobe

Subscribers: rwbarton, thomie

GHC Trac Issues: #14028

Differential Revision: https://phabricator.haskell.org/D3795

libraries/base/GHC/Stack.hs
testsuite/tests/typecheck/should_run/IPLocation.hs

index f5b175c..1f102c9 100644 (file)
@@ -85,7 +85,10 @@ popCallStack stk = case stk of
 --
 -- @since 4.9.0.0
 callStack :: HasCallStack => CallStack
-callStack = popCallStack ?callStack
+callStack =
+  case ?callStack of
+    EmptyCallStack -> EmptyCallStack
+    _              -> popCallStack ?callStack
 {-# INLINE callStack #-}
 
 -- | Perform some computation without adding new entries to the 'CallStack'.
index 75575e0..9647289 100644 (file)
@@ -29,9 +29,15 @@ f6 0 = putStrLn $ prettyCallStack ?loc
 f6 n = f6 (n-1)
        -- recursive functions add a SrcLoc for each recursive call
 
+f7 :: IO ()
+f7 = putStrLn (prettyCallStack $ id (\_ -> callStack) ())
+       -- shouldn't crash. See #14043.
+
+main :: IO ()
 main = do f0
           f1
           f3 (\ () -> putStrLn $ prettyCallStack ?loc)
           f4 (\ () -> putStrLn $ prettyCallStack ?loc)
           f5 (\ () -> putStrLn $ prettyCallStack ?loc3)
           f6 5
+          f7