From c3ecf07c504293238b274fa09c5d5c05d18b9d0e Mon Sep 17 00:00:00 2001 From: Chris Kuklewicz Date: Mon, 18 Apr 2011 23:45:31 +0100 Subject: [PATCH 2/3] adding tests for QSemN and SampleVar --- tests/ghc-regress/lib/Concurrent/QSemN002.hs | 63 ++++++++++++++++++++ tests/ghc-regress/lib/Concurrent/QSemN002.stdout | 13 ++++ tests/ghc-regress/lib/Concurrent/SampleVar002.hs | 47 +++++++++++++++ .../ghc-regress/lib/Concurrent/SampleVar002.stdout | 8 +++ tests/ghc-regress/lib/Concurrent/all.T | 4 +- 5 files changed, 134 insertions(+), 1 deletions(-) create mode 100644 tests/ghc-regress/lib/Concurrent/QSemN002.hs create mode 100644 tests/ghc-regress/lib/Concurrent/QSemN002.stdout create mode 100644 tests/ghc-regress/lib/Concurrent/SampleVar002.hs create mode 100644 tests/ghc-regress/lib/Concurrent/SampleVar002.stdout diff --git a/tests/ghc-regress/lib/Concurrent/QSemN002.hs b/tests/ghc-regress/lib/Concurrent/QSemN002.hs new file mode 100644 index 0000000..e853be9 --- /dev/null +++ b/tests/ghc-regress/lib/Concurrent/QSemN002.hs @@ -0,0 +1,63 @@ +-- Check for fix for #3160, http://hackage.haskell.org/trac/ghc/ticket/3160 +module Main where + +import Prelude hiding (read) +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Concurrent.QSemN +import Control.Exception +import System.Exit + +-- delay = threadDelay (1000*100) +delay = yield + +fork x = do m <- newEmptyMVar + t <- forkIO (finally x (putMVar m ())) + delay + return (t,m) + +stop (t,m) = do killThread t + delay + takeMVar m + +-- True if test passed, False if test failed +testSem :: Integral n + => String + -> (n -> IO a) + -> (a->IO ()) + -> (a -> IO ()) + -> IO Bool +testSem name new wait signal = do + putStrLn ("\nTest "++ name) + q <- new 0 + putStrLn "0: forkIO wait thread 1" + (t1,m1) <- fork $ do + wait q `onException` (putStrLn "1: wait interrupted") + putStrLn "1: wait done UNEXPECTED" + putStrLn "0: stop thread 1" + stop (t1,m1) + putStrLn "0: signal q #1" + signal q + delay + putStrLn "0: forkIO wait thread 2" + (t2,m2) <- fork $ do + wait q `onException` (putStrLn "2: wait interrupted UNEXPECTED") + putStrLn "2: wait done" + putStrLn "0: forkIO wait thread 3" + result <- newEmptyMVar + (t3,m3) <- fork $ do + wait q `onException` (putStrLn "3: wait interrupted (QUANTITY LOST) FAIL" >> putMVar result False) + putStrLn "3: wait done (QUANTITY CONSERVED) PASS" + putMVar result True + putStrLn "0: signal q #2" + signal q + delay + putStrLn "0: stop thread 2" + stop (t2,m2) + putStrLn "0: stop thread 3" + stop (t3,m3) + takeMVar result + +main = do + _ <- testSem "QSemN" newQSemN (flip waitQSemN 1) (flip signalQSemN 1) + return () diff --git a/tests/ghc-regress/lib/Concurrent/QSemN002.stdout b/tests/ghc-regress/lib/Concurrent/QSemN002.stdout new file mode 100644 index 0000000..def667d --- /dev/null +++ b/tests/ghc-regress/lib/Concurrent/QSemN002.stdout @@ -0,0 +1,13 @@ + +Test QSemN +0: forkIO wait thread 1 +0: stop thread 1 +1: wait interrupted +0: signal q #1 +0: forkIO wait thread 2 +2: wait done +0: forkIO wait thread 3 +0: signal q #2 +3: wait done (QUANTITY CONSERVED) PASS +0: stop thread 2 +0: stop thread 3 diff --git a/tests/ghc-regress/lib/Concurrent/SampleVar002.hs b/tests/ghc-regress/lib/Concurrent/SampleVar002.hs new file mode 100644 index 0000000..a33d182 --- /dev/null +++ b/tests/ghc-regress/lib/Concurrent/SampleVar002.hs @@ -0,0 +1,47 @@ +module Main where + +import Prelude hiding (read) +import Control.Concurrent +import Control.Exception +import Control.Concurrent.MVar +import Control.Concurrent.SampleVar +import System.Timeout + +delay = yield + +fork x = do m <- newEmptyMVar + t <- forkIO (finally x (putMVar m ())) + delay + return (t,m) + +stop (t,m) = do killThread t + delay + takeMVar m + +testSV name newEmpty read write = do + putStrLn ("\nTest "++ name) + sv <- newEmpty + putStrLn "0: forkIO read thread 1" + (t1,m1) <- fork $ do + read sv `onException` (putStrLn "1: read interrupted") + putStrLn "1: read done UNEXPECTED" + putStrLn "0: stop thread 1" + stop (t1,m1) + putStrLn "0: write sv #1" + write sv 1 + putStrLn "0: write sv #2 with timeout" + m <- timeout (1000*100) (write sv 2) + case m of + Nothing -> do + putStrLn "0: timeout triggered, write sv #2 blocked, FAIL" + return False + Just () -> do + putStrLn "0: write sv #2 returned, PASS" + return True + +main = do + _ <- testSV "SampleVar" newEmptySampleVar readSampleVar writeSampleVar + return () + + + diff --git a/tests/ghc-regress/lib/Concurrent/SampleVar002.stdout b/tests/ghc-regress/lib/Concurrent/SampleVar002.stdout new file mode 100644 index 0000000..cd5853a --- /dev/null +++ b/tests/ghc-regress/lib/Concurrent/SampleVar002.stdout @@ -0,0 +1,8 @@ + +Test SampleVar +0: forkIO read thread 1 +0: stop thread 1 +1: read interrupted +0: write sv #1 +0: write sv #2 with timeout +0: write sv #2 returned, SUCCESS diff --git a/tests/ghc-regress/lib/Concurrent/all.T b/tests/ghc-regress/lib/Concurrent/all.T index 5ba43d0..a63f23c 100644 --- a/tests/ghc-regress/lib/Concurrent/all.T +++ b/tests/ghc-regress/lib/Concurrent/all.T @@ -7,5 +7,7 @@ test('Chan001', reqlib('QuickCheck'), compile_and_run, ['-package QuickChec test('MVar001', reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck']) test('QSemN001', reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck']) test('QSem001', reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck']) -test('ThreadDelay001', normal, compile_and_run, ['']) test('QSem002', normal, compile_and_run, ['']) +test('QSemN002', normal, compile_and_run, ['']) +test('SampleVar002', normal, compile_and_run, ['']) +test('ThreadDelay001', normal, compile_and_run, ['']) -- 1.7.2