Commit ec102106 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Add test for Hugs #37

parent e00058d8
......@@ -58,3 +58,4 @@ test('cg057', compose( only_ways(['prof','profasm']),
extra_run_opts('+RTS -xc') ),
compile_and_run, [''])
test('cg058', normal, compile_and_run, [''])
-- Not really a code-gen test, but this program gave
-- incorrect results in Hugs (Husg Trac #37), so I
-- thought I'd add it to GHC's test suite.
module Main where
data MInt = Zero | Succ MInt | Pred MInt deriving Show
tn :: Int -> MInt
tn x | x<0 = Pred (tn (x+1))
tn 0 = Zero
tn (n+1) = Succ (tn n)
ti :: MInt -> Int
ti Zero = 0
ti (Succ x) = 1+(ti x)
ti (Pred x) = (ti x) -1
testi :: (MInt -> MInt -> MInt) -> (Int -> Int -> Int) -> Int -> Int -> Bool
testi f g x y = (ti (f (tn x) (tn y))) /= (g x y)
myMul x y = tn ((ti x) * (ti y))
-- test should be empty!
test = [ (x,y,ti (myMul (tn x) (tn y)),x * y)
| x<-[-100..100],
y<-([-100..(-1)]++[1..100]),
testi myMul (*) x y ]
main = print test
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