testsuite: Reduce sensitivity to exception context

haskell · Feb 28, 2024 · 225162f · 225162f
1 parent e1ff4d4
commit 225162f
Show file tree

Hide file tree

Showing 4 changed files with 6 additions and 5 deletions.
diff --git a/tests/all.T b/tests/all.T
@@ -6,8 +6,7 @@ test('stm050', [extra_run_opts('10000')], compile_and_run, ['-package stm'])
 
 test('stm054', normal, compile_and_run, ['-package stm'])
 test('stm055', [exit_code(1), js_broken(22576)], compile_and_run, ['-package stm'])
-test('stm056', only_ways(['threaded1','threaded2']),
-                compile_and_run, ['-package stm'])
+test('stm056', only_ways(['threaded1','threaded2']), compile_and_run, ['-package stm'])
 
 test('stm061', normal, compile_and_run, ['-package stm'])
 test('T2411', ignore_stdout, compile_and_run, ['-package stm'])

diff --git a/tests/stm056.hs b/tests/stm056.hs
@@ -11,8 +11,9 @@ inc tv = do
   writeTVar tv (v + 1)
 
 bad :: MVar () -> IO ()
-bad m = do { evaluate (1 `quot` 0); return () }
-         `finally` putMVar m ()
+bad m = handle (\(_ :: SomeException) -> putStrLn "bad" >> putMVar m ()) $ do
+  evaluate (1 `quot` 0)
+  return ()
 
 main :: IO ()
 main = do
@@ -22,3 +23,4 @@ main = do
   forkOS (bad m)
   takeMVar m
   threadDelay 100000 -- allow time for the exception to be printed
+
diff --git a/tests/stm056.stderr b/tests/stm056.stderr
diff --git a/tests/stm056.stdout b/tests/stm056.stdout
@@ -0,0 +1 @@
+bad