[commit: testsuite] master: Add a quotRem2 test (e128456)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/e1284566c57c90c0cd5de061ebd63b35956f2fd1

>---------------------------------------------------------------

commit e1284566c57c90c0cd5de061ebd63b35956f2fd1
Author: Ian Lynagh <igloo at earth.li>
Date:   Sat Apr 21 15:05:43 2012 +0100

    Add a quotRem2 test

>---------------------------------------------------------------

 tests/numeric/should_run/all.T           |    1 +
 tests/numeric/should_run/quotRem2.hs     |   34 ++++++++++++++++++++++++++++++
 tests/numeric/should_run/quotRem2.stdout |    3 ++
 3 files changed, 38 insertions(+), 0 deletions(-)

diff --git a/tests/numeric/should_run/all.T b/tests/numeric/should_run/all.T
index 2cfcae7..5849ca4 100644
--- a/tests/numeric/should_run/all.T
+++ b/tests/numeric/should_run/all.T
@@ -56,4 +56,5 @@ test('4383', normal, compile_and_run, [''])
 
 test('add2', normal, compile_and_run, [''])
 test('mul2', normal, compile_and_run, [''])
+test('quotRem2', normal, compile_and_run, [''])
 
diff --git a/tests/numeric/should_run/quotRem2.hs b/tests/numeric/should_run/quotRem2.hs
new file mode 100644
index 0000000..bb7fb6c
--- /dev/null
+++ b/tests/numeric/should_run/quotRem2.hs
@@ -0,0 +1,34 @@
+
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+import GHC.Prim
+import GHC.Word
+import Control.Monad
+import Data.Bits
+
+main :: IO ()
+main = do f 5 6 23
+          f 0x80000000 0 0x80000001
+          f 0xFC1D8A3BFB29FC6A 49 0xFD94E3B7FE36FB18
+
+f :: Word -> Word -> Word -> IO ()
+f wxHigh@(W# xHigh) wxLow@(W# xLow) wy@(W# y)
+    = do when debugging $ putStrLn "-----"
+         when debugging $ putStrLn ("Doing " ++ show (wxHigh, wxLow)
+                                             ++ " `quotRem` " ++ show wy)
+         let ix = (toInteger wxHigh `shiftL` bitSize wxHigh)
+              .|. toInteger wxLow
+             wanted = ix `quotRem` toInteger wy
+         when debugging $ putStrLn ("Wanted: " ++ show wanted)
+         case quotRemWord2# xHigh xLow y of
+             (# q, r #) ->
+                 do let wq = W# q
+                        wr = W# r
+                        got = (toInteger wq, toInteger wr)
+                    when debugging $ putStrLn ("Got: " ++ show got)
+                    if wanted == got then putStrLn "Worked"
+                                     else putStrLn "Failed"
+
+debugging :: Bool
+debugging = False
+
diff --git a/tests/numeric/should_run/quotRem2.stdout b/tests/numeric/should_run/quotRem2.stdout
new file mode 100644
index 0000000..e09c6b6
--- /dev/null
+++ b/tests/numeric/should_run/quotRem2.stdout
@@ -0,0 +1,3 @@
+Worked
+Worked
+Worked