Commit edbab70c authored by simonmar's avatar simonmar
Browse files

[project @ 2002-02-18 09:33:44 by simonmar]

Add test for PAP_entry: CATCH_FRAME bug.
parent 1d193b11
......@@ -8,7 +8,7 @@ include ($confdir ++ "/../vanilla-test.T")
def myvtr ( $args_c, $args_r, $ret_res )
{
vtr ( " -package concurrent -fglasgow-exts " ++ $args_c,
vtr ( " -package concurrent -package lang -fglasgow-exts " ++ $args_c,
$args_r, $ret_res )
}
......@@ -45,3 +45,4 @@ test "conc031" { myvtr("", "", "") }
test "conc032" { myvtr("", "", "") }
test "conc033" { myvtr("", "", "") }
test "conc034" { myvtr("", "+RTS -C0 -RTS", "") }
test "conc035" { myvtr("", "", "") }
module Main where
import Concurrent
import qualified Exception as E
trapHandler :: MVar Int -> IO ()
trapHandler inVar =
(do { trapMsg <- takeMVar inVar
; putStrLn ("Handler got: " ++ show trapMsg)
; trapHandler inVar
}
)
`E.catch`
(trapExc inVar)
trapExc :: MVar Int -> E.Exception -> IO ()
trapExc inVar e =
do { putStrLn ("Exception: " ++ show e)
; trapHandler inVar
}
main :: IO ()
main =
do { inVar <- newEmptyMVar
; tid <- forkIO (trapHandler inVar)
; yield
; putMVar inVar 1
; threadDelay 1000
; throwTo tid (E.ErrorCall "1st")
; threadDelay 1000
; putMVar inVar 2
; threadDelay 1000
; throwTo tid (E.ErrorCall "2nd")
; threadDelay 1000
; putStrLn "All done"
}
Handler got: 1
Exception: 1st
Handler got: 2
Exception: 2nd
All done
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment