summaryrefslogtreecommitdiff
path: root/testsuite/tests/codeGen/should_run/cgrun058.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/codeGen/should_run/cgrun058.hs')
-rw-r--r--testsuite/tests/codeGen/should_run/cgrun058.hs30
1 files changed, 30 insertions, 0 deletions
diff --git a/testsuite/tests/codeGen/should_run/cgrun058.hs b/testsuite/tests/codeGen/should_run/cgrun058.hs
new file mode 100644
index 0000000000..f0001584d1
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/cgrun058.hs
@@ -0,0 +1,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