diff options
-rw-r--r-- | rts/HeapStackCheck.cmm | 5 | ||||
-rw-r--r-- | testsuite/tests/rts/T9045.hs | 22 | ||||
-rw-r--r-- | testsuite/tests/rts/all.T | 5 |
3 files changed, 30 insertions, 2 deletions
diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm index d826529aef..12bcfb26df 100644 --- a/rts/HeapStackCheck.cmm +++ b/rts/HeapStackCheck.cmm @@ -196,7 +196,8 @@ stg_gc_prim_n (W_ arg, W_ fun) jump fun(arg); } -stg_gc_prim_p_ll_ret +INFO_TABLE_RET(stg_gc_prim_p_ll, RET_SMALL, W_ info, P_ arg, W_ fun) + /* explicit stack */ { W_ fun; P_ arg; @@ -216,7 +217,7 @@ stg_gc_prim_p_ll Sp_adj(-3); Sp(2) = fun; Sp(1) = arg; - Sp(0) = stg_gc_prim_p_ll_ret; + Sp(0) = stg_gc_prim_p_ll_info; jump stg_gc_noregs []; } diff --git a/testsuite/tests/rts/T9045.hs b/testsuite/tests/rts/T9045.hs new file mode 100644 index 0000000000..1e581efa35 --- /dev/null +++ b/testsuite/tests/rts/T9045.hs @@ -0,0 +1,22 @@ +-- This is nofib/smp/threads006. It fails in GHC 7.8.2 with a GC crash. + +{-# OPTIONS_GHC -O2 #-} +import System.IO +import System.Environment +import System.CPUTime +import Text.Printf +import Control.Monad +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Exception + +main :: IO () +main = do + hSetBuffering stdout NoBuffering + [nthreads] <- fmap (map read) getArgs + tids <- replicateM nthreads . mask $ \_ -> forkIO $ return () + m <- newEmptyMVar + -- do it in a subthread to avoid bound-thread overhead + forkIO $ do mapM_ killThread tids; putMVar m () + takeMVar m + return () diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 9239f44a21..f5a72f86b8 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -222,3 +222,8 @@ test('T8124', [ only_ways(threaded_ways), omit_ways(['ghci']), # T8124_stub.h before compiling T8124_c.c, which # needs it. compile_and_run, ['T8124_c.c -no-hs-main']) + +# +RTS -A8k makes it fail faster +# The ghci way gets confused by the RTS options +test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], compile_and_run, ['']) + |