[project @ 2001-02-13 15:12:42 by rrt]

Update tests not to use deprecated features (except that I had to write
Exception.catch everywhere instead of catch for some reason, because ghc
complained that catch was ambiguous (Exception. vs PrelException.).

Also add some cases to make mingwin work.

diff --git a/ghc/tests/concurrent/should_run/Makefile b/ghc/tests/concurrent/should_run/Makefile
index 6b0271d..4d7c4ce 100644 (file)
--- a/ghc/tests/concurrent/should_run/Makefile
+++ b/ghc/tests/concurrent/should_run/Makefile
@@ -1,5 +1,5 @@
 #-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.9 2000/11/03 16:23:37 simonmar Exp $
+# $Id: Makefile,v 1.10 2001/02/13 15:12:42 rrt Exp $
 
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
@@ -11,8 +11,9 @@ endif
 
 include $(TOP)/mk/should_run.mk
 
+conc007_RUNTEST_OPTS = +RTS -H128M -RTS
 conc009_RUNTEST_OPTS = -x 1
-conc021_RUNTEST_OPTS = -x 250
+conc021_RUNTEST_OPTS = -x 250 -o2 conc021.stderr-mingw
 
 SRC_HC_OPTS += -dcore-lint -package concurrent -fglasgow-exts
 

diff --git a/ghc/tests/concurrent/should_run/conc007.hs b/ghc/tests/concurrent/should_run/conc007.hs
index 0caada8..77421ca 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc007.hs
+++ b/ghc/tests/concurrent/should_run/conc007.hs
@@ -22,7 +22,7 @@ choose a b = do
 -- exception is raised in any thread.
 
 myForkIO :: IO () -> IO ThreadId
-myForkIO io = forkIO (catchAllIO io (\e -> return ()))
+myForkIO io = forkIO (Exception.catch io (\e -> return ()))
 
 main = do
    let big = sum [1..]

diff --git a/ghc/tests/concurrent/should_run/conc008.hs b/ghc/tests/concurrent/should_run/conc008.hs
index b12cf16..abbdf18 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc008.hs
+++ b/ghc/tests/concurrent/should_run/conc008.hs
@@ -9,4 +9,4 @@ import Exception
 
 main = do 
   id <- myThreadId
-  catchAllIO (killThread id) (\e -> putStr (show e))
+  Exception.catch (killThread id) (\e -> putStr (show e))

diff --git a/ghc/tests/concurrent/should_run/conc009.hs b/ghc/tests/concurrent/should_run/conc009.hs
index d64e932..ee8017f 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc009.hs
+++ b/ghc/tests/concurrent/should_run/conc009.hs
@@ -7,4 +7,4 @@ import Exception
 
 main = do 
   id <- myThreadId
-  raiseInThread id (ErrorCall "hello")
+  throwTo id (ErrorCall "hello")

diff --git a/ghc/tests/concurrent/should_run/conc010.hs b/ghc/tests/concurrent/should_run/conc010.hs
index 661b076..bb97b96 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc010.hs
+++ b/ghc/tests/concurrent/should_run/conc010.hs
@@ -22,8 +22,8 @@ main = do
   block  <- newEmptyMVar
   ready  <- newEmptyMVar
   ready2 <- newEmptyMVar
-  id <- forkIO (catchAllIO (putMVar ready () >> takeMVar block) 
+  id <- forkIO (Exception.catch (putMVar ready () >> takeMVar block) 
                (\e -> putStr (show e) >> putMVar ready2 ()))
   takeMVar ready
-  raiseInThread id (ErrorCall "hello")
+  throwTo id (ErrorCall "hello")
   takeMVar ready2

diff --git a/ghc/tests/concurrent/should_run/conc012.hs b/ghc/tests/concurrent/should_run/conc012.hs
index 0030742..e94d91b 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc012.hs
+++ b/ghc/tests/concurrent/should_run/conc012.hs
@@ -15,7 +15,7 @@ stackoverflow n = n + stackoverflow n
 main = do
   let x = stackoverflow 1
   result <- newEmptyMVar 
-  forkIO (catchAllIO (x `seq` putMVar result Finished) 
+  forkIO (Exception.catch (x `seq` putMVar result Finished) 
                     (\e -> putMVar result (Died e)))
   res <- takeMVar result
   case res of

diff --git a/ghc/tests/concurrent/should_run/conc014.hs b/ghc/tests/concurrent/should_run/conc014.hs
index 650a0d7..e7b38d6 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc014.hs
+++ b/ghc/tests/concurrent/should_run/conc014.hs
@@ -7,10 +7,10 @@ import Exception
 main = do
   main_thread <- myThreadId
   m <- newEmptyMVar
-  forkIO (do { takeMVar m;  raiseInThread main_thread (ErrorCall "foo") })
+  forkIO (do { takeMVar m;  throwTo main_thread (ErrorCall "foo") })
   (error "wibble")
-       `catchAllIO` (\e -> do putMVar m ()
-                              sum [1..10000] `seq` putStrLn "done.")
+       `Exception.catch` (\e -> do putMVar m ()
+                                   sum [1..10000] `seq` putStrLn "done.")
   (threadDelay 500000)
-       `catchAllIO` (\e -> putStrLn ("caught: " ++ show e))
+       `Exception.catch` (\e -> putStrLn ("caught: " ++ show e))
 

diff --git a/ghc/tests/concurrent/should_run/conc015.hs b/ghc/tests/concurrent/should_run/conc015.hs
index 96ce373..07b2fcd 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc015.hs
+++ b/ghc/tests/concurrent/should_run/conc015.hs
@@ -15,18 +15,18 @@ main = do
   m <- newEmptyMVar
   m2 <- newEmptyMVar
   forkIO (do takeMVar m
-            raiseInThread main_thread (ErrorCall "foo")
-            raiseInThread main_thread (ErrorCall "bar") 
+            throwTo main_thread (ErrorCall "foo")
+            throwTo main_thread (ErrorCall "bar") 
             putMVar m2 ()
         )
   ( do
-    blockAsyncExceptions (do
+    block (do
        putMVar m ()
        sum [1..10000] `seq` -- give 'foo' a chance to be raised
-         (unblockAsyncExceptions (threadDelay 500000))
-               `catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
+         (unblock (threadDelay 500000))
+               `Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
      )
     takeMVar m2
    )
-    `catchAllIO`
+    `Exception.catch`
     (\e -> putStrLn ("caught2: " ++ show e))

diff --git a/ghc/tests/concurrent/should_run/conc016.hs b/ghc/tests/concurrent/should_run/conc016.hs
index e616a42..3990d0c 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc016.hs
+++ b/ghc/tests/concurrent/should_run/conc016.hs
@@ -8,11 +8,11 @@ main = do
   m <- newEmptyMVar
   sub_thread <- forkIO (do
                         takeMVar m
-                        raiseInThread main_thread (ErrorCall "foo")
+                        throwTo main_thread (ErrorCall "foo")
                        )
-  blockAsyncExceptions (do
+  block (do
     putMVar m ()
     sum [1..10000] `seq` -- to be sure the other thread is now blocked
-       killThread sub_thread
+      killThread sub_thread
    )
   putStrLn "ok"

diff --git a/ghc/tests/concurrent/should_run/conc017.hs b/ghc/tests/concurrent/should_run/conc017.hs
index 7bdaad2..4dbda4e 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc017.hs
+++ b/ghc/tests/concurrent/should_run/conc017.hs
@@ -11,25 +11,25 @@ main = do
   m3 <- newEmptyMVar
   forkIO (do 
             takeMVar m1
-            raiseInThread main_thread (ErrorCall "foo")
+            throwTo main_thread (ErrorCall "foo")
             takeMVar m2
-            raiseInThread main_thread (ErrorCall "bar")
+            throwTo main_thread (ErrorCall "bar")
             putMVar m3 ()
         )
   (do 
-    blockAsyncExceptions (do
+    block (do
        (do putMVar m1 () 
-           unblockAsyncExceptions (
+           unblock (
                -- unblocked, "foo" delivered to "caught1"
               threadDelay 100000
             )
-        ) `catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
+        ) `Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
        putMVar m2 ()
        -- blocked here, "bar" can't be delivered
        (sum [1..10000] `seq` return ())
-         `catchAllIO` (\e -> putStrLn ("caught2: " ++ show e))
+         `Exception.catch` (\e -> putStrLn ("caught2: " ++ show e))
      )
     -- unblocked here, "bar" delivered to "caught3"
     takeMVar m3
    ) 
-   `catchAllIO` (\e -> putStrLn ("caught3: " ++ show e))
+   `Exception.catch` (\e -> putStrLn ("caught3: " ++ show e))

diff --git a/ghc/tests/concurrent/should_run/conc018.hs b/ghc/tests/concurrent/should_run/conc018.hs
index 56f0e9e..6ffe887 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc018.hs
+++ b/ghc/tests/concurrent/should_run/conc018.hs
@@ -2,7 +2,7 @@ import Concurrent
 import Exception
 
 main = do
-  catchAllIO (do
+  Exception.catch (do
        m <- newMVar ()
        putMVar m ()
      )

diff --git a/ghc/tests/concurrent/should_run/conc020.hs b/ghc/tests/concurrent/should_run/conc020.hs
index 7a3774a..29e3418 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc020.hs
+++ b/ghc/tests/concurrent/should_run/conc020.hs
@@ -3,8 +3,8 @@ import Exception
 
 main = do
   m <- newEmptyMVar
-  t <- forkIO (blockAsyncExceptions $ takeMVar m)
+  t <- forkIO (block $ takeMVar m)
   threadDelay 100000
-  raiseInThread t (ErrorCall "I'm Interruptible")
+  throwTo t (ErrorCall "I'm Interruptible")
   threadDelay 100000
   putMVar m ()  -- to avoid t being garbage collected

diff --git a/ghc/tests/concurrent/should_run/conc021.stderr-mingw b/ghc/tests/concurrent/should_run/conc021.stderr-mingw
new file mode 100644 (file)
index 0000000..49ee2ae
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc021.stderr-mingw
@@ -0,0 +1 @@
+C:\TEMP\fptools-head\fptools\ghc\tests\concurrent\should_run\conc021.bin: main thread exited (uncaught exception)

diff --git a/ghc/tests/concurrent/should_run/conc022.hs b/ghc/tests/concurrent/should_run/conc022.hs
index 7e84e83..8bbeaf6 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc022.hs
+++ b/ghc/tests/concurrent/should_run/conc022.hs
@@ -25,13 +25,13 @@ timeout secs action on_timeout
     threadid <- myThreadId
     timeout <- forkIOIgnoreExceptions (
                            do threadDelay (secs * 1000000)
-                              raiseInThread threadid (ErrorCall "__timeout")
+                              throwTo threadid (ErrorCall "__timeout")
                          )
     ( do result <- action
         killThread timeout
         return result
       ) 
-      `catchAllIO`
+      `Exception.catch`
       ( \exception -> case exception of
                       ErrorCall "__timeout" -> on_timeout                     
                       _other                -> do
@@ -42,5 +42,5 @@ forkIOIgnoreExceptions :: IO () -> IO ThreadId
 forkIOIgnoreExceptions action = IO $ \ s -> 
    case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
  where
-  action_plus = catchAllIO action (\_ -> return ())
+  action_plus = Exception.catch action (\_ -> return ())
 

diff --git a/ghc/tests/concurrent/should_run/conc024.hs b/ghc/tests/concurrent/should_run/conc024.hs
index 0daed7e..d195b97 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc024.hs
+++ b/ghc/tests/concurrent/should_run/conc024.hs
@@ -8,7 +8,7 @@ import Prelude hiding (catch)
 
 main = do
   id <- myThreadId
-  forkIO (catchAllIO (do m <- newEmptyMVar; takeMVar m)
-               (\e -> raiseInThread id e))
-  catchAllIO (print (sum [1..1000000]))
+  forkIO (catch (do m <- newEmptyMVar; takeMVar m)
+               (\e -> throwTo id e))
+  catch (print (sum [1..1000000]))
        (\e -> print e)

diff --git a/ghc/tests/concurrent/should_run/conc025.stdout b/ghc/tests/concurrent/should_run/conc025.stdout
index e69de29..fb15692 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc025.stdout
+++ b/ghc/tests/concurrent/should_run/conc025.stdout
@@ -0,0 +1 @@
+"Got done done"