[Git][ghc/ghc][wip/loop-backtrace] 2 commits: testsuite: Add LoopBacktrace test

21 Jun 2026


      Ben Gamari pushed to branch wip/loop-backtrace at Glasgow Haskell Compiler / GHC


Commits:
57e9a132 by Ben Gamari at 2026-06-21T11:49:24-04:00
testsuite: Add LoopBacktrace test

- - - - -
c126d27d by Ben Gamari at 2026-06-21T11:49:24-04:00
Throw nontermination exceptions via `throw`

This ensures that the exception that results gets the usual backtrace
annotations.

- - - - -


11 changed files:

- libraries/base/src/Control/Exception/Base.hs
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- rts/Prelude.h
- rts/RtsStartup.c
- rts/Schedule.c
- rts/include/rts/RtsToHsIface.h
- + testsuite/tests/rts/LoopBacktrace.hs
- + testsuite/tests/rts/LoopBacktrace.stderr
- + testsuite/tests/rts/LoopBacktrace.stdout
- testsuite/tests/rts/all.T


Changes:

=====================================
libraries/base/src/Control/Exception/Base.hs
=====================================
@@ -85,7 +85,6 @@ module Control.Exception.Base
      patError,
      noMethodBindingError,
      typeError,
-     nonTermination,
      nestedAtomically,
      noMatchingContinuationPrompt
      ) where


=====================================
libraries/ghc-internal/include/RtsIfaceSymbols.h
=====================================
@@ -20,7 +20,7 @@ CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTM_closure)
 CLOSURE(GHCziInternalziIOziException, cannotCompactFunction_closure)
 CLOSURE(GHCziInternalziIOziException, cannotCompactPinned_closure)
 CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure)
-CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure)
+CLOSURE(GHCziInternalziControlziExceptionziBase, nonTerminationError_closure)
 CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure)
 CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure)
 #if defined(mingw32_HOST_OS)


=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
=====================================
@@ -108,7 +108,7 @@ module GHC.Internal.Control.Exception.Base (
         impossibleError, impossibleConstraintError,
         nonExhaustiveGuardsError, patError, noMethodBindingError,
         typeError,
-        nonTermination, nestedAtomically, noMatchingContinuationPrompt,
+        nonTerminationError, nestedAtomically, noMatchingContinuationPrompt,
   ) where
 
 import           GHC.Internal.Base (
@@ -448,8 +448,9 @@ impossibleConstraintError   s = errorWithoutStackTrace (unpackCStringUtf8# s)
 
 
 -- GHC's RTS calls this
-nonTermination :: SomeException
-nonTermination = toException NonTermination
+nonTerminationError :: IO ()
+nonTerminationError = throwIO NonTermination
+
 
 -- GHC's RTS calls this
 nestedAtomically :: SomeException


=====================================
rts/Prelude.h
=====================================
@@ -58,7 +58,7 @@ extern StgClosure ZCMain_main_closure;
 #define cannotCompactFunction_closure ghc_hs_iface->cannotCompactFunction_closure
 #define cannotCompactPinned_closure ghc_hs_iface->cannotCompactPinned_closure
 #define cannotCompactMutable_closure ghc_hs_iface->cannotCompactMutable_closure
-#define nonTermination_closure    ghc_hs_iface->nonTermination_closure
+#define nonTerminationError_closure    ghc_hs_iface->nonTerminationError_closure
 #define nestedAtomically_closure  ghc_hs_iface->nestedAtomically_closure
 #define absentSumFieldError_closure ghc_hs_iface->absentSumFieldError_closure
 #define underflowException_closure ghc_hs_iface->underflowException_closure


=====================================
rts/RtsStartup.c
=====================================
@@ -193,7 +193,7 @@ static void initBuiltinGcRoots(void)
     getStablePtr((StgPtr)heapOverflow_closure);
     getStablePtr((StgPtr)unpackCString_closure);
     getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
-    getStablePtr((StgPtr)nonTermination_closure);
+    getStablePtr((StgPtr)nonTerminationError_closure);
     getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
     getStablePtr((StgPtr)allocationLimitExceeded_closure);
     getStablePtr((StgPtr)cannotCompactFunction_closure);


=====================================
rts/Schedule.c
=====================================
@@ -3276,6 +3276,17 @@ findAtomicallyFrameHelper (Capability *cap, StgTSO *tso)
   }
 }
 
