Add a test for add-with-carry
authorIan Lynagh <igloo@earth.li>
Thu, 23 Feb 2012 22:10:27 +0000 (22:10 +0000)
committerIan Lynagh <igloo@earth.li>
Thu, 23 Feb 2012 22:12:12 +0000 (22:12 +0000)
testsuite/tests/numeric/should_run/add2.hs [new file with mode: 0644]
testsuite/tests/numeric/should_run/add2.stdout [new file with mode: 0644]
testsuite/tests/numeric/should_run/all.T

diff --git a/testsuite/tests/numeric/should_run/add2.hs b/testsuite/tests/numeric/should_run/add2.hs
new file mode 100644 (file)
index 0000000..5990f4f
--- /dev/null
@@ -0,0 +1,26 @@
+
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+import GHC.Prim
+import GHC.Word
+import Data.Bits
+
+main :: IO ()
+main = do f 5 6
+          f maxBound 23
+          f maxBound maxBound
+
+f :: Word -> Word -> IO ()
+f wx@(W# x) wy@(W# y)
+    = do putStrLn "-----"
+         putStrLn ("Doing " ++ show wx ++ " + " ++ show wy)
+         case x `plusWord2#` y of
+             (# h, l #) ->
+                 do let wh = W# h
+                        wl = W# l
+                        r = shiftL (fromIntegral wh) (bitSize wh)
+                          + fromIntegral wl
+                    putStrLn ("High: " ++ show wh)
+                    putStrLn ("Low: " ++ show wl)
+                    putStrLn ("Result: " ++ show (r :: Integer))
+
diff --git a/testsuite/tests/numeric/should_run/add2.stdout b/testsuite/tests/numeric/should_run/add2.stdout
new file mode 100644 (file)
index 0000000..bdeff72
--- /dev/null
@@ -0,0 +1,15 @@
+-----
+Doing 5 + 6
+High: 0
+Low: 11
+Result: 11
+-----
+Doing 18446744073709551615 + 23
+High: 1
+Low: 22
+Result: 18446744073709551638
+-----
+Doing 18446744073709551615 + 18446744073709551615
+High: 1
+Low: 18446744073709551614
+Result: 36893488147419103230
index af46ec1..252d1af 100644 (file)
@@ -53,3 +53,6 @@ test('1603', skip, compile_and_run, [''])
 test('3676', expect_broken(3676), compile_and_run, [''])
 test('4381', normal, compile_and_run, [''])
 test('4383', normal, compile_and_run, [''])
+
+test('add2', normal, compile_and_run, [''])
+