Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ebcb55d5e13f32535b253add2e42db6fe720c2a9 >--------------------------------------------------------------- commit ebcb55d5e13f32535b253add2e42db6fe720c2a9 Author: Simon Marlow <[email protected]> Date: Fri Mar 23 15:00:34 2012 +0000 add test for #5943 >--------------------------------------------------------------- tests/5943.hs | 36 ++++++++++++++++++++++++++++++++++++ tests/5943.stdout | 7 +++++++ tests/all.T | 2 ++ 3 files changed, 45 insertions(+), 0 deletions(-) diff --git a/tests/5943.hs b/tests/5943.hs new file mode 100644 index 0000000..88fa24d --- /dev/null +++ b/tests/5943.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +import Control.Monad +import Control.Monad.Fix +import Data.IORef +import Prelude hiding (until) + +data Phase a = Ready a | Updated a a + +delay :: IO Int -- ^ the signal to delay + -> IO (IO (), IO (), IO Int) -- ^ the delayed signal +delay s = do + ref <- newIORef (Ready 0) + let + upd = do v <- readIORef ref + case v of + Ready x -> do putStrLn "upd: Ready"; x' <- s; putStrLn (show x'); writeIORef ref (Updated x' x) + _ -> return () + + fin = do v <- readIORef ref + case v of + Updated x _ -> do putStrLn "fin: Updated"; writeIORef ref $! Ready x + _ -> error "Signal not updated!" + + sig = do v <- readIORef ref + case v of + Ready x -> do putStrLn "sig: Ready"; return x + Updated _ x -> do putStrLn "sig: Updated"; return x + + return (upd,fin,sig) + +main = do + (upd,fin,_) <- mfix $ \ ~(_,_,sig) -> delay (fmap (1+) sig) + upd + fin + upd diff --git a/tests/5943.stdout b/tests/5943.stdout new file mode 100644 index 0000000..d24cba1 --- /dev/null +++ b/tests/5943.stdout @@ -0,0 +1,7 @@ +upd: Ready +sig: Ready +1 +fin: Updated +upd: Ready +sig: Ready +2 diff --git a/tests/all.T b/tests/all.T index 13f25f0..ae00389 100644 --- a/tests/all.T +++ b/tests/all.T @@ -116,3 +116,5 @@ test('weak001', normal, compile_and_run, ['']) # http://mingw-users.1079350.n2.nabble.com/Bug-re-Unicode-on-the-console-td3121717.html test('4006', if_msys(expect_fail), compile_and_run, ['']) +test('5943', normal, compile_and_run, ['']) + _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
