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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/2f4d13348e2140f7fc0d4b8b995a2be0fa6291f0

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

commit 2f4d13348e2140f7fc0d4b8b995a2be0fa6291f0
Author: Johan Tibell <[email protected]>
Date:   Tue Jul 19 16:15:52 2011 +0200

    Add test for popCnt# primop

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

 tests/codeGen/should_run/all.T                     |    1 +
 tests/codeGen/should_run/cgrun071.hs               |   72 ++++++++++++++++++++
 .../should_run/cgrun071.stdout}                    |    1 +
 3 files changed, 74 insertions(+), 0 deletions(-)

diff --git a/tests/codeGen/should_run/all.T b/tests/codeGen/should_run/all.T
index f4a5dc6..fe381a1 100644
--- a/tests/codeGen/should_run/all.T
+++ b/tests/codeGen/should_run/all.T
@@ -75,6 +75,7 @@ test('cgrun068', reqlib('random'), compile_and_run, [''])
 test('cgrun069', omit_ways(['ghci']), multisrc_compile_and_run,
                  ['cgrun069', ['cgrun069_cmm.cmm'], ''])
 test('cgrun070', normal, compile_and_run, [''])
+test('cgrun071', normal, compile_and_run, [''])
 
 test('1852', normal, compile_and_run, [''])
 test('1861', extra_run_opts('0'), compile_and_run, [''])
diff --git a/tests/codeGen/should_run/cgrun071.hs 
b/tests/codeGen/should_run/cgrun071.hs
new file mode 100644
index 0000000..64631b8
--- /dev/null
+++ b/tests/codeGen/should_run/cgrun071.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
+
+module Main ( main ) where
+
+import Data.Bits
+import GHC.Prim
+import GHC.Word
+
+#include "MachDeps.h"
+
+main = putStr
+       (test_popCnt ++ "\n"
+        ++ test_popCnt8 ++ "\n"
+        ++ test_popCnt16 ++ "\n"
+        ++ test_popCnt32 ++ "\n"
+        ++ test_popCnt64 ++ "\n"
+        ++ "\n"
+       )
+
+popcnt :: Word -> Word
+popcnt (W# w#) = W# (popCnt# w#)
+
+popcnt8 :: Word8 -> Word
+popcnt8 (W8# w#) = W# (popCnt8# w#)
+
+popcnt16 :: Word16 -> Word
+popcnt16 (W16# w#) = W# (popCnt16# w#)
+
+popcnt32 :: Word32 -> Word
+popcnt32 (W32# w#) = W# (popCnt32# w#)
+
+popcnt64 :: Word64 -> Word
+popcnt64 (W64# w#) =
+#if SIZEOF_HSWORD == 4
+    W# (popCnt64# w#)
+#else
+    W# (popCnt# w#)
+#endif
+
+-- Cribbed from http://hackage.haskell.org/trac/ghc/ticket/3563
+slowPopcnt :: Word -> Word
+slowPopcnt x = count' (bitSize x) x 0
+  where
+    count' 0 _ !acc = acc
+    count' n x acc  = count' (n-1) (x `shiftR` 1)
+                      (acc + if x .&. 1 == 1 then 1 else 0)
+
+test_popCnt = test popcnt slowPopcnt
+test_popCnt8 = test popcnt8 (slowPopcnt . fromIntegral . (mask 8 .&.))
+test_popCnt16 = test popcnt16 (slowPopcnt . fromIntegral . (mask 16 .&.))
+test_popCnt32 = test popcnt32 (slowPopcnt . fromIntegral . (mask 32 .&.))
+test_popCnt64 = test popcnt64 (slowPopcnt . fromIntegral . (mask 64 .&.))
+
+mask n = (2 `shiftL` n) - 1
+
+test :: Num a => (a -> Word) -> (a -> Word) -> String
+test slow fast = show $ expected == actual
+  where
+    expected = map slow cases
+    actual = map fast cases
+    -- 10 random numbers
+#if SIZEOF_HSWORD == 4
+    cases = [1480294021,1626858410,2316287658,1246556957,3806579062,65945563,
+             1521588071,791321966,1355466914,2284998160]
+#elif SIZEOF_HSWORD == 8
+    cases = [11004539497957619752,5625461252166958202,1799960778872209546,
+             16979826074020750638,12789915432197771481,11680809699809094550,
+             13208678822802632247,13794454868797172383,13364728999716654549,
+             17516539991479925226]
+#else
+# error Unexpected word size
+#endif
diff --git a/tests/lib/should_run/rand001.stdout 
b/tests/codeGen/should_run/cgrun071.stdout
similarity index 96%
copy from tests/lib/should_run/rand001.stdout
copy to tests/codeGen/should_run/cgrun071.stdout
index 2e883c5..e946ef1 100644
--- a/tests/lib/should_run/rand001.stdout
+++ b/tests/codeGen/should_run/cgrun071.stdout
@@ -3,3 +3,4 @@ True
 True
 True
 True
+



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to