diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2014-07-31 10:00:16 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2014-08-01 12:45:41 +0100 |
| commit | 9d9a55469719908bbd5cd3277e0ac79c0588dc55 (patch) | |
| tree | 64ac687c7eaae1518d20e180d6d71ae04f4671ef /testsuite/tests/concurrent | |
| parent | 6483b8ab7c5cb4dc3d06b2069dcd44fabe400858 (diff) | |
| download | haskell-9d9a55469719908bbd5cd3277e0ac79c0588dc55.tar.gz | |
interruptible() was not returning true for BlockedOnSTM (#9379)
Summary:
There's an knock-on fix in HeapStackCheck.c which is potentially
scary, but I'm pretty confident is OK. See comment for details.
Test Plan:
I've run all the STM
tests I can find, including libraries/stm/tests/stm049 with +RTS -N8
and some of the constants bumped to make it more of a stress test.
Reviewers: hvr, rwbarton, austin
Subscribers: simonmar, relrod, ezyang, carter
Differential Revision: https://phabricator.haskell.org/D104
GHC Trac Issues: #9379
Diffstat (limited to 'testsuite/tests/concurrent')
| -rw-r--r-- | testsuite/tests/concurrent/should_run/T9379.hs | 17 | ||||
| -rw-r--r-- | testsuite/tests/concurrent/should_run/all.T | 2 |
2 files changed, 19 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/T9379.hs b/testsuite/tests/concurrent/should_run/T9379.hs new file mode 100644 index 0000000000..49e6d1eaed --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T9379.hs @@ -0,0 +1,17 @@ +import Control.Exception +import Control.Concurrent +import Control.Concurrent.STM +import Foreign.StablePtr + +main :: IO () +main = do + tv <- atomically $ newTVar True + _ <- newStablePtr tv + t <- mask_ $ forkIO (blockSTM tv) + killThread t + +blockSTM :: TVar Bool -> IO () +blockSTM tv = do + atomically $ do + v <- readTVar tv + check $ not v diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 017dba172e..b43026a2ea 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -86,6 +86,8 @@ test('AtomicPrimops', normal, compile_and_run, ['']) # test uses 2 threads and yield, scheduling can vary with threaded2 test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, ['']) +test('T9379', normal, compile_and_run, ['']) + # ----------------------------------------------------------------------------- # These tests we only do for a full run |