Add a quotRem2 test
authorIan Lynagh <igloo@earth.li>
Sat, 21 Apr 2012 14:05:43 +0000 (15:05 +0100)
committerIan Lynagh <igloo@earth.li>
Sat, 21 Apr 2012 14:05:43 +0000 (15:05 +0100)
testsuite/tests/numeric/should_run/all.T
testsuite/tests/numeric/should_run/quotRem2.hs [new file with mode: 0644]
testsuite/tests/numeric/should_run/quotRem2.stdout [new file with mode: 0644]

index 2cfcae7..5849ca4 100644 (file)
@@ -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/testsuite/tests/numeric/should_run/quotRem2.hs b/testsuite/tests/numeric/should_run/quotRem2.hs
new file mode 100644 (file)
index 0000000..bb7fb6c
--- /dev/null
@@ -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/testsuite/tests/numeric/should_run/quotRem2.stdout b/testsuite/tests/numeric/should_run/quotRem2.stdout
new file mode 100644 (file)
index 0000000..e09c6b6
--- /dev/null
@@ -0,0 +1,3 @@
+Worked
+Worked
+Worked