+static void throwNontermination(Capability *cap, StgTSO *tso) {
+  StgStack *stack = tso->stackobj;
+  stack->sp -= 3;
+  stack->sp[0] = (W_)&stg_enter_info;
+  stack->sp[1] = (W_)nonTerminationError_closure;
+  stack->sp[2] = (W_)&stg_ap_v_info;
+  tso->why_blocked = NotBlocked;
+  appendToRunQueue(cap,tso);
+}
+
+
 /* -----------------------------------------------------------------------------
    resurrectThreads is called after garbage collection on the list of
    threads found to be garbage.  Each of these threads will be woken
@@ -3313,8 +3324,7 @@ resurrectThreads (StgTSO *threads)
                                   (StgClosure *)blockedIndefinitelyOnMVar_closure);
             break;
         case BlockedOnBlackHole:
-            throwToSingleThreaded(cap, tso,
-                                  (StgClosure *)nonTermination_closure);
+            throwNontermination(cap, tso);
             break;
         case BlockedOnSTM:
             throwToSingleThreaded(cap, tso,


=====================================
rts/include/rts/RtsToHsIface.h
=====================================
@@ -25,7 +25,7 @@ typedef struct {
     StgClosure *cannotCompactFunction_closure;  // GHC.Internal.IO.Exception.cannotCompactFunction_closure
     StgClosure *cannotCompactPinned_closure;  // GHC.Internal.IO.Exception.cannotCompactPinned_closure
     StgClosure *cannotCompactMutable_closure;  // GHC.Internal.IO.Exception.cannotCompactMutable_closure
-    StgClosure *nonTermination_closure;  // GHC.Internal.Control.Exception.Base.nonTermination_closure
+    StgClosure *nonTerminationError_closure;  // GHC.Internal.Control.Exception.Base.nonTerminationError_closure
     StgClosure *nestedAtomically_closure;  // GHC.Internal.Control.Exception.Base.nestedAtomically_closure
     StgClosure *noMatchingContinuationPrompt_closure;  // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure
     StgClosure *blockedOnBadFD_closure;  // GHC.Internal.Event.Thread.blockedOnBadFD_closure


=====================================
testsuite/tests/rts/LoopBacktrace.hs
=====================================
@@ -0,0 +1,17 @@
+{-# OPTIONS_GHC -finfo-table-map -forig-thunk-info #-}
+
+import GHC.Exception.Backtrace.Experimental
+
+x :: Integer
+x = x + 1
+
+testing :: IO ()
+testing = do
+  putStrLn "hello"
+  print x
+  putStrLn "world"
+
+main :: IO ()
+main = do
+  setBacktraceMechanismState IPEBacktrace True
+  testing


=====================================
testsuite/tests/rts/LoopBacktrace.stderr
=====================================
@@ -0,0 +1,21 @@
+LoopBacktrace: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination:
+
+<<loop>>
+
+IPE backtrace:
+  GHC.Internal.Exception.Backtrace.collectBacktraces' (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:(179,1)-(202,25))
+  GHC.Internal.Exception.Backtrace.collectBacktraces (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:174:39-56)
+  GHC.Internal.Exception.toExceptionWithBacktrace (libraries/ghc-internal/src/GHC/Internal/Exception.hs:(179,26)-(181,53))
+  GHC.Internal.IO.throwIO (libraries/ghc-internal/src/GHC/Internal/IO.hs:293:36)
+  Cmm$rts/HeapStackCheck.cmm. (:)
+  GHC.Internal.Bignum.Integer.integerAdd (libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs:(547,1)-(571,52))
+  Cmm$rts/Updates.cmm. (:)
+  Main.x (LoopBacktrace.hs:6:1-9)
+  GHC.Internal.Show.show (libraries/ghc-internal/src/GHC/Internal/Show.hs:497:10-21)
+  GHC.Internal.IO.Handle.Text.hPutStr' (libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs:667:29-37)
+  GHC.Internal.Base.thenIO (libraries/ghc-internal/src/GHC/Internal/Base.hs:2337:1-72)
+  Cmm$rts/Exception.cmm. (:)
+  Cmm$rts/StgStartup.cmm. (:)
+HasCallStack backtrace:
+  throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:452:23 in ghc-internal:GHC.Internal.Control.Exception.Base
+


=====================================
testsuite/tests/rts/LoopBacktrace.stdout
=====================================
@@ -0,0 +1 @@
+hello


=====================================
testsuite/tests/rts/all.T
=====================================
@@ -687,3 +687,5 @@ test('ClosureTable',
      ['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include'])
 
 test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, [''])
+
+test('LoopBacktrace', [exit_code(1)], compile_and_run, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4010d1929d506335de6895408bed71a...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4010d1929d506335de6895408bed71a...
You're receiving this email because of your account on gitlab.haskell.org.

    

Ben Gamari (＠bgamari)

tags

participants (1)