1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
-- Not really a code-gen test, but this program gave
-- incorrect results in Hugs (Hugs 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 = Succ (tn (n - 1))
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, -99, -98, -97, -2, -1, 0, 1, 2, 97, 98, 99, 100],
y<-([-100..(-1)]++[1..100]),
testi myMul (*) x y ]
main = print test
|
