Commit b74cc4d1 authored by simonpj's avatar simonpj
Browse files

[project @ 2002-09-27 10:25:23 by simonpj]

Add tests for rebindable syntax, courtesy of Ashley Yakeley
parent 90fd4647
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
# These tests try test the rebindable-syntax feature of GHC,
# which you get when you use -fno-implicit-prelude
#
# Written by Ashley Yakeley
# No point in doing anything except the normal way
setTestOpts(only_ways(['normal']));
test('rebindable1', normal, compile, [''])
test('rebindable2', normal, compile_and_run, [''])
test('rebindable3', normal, compile_and_run, [''])
test('rebindable4', normal, compile_and_run, [''])
test('rebindable5', normal, compile_and_run, [''])
test('rebindable6', normal, compile_and_run, [''])
{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
module RebindableCase1 where
{
-- import Prelude;
import Prelude(String,undefined,Maybe(..));
return :: a;
return = undefined;
infixl 1 >>=;
(>>=) :: a;
(>>=) = undefined;
infixl 1 >>;
(>>) :: a;
(>>) = undefined;
fail :: a;
fail = undefined;
fromInteger :: a;
fromInteger = undefined;
fromRational :: a;
fromRational = undefined;
negate :: a;
negate = undefined;
(-) :: a;
(-) = undefined;
test_do f g = do
{
f;
Just a <- g;
return a;
};
test_fromInteger = 1;
test_fromRational = 0.5;
test_negate a = - a;
test_fromInteger_pattern 1 = undefined;
test_fromInteger_pattern (-1) = undefined;
test_fromInteger_pattern (a + 7) = a;
test_fromRational_pattern 0.5 = undefined;
test_fromRational_pattern (-0.5) = undefined;
test_fromRational_pattern _ = undefined;
}
{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
module Main where
{
-- import Prelude;
import qualified Prelude;
import Prelude(String,undefined,Maybe(..),IO,putStrLn,Integer,(++),Rational);
import Prelude(Monad(..));
debugFunc :: String -> IO a -> IO a;
debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
(ioa Prelude.>>= (\a ->
(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
));
newtype TM a = MkTM {unTM :: IO a};
instance (Monad TM) where
{
return a = MkTM (debugFunc "return" (Prelude.return a));
(>>=) ma amb = MkTM (debugFunc ">>=" ((Prelude.>>=) (unTM ma) (\a -> unTM (amb a))));
(>>) ma mb = MkTM (debugFunc ">>" ((Prelude.>>) (unTM ma) (unTM mb)));
fail s = MkTM (debugFunc "fail" (Prelude.return undefined));
};
preturn a = MkTM (Prelude.return a);
fromInteger :: Integer -> Integer;
fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
fromRational :: Rational -> Rational;
fromRational a = a Prelude.+ a Prelude.+ a; -- three times
negate :: a -> a;
negate a = a; -- don't actually negate
(-) :: a -> a -> a;
(-) x y = y; -- changed function
test_do f g = do
{
f; -- >>
Just a <- g; -- >>= (and fail if g returns Nothing)
return a; -- return
};
test_fromInteger = 27;
test_fromRational = 31.5;
test_negate a = - a;
test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;
test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
test_fromRational_pattern a = "_=" ++ (Prelude.show a);
tmPutStrLn s = MkTM (putStrLn s);
doTest :: String -> TM a -> IO ();
doTest s ioa =
(putStrLn ("start test " ++ s))
Prelude.>>
(unTM ioa)
Prelude.>>
(putStrLn ("end test " ++ s));
main :: IO ();
main =
(doTest "test_do failure"
(test_do (preturn ()) (preturn Nothing))
)
Prelude.>>
(doTest "test_do success"
(test_do (preturn ()) (preturn (Just ())))
)
Prelude.>>
(doTest "test_fromInteger"
(tmPutStrLn (Prelude.show test_fromInteger)) -- 27 * 5 = 135
)
Prelude.>>
(doTest "test_fromRational"
(tmPutStrLn (Prelude.show test_fromRational)) -- 31.5 * 3 = 189%2
)
Prelude.>>
(doTest "test_negate"
(tmPutStrLn (Prelude.show (test_negate 3))) -- 3 * 5 = 15, non-negate
)
Prelude.>>
(doTest "test_fromInteger_pattern 1"
(tmPutStrLn (test_fromInteger_pattern 1)) -- 1 * 5 = 5, matches "1"
)
Prelude.>>
(doTest "test_fromInteger_pattern (-2)"
(tmPutStrLn (test_fromInteger_pattern (-2))) -- "-2" = 2 * 5 = 10
)
Prelude.>>
(doTest "test_fromInteger_pattern 9"
(tmPutStrLn (test_fromInteger_pattern 9)) -- "9" = 45, 45 "-" "7" = "7" = 35
)
Prelude.>>
(doTest "test_fromRational_pattern 0.5"
(tmPutStrLn (test_fromRational_pattern 0.5)) -- "0.5" = 3%2
)
Prelude.>>
(doTest "test_fromRational_pattern (-0.7)"
(tmPutStrLn (test_fromRational_pattern (-0.7))) -- "-0.7" = "0.7" = 21%10
)
Prelude.>>
(doTest "test_fromRational_pattern 1.7"
(tmPutStrLn (test_fromRational_pattern 1.7)) -- "1.7" = 51%10
);
}
start test test_do failure
++ >>
++ >>=
++ fail
-- fail
-- >>=
-- >>
end test test_do failure
start test test_do success
++ >>
++ >>=
++ return
-- return
-- >>=
-- >>
end test test_do success
start test test_fromInteger
135
end test test_fromInteger
start test test_fromRational
189 % 2
end test test_fromRational
start test test_negate
15
end test test_negate
start test test_fromInteger_pattern 1
1=5
end test test_fromInteger_pattern 1
start test test_fromInteger_pattern (-2)
(-2)=10
end test test_fromInteger_pattern (-2)
start test test_fromInteger_pattern 9
(a + 7)=35
end test test_fromInteger_pattern 9
start test test_fromRational_pattern 0.5
0.5=3 % 2
end test test_fromRational_pattern 0.5
start test test_fromRational_pattern (-0.7)
(-0.7)=21 % 10
end test test_fromRational_pattern (-0.7)
start test test_fromRational_pattern 1.7
_=51 % 10
end test test_fromRational_pattern 1.7
{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
module Main where
{
-- import Prelude;
import qualified Prelude;
import Prelude(String,undefined,Maybe(..),IO,putStrLn,Integer,(++),Rational);
debugFunc :: String -> IO a -> IO a;
debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
(ioa Prelude.>>= (\a ->
(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
));
return :: a -> IO a;
return a = debugFunc "return" (Prelude.return a);
infixl 1 >>=;
(>>=) :: IO a -> (a -> IO b) -> IO b;
(>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb);
infixl 1 >>;
(>>) :: IO a -> IO b -> IO b;
(>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb);
fail :: String -> IO a;
fail s = debugFunc "fail" (Prelude.return undefined);
-- fail s = debugFunc "fail" (Prelude.fail s);
fromInteger :: Integer -> Integer;
fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
fromRational :: Rational -> Rational;
fromRational a = a Prelude.+ a Prelude.+ a; -- three times
negate :: a -> a;
negate a = a; -- don't actually negate
(-) :: a -> a -> a;
(-) x y = y; -- changed function
test_do f g = do
{
f; -- >>
Just a <- g; -- >>= (and fail if g returns Nothing)
return a; -- return
};
test_fromInteger = 27;
test_fromRational = 31.5;
test_negate a = - a;
test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;
test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
test_fromRational_pattern a = "_=" ++ (Prelude.show a);
doTest :: String -> IO a -> IO ();
doTest s ioa =
(putStrLn ("start test " ++ s))
Prelude.>>
ioa
Prelude.>>
(putStrLn ("end test " ++ s));
main :: IO ();
main =
(doTest "test_do failure"
(test_do (Prelude.return ()) (Prelude.return Nothing))
)
Prelude.>>
(doTest "test_do success"
(test_do (Prelude.return ()) (Prelude.return (Just ())))
)
Prelude.>>
(doTest "test_fromInteger"
(putStrLn (Prelude.show test_fromInteger))
)
Prelude.>>
(doTest "test_fromRational"
(putStrLn (Prelude.show test_fromRational))
)
Prelude.>>
(doTest "test_negate"
(putStrLn (Prelude.show (test_negate 3)))
)
Prelude.>>
(doTest "test_fromInteger_pattern 1"
(putStrLn (test_fromInteger_pattern 1))
)
Prelude.>>
(doTest "test_fromInteger_pattern (-2)"
(putStrLn (test_fromInteger_pattern (-2)))
)
Prelude.>>
(doTest "test_fromInteger_pattern 9"
(putStrLn (test_fromInteger_pattern 9))
)
Prelude.>>
(doTest "test_fromRational_pattern 0.5"
(putStrLn (test_fromRational_pattern 0.5))
)
Prelude.>>
(doTest "test_fromRational_pattern (-0.7)"
(putStrLn (test_fromRational_pattern (-0.7)))
)
Prelude.>>
(doTest "test_fromRational_pattern 1.7"
(putStrLn (test_fromRational_pattern 1.7))
);
}
start test test_do failure
++ >>
++ >>=
++ fail
-- fail
-- >>=
-- >>
end test test_do failure
start test test_do success
++ >>
++ >>=
++ return
-- return
-- >>=
-- >>
end test test_do success
start test test_fromInteger
135
end test test_fromInteger
start test test_fromRational
189 % 2
end test test_fromRational
start test test_negate
15
end test test_negate
start test test_fromInteger_pattern 1
1=5
end test test_fromInteger_pattern 1
start test test_fromInteger_pattern (-2)
(-2)=10
end test test_fromInteger_pattern (-2)
start test test_fromInteger_pattern 9
(a + 7)=35
end test test_fromInteger_pattern 9
start test test_fromRational_pattern 0.5
0.5=3 % 2
end test test_fromRational_pattern 0.5
start test test_fromRational_pattern (-0.7)
(-0.7)=21 % 10
end test test_fromRational_pattern (-0.7)
start test test_fromRational_pattern 1.7
_=51 % 10
end test test_fromRational_pattern 1.7
{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
module Main where
{
-- import Prelude;
import qualified Prelude;
import Prelude(String,undefined,Maybe(..),IO,putStrLn,Integer,(++),Rational);
debugFunc :: String -> IO a -> IO a;
debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
(ioa Prelude.>>= (\a ->
(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
));
infixl 1 >>=;
infixl 1 >>;
class MyMonad m where
{
return :: a -> m a;
(>>=) :: m a -> (a -> m b) -> m b;
(>>) :: m a -> m b -> m b;
fail :: String -> m a;
};
instance MyMonad IO where
{
return a = debugFunc "return" (Prelude.return a);
(>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb);
(>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb);
fail s = debugFunc "fail" (Prelude.return undefined);
-- fail s = debugFunc "fail" (Prelude.fail s);
};
fromInteger :: Integer -> Integer;
fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
fromRational :: Rational -> Rational;
fromRational a = a Prelude.+ a Prelude.+ a; -- three times
negate :: a -> a;
negate a = a; -- don't actually negate
(-) :: a -> a -> a;
(-) x y = y; -- changed function
test_do f g = do
{
f; -- >>
Just a <- g; -- >>= (and fail if g returns Nothing)
return a; -- return
};
test_fromInteger = 27;
test_fromRational = 31.5;
test_negate a = - a;
test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;
test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
test_fromRational_pattern a = "_=" ++ (Prelude.show a);
doTest :: String -> IO a -> IO ();
doTest s ioa =
(putStrLn ("start test " ++ s))
Prelude.>>
ioa
Prelude.>>
(putStrLn ("end test " ++ s));
main :: IO ();
main =
(doTest "test_do failure"
(test_do (Prelude.return ()) (Prelude.return Nothing))
)
Prelude.>>
(doTest "test_do success"
(test_do (Prelude.return ()) (Prelude.return (Just ())))
)
Prelude.>>
(doTest "test_fromInteger"
(putStrLn (Prelude.show test_fromInteger))
)
Prelude.>>
(doTest "test_fromRational"
(putStrLn (Prelude.show test_fromRational))
)
Prelude.>>
(doTest "test_negate"
(putStrLn (Prelude.show (test_negate 3)))
)
Prelude.>>
(doTest "test_fromInteger_pattern 1"
(putStrLn (test_fromInteger_pattern 1))
)
Prelude.>>
(doTest "test_fromInteger_pattern (-2)"
(putStrLn (test_fromInteger_pattern (-2)))
)
Prelude.>>
(doTest "test_fromInteger_pattern 9"
(putStrLn (test_fromInteger_pattern 9))
)
Prelude.>>
(doTest "test_fromRational_pattern 0.5"
(putStrLn (test_fromRational_pattern 0.5))
)
Prelude.>>
(doTest "test_fromRational_pattern (-0.7)"
(putStrLn (test_fromRational_pattern (-0.7)))
)
Prelude.>>
(doTest "test_fromRational_pattern 1.7"
(putStrLn (test_fromRational_pattern 1.7))
);
}
start test test_do failure
++ >>
++ >>=
++ fail
-- fail
-- >>=
-- >>
end test test_do failure
start test test_do success
++ >>
++ >>=
++ return
-- return
-- >>=
-- >>
end test test_do success
start test test_fromInteger
135
end test test_fromInteger
start test test_fromRational
189 % 2
end test test_fromRational
start test test_negate
15
end test test_negate
start test test_fromInteger_pattern 1
1=5
end test test_fromInteger_pattern 1
start test test_fromInteger_pattern (-2)
(-2)=10
end test test_fromInteger_pattern (-2)
start test test_fromInteger_pattern 9
(a + 7)=35
end test test_fromInteger_pattern 9
start test test_fromRational_pattern 0.5
0.5=3 % 2
end test test_fromRational_pattern 0.5
start test test_fromRational_pattern (-0.7)
(-0.7)=21 % 10
end test test_fromRational_pattern (-0.7)
start test test_fromRational_pattern 1.7
_=51 % 10
end test test_fromRational_pattern 1.7
{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
module Main where
{
-- import Prelude;
import qualified Prelude;
import Prelude(String,undefined,Maybe(..),IO,putStrLn,Integer,(++),Rational);
debugFunc :: String -> IO a -> IO a;
debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
(ioa Prelude.>>= (\a ->
(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
));
infixl 1 >>=;
infixl 1 >>;
class HasReturn m where