Commit 6a5b5511 authored by erkok's avatar erkok
Browse files

[project @ 2002-10-12 00:01:04 by erkok]

mdo testsuite
parent aa9aca4b
setTestOpts(only_ways(['normal']));
test('mdo001', normal, compile_and_run, [''])
test('mdo002', normal, compile_and_run, [''])
test('mdo003', normal, compile_and_run, [''])
test('mdo004', normal, compile_and_run, [''])
test('mdo005', normal, compile_and_run, [''])
{-# OPTIONS -fglasgow-exts #-}
-- test that we have all the promised instances
module Main(main) where
import Control.Monad.Fix
import qualified Control.Monad.ST as SST
import qualified Control.Monad.ST.Lazy as LST
generic :: MonadFix m => m [Int]
generic = mdo xs <- return (1:xs)
return (take 4 xs)
io :: IO [Int]
io = generic
sst :: SST.ST s [Int]
sst = generic
lst :: LST.ST s [Int]
lst = generic
mb :: Maybe [Int]
mb = generic
ls :: [[Int]]
ls = generic
main :: IO ()
main = do
print =<< io
print $ SST.runST sst
print $ LST.runST lst
print $ mb
print $ ls
[1,1,1,1]
[1,1,1,1]
[1,1,1,1]
Just [1,1,1,1]
[[1,1,1,1]]
{-# OPTIONS -fglasgow-exts #-}
-- test of user defined instance of MonadFix
module Main (main) where
import Control.Monad.Fix
data X a = X a deriving Show
instance Monad X where
return = X
(X a) >>= f = f a
instance MonadFix X where
mfix f = fix (f . unX)
where unX ~(X x) = x
z :: X [Int]
z = mdo x <- return (1:x)
return (take 4 x)
main = print z
{-# OPTIONS -fglasgow-exts #-}
module Main(main) where
-- test let bindings
module Main (main) where
import Control.Monad.Fix
t :: IO Int
......
{-# OPTIONS -fglasgow-exts #-}
-- test let bindings, polymorphism is ok provided they are not
-- isolated in a recursive segment
-- NB. this is not what Hugs does!
module Main (main) where
import Control.Monad.Fix
t :: IO (Int, Int)
t = mdo let l [] = 0
l (x:xs) = 1 + l xs
return (l "1", l [1,2,3])
main :: IO ()
main = t >>= print
{-# OPTIONS -fglasgow-exts #-}
-- test scoping
module Main (main) where
import Control.Monad.Fix
import Maybe ( fromJust )
t = mdo x <- fromJust (mdo x <- Just (1:x)
return (take 4 x))
return x
main :: IO ()
main = print t
setTestOpts(only_ways(['normal']));
test('mdofail001', normal, compile_fail, [''])
test('mdofail002', normal, compile_fail, [''])
test('mdofail003', normal, compile_fail, [''])
test('mdofail004', normal, compile_fail, [''])
test('mdofail005', normal, compile_fail, [''])
{-# OPTIONS -fglasgow-exts #-}
-- let bindings are monomorphic if used prior to their definition
module Main (main) where
import Control.Monad.Fix
t :: IO (Int, Int)
t = mdo x <- return (l "1", l [1,2,3])
let l [] = 0
l (x:xs) = 1 + l xs
return x
main :: IO ()
main = t >>= print
mdofail001.hs:10:
No instance for (Num Char)
arising from the literal `1' at mdofail001.hs:10
In the list element: 1
In the first argument of `l', namely `[1, 2, 3]'
{-# OPTIONS -fglasgow-exts #-}
-- shadowing is not allowed
module Main (main) where
import Control.Monad.Fix
t :: IO ()
t = mdo x <- return 1
x <- return 2
return ()
main :: IO ()
main = t
mdofail002.hs:10:
Conflicting definitions for `x'
In a mdo-expression
{-# OPTIONS -fglasgow-exts #-}
-- shadowing is not allowed II
module Main (main) where
import Control.Monad.Fix
t :: IO ()
t = mdo x <- return 1
let x 0 = 4
return ()
main :: IO ()
main = t
mdofail003.hs:10:
Conflicting definitions for `x'
In a mdo-expression
{-# OPTIONS -fglasgow-exts #-}
-- mdo requires MonadFix instance, even
-- if no recursion is present
module Main (main) where
import Control.Monad.Fix
data X a = X a deriving Show
instance Monad X where
return = X
(X a) >>= f = f a
z :: X [Int]
z = mdo return [1,2,3,4]
main = print z
mdofail004.hs:17:
No instance for (MonadFix X)
arising from a do statement at mdofail004.hs:17
In a right-hand side of function `z': mdo return [1, 2, 3, 4]
In the definition of `z': z = mdo return [1, 2, 3, 4]
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