diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2019-06-19 12:17:10 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@well-typed.com> | 2019-06-26 08:18:25 -0400 |
| commit | 12752342228fc60d87c4235c253655a9092388a3 (patch) | |
| tree | 9a17c9c5c348c549dc9a27963adc98ca5fdee159 /testsuite/tests/concurrent | |
| parent | 58e84b308c4351793defd1b6b06339261d5abdf4 (diff) | |
| download | haskell-12752342228fc60d87c4235c253655a9092388a3.tar.gz | |
testsuite: Add T5611a
This is the same as T5611 but with an unsafe call to sleep.
Diffstat (limited to 'testsuite/tests/concurrent')
5 files changed, 42 insertions, 4 deletions
diff --git a/testsuite/tests/concurrent/should_run/T5611a.hs b/testsuite/tests/concurrent/should_run/T5611a.hs new file mode 100644 index 0000000000..81e6cc957e --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T5611a.hs @@ -0,0 +1,36 @@ +-- The same as T5611 but with unsafe calls. + +{-# LANGUAGE CPP,ForeignFunctionInterface #-} + +import Control.Concurrent +import Foreign.C +import System.IO + +#if defined(mingw32_HOST_OS) +sleep n = sleepBlock (n*1000) +foreign import stdcall unsafe "Sleep" sleepBlock :: Int -> IO () +#else +sleep n = sleepBlock n +foreign import ccall unsafe "sleep" sleepBlock :: Int -> IO () +#endif + +main :: IO () +main = do + hSetBuffering stdout LineBuffering + + tid <- forkIO $ do + putStrLn "child: Sleeping" + _ <- sleep 1 + + -- The following lines should not happen after the killThread from the + -- parent thread completes. However, they do... + -- putStrLn "child: Done sleeping" + threadDelay 100000 + putStrLn "child: Done waiting" + + threadDelay 100000 + -- putStrLn $ "parent: Throwing exception to thread " ++ show tid + throwTo tid $ userError "Exception delivered successfully" + putStrLn "parent: Done throwing exception" + + threadDelay 200000 diff --git a/testsuite/tests/concurrent/should_run/T5611a.stderr b/testsuite/tests/concurrent/should_run/T5611a.stderr new file mode 100644 index 0000000000..644a878735 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T5611a.stderr @@ -0,0 +1 @@ +T5611a: user error (Exception delivered successfully) diff --git a/testsuite/tests/concurrent/should_run/T5611a.stderr.mingw32 b/testsuite/tests/concurrent/should_run/T5611a.stderr.mingw32 new file mode 100644 index 0000000000..42c9f24f76 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T5611a.stderr.mingw32 @@ -0,0 +1 @@ +T5611a: <stdout>: commitBuffer: user error (Exception delivered successfully) diff --git a/testsuite/tests/concurrent/should_run/T5611a.stdout b/testsuite/tests/concurrent/should_run/T5611a.stdout new file mode 100644 index 0000000000..cf4f0d2827 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T5611a.stdout @@ -0,0 +1,2 @@ +child: Sleeping +parent: Done throwing exception diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 706cd68ed4..b8aeb32803 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -74,10 +74,8 @@ test('T5558', compile_and_run, ['']) test('T5421', normal, compile_and_run, ['']) -test('T5611', - [expect_broken_for(16845, ['ghci']), - when(opsys('darwin'), fragile(12751))], - compile_and_run, ['']) +test('T5611', when(opsys('darwin'), fragile(12751)) , compile_and_run, ['']) +test('T5611a', when(opsys('darwin'), fragile(12751)) , compile_and_run, ['']) test('T5238', normal, compile_and_run, ['']) test('T5866', exit_code(1), compile_and_run, ['']) |