[commit: testsuite] master: add test for the new bswap primops (95996c1)

[Ian Lynagh]

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

On branch  : master

https://github.com/ghc/testsuite/commit/95996c188380406a8b2382abc926f679588c5b2c

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

commit 95996c188380406a8b2382abc926f679588c5b2c
Author: Ian Lynagh <ian at well-typed.com>
Date:   Sun Jun 9 12:12:40 2013 +0100

    add test for the new bswap primops
    
    Patch from Vincent Hanquez.

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

 tests/codeGen/should_run/all.T           |    1 +
 tests/codeGen/should_run/cgrun072.hs     |   66 ++++++++++++++++++++++++++++++
 tests/codeGen/should_run/cgrun072.stdout |    4 ++
 3 files changed, 71 insertions(+), 0 deletions(-)

diff --git a/tests/codeGen/should_run/all.T b/tests/codeGen/should_run/all.T
index c4f1d63..e18bfa6 100644
--- a/tests/codeGen/should_run/all.T
+++ b/tests/codeGen/should_run/all.T
@@ -76,6 +76,7 @@ test('cgrun069', omit_ways(['ghci']), multi_compile_and_run,
                  ['cgrun069', [('cgrun069_cmm.cmm', '')], ''])
 test('cgrun070', normal, compile_and_run, [''])
 test('cgrun071', normal, compile_and_run, [''])
+test('cgrun072', normal, compile_and_run, [''])
 
 test('T1852', normal, compile_and_run, [''])
 test('T1861', extra_run_opts('0'), compile_and_run, [''])
diff --git a/tests/codeGen/should_run/cgrun072.hs b/tests/codeGen/should_run/cgrun072.hs
new file mode 100644
index 0000000..4a8b9aa
--- /dev/null
+++ b/tests/codeGen/should_run/cgrun072.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
+
+module Main ( main ) where
+
+import Data.Bits
+import GHC.Prim
+import GHC.Word
+
+#include "MachDeps.h"
+
+main = putStr
+       (test_bSwap16 ++ "\n"
+        ++ test_bSwap32 ++ "\n"
+        ++ test_bSwap64 ++ "\n"
+        ++ "\n"
+       )
+
+bswap16 :: Word16 -> Word16
+bswap16 (W16# w#) = W16# (bSwap16# w#)
+
+bswap32 :: Word32 -> Word32
+bswap32 (W32# w#) = W32# (bSwap32# w#)
+
+bswap64 :: Word64 -> Word64
+bswap64 (W64# w#) = W64# (bSwap64# w#)
+
+slowBswap64 :: Word64 -> Word64
+slowBswap64 w =
+        (w `shiftR` 56)                  .|. (w `shiftL` 56)
+    .|. ((w `shiftR` 40) .&. 0xff00)     .|. ((w .&. 0xff00) `shiftL` 40)
+    .|. ((w `shiftR` 24) .&. 0xff0000)   .|. ((w .&. 0xff0000) `shiftL` 24)
+    .|. ((w `shiftR` 8)  .&. 0xff000000) .|. ((w .&. 0xff000000) `shiftL` 8)
+
+-- | swap endianness on a Word32
+slowBswap32 :: Word32 -> Word32
+slowBswap32 w =
+         (w `shiftR` 24)             .|. (w `shiftL` 24)
+     .|. ((w `shiftR` 8) .&. 0xff00) .|. ((w .&. 0xff00) `shiftL` 8)
+
+-- | swap endianness on a Word16
+slowBswap16 :: Word16 -> Word16
+slowBswap16 w = (w `shiftR` 8) .|. (w `shiftL` 8)
+
+test_bSwap16 = test casesW16 bswap16 slowBswap16
+test_bSwap32 = test casesW32 bswap32 slowBswap32
+test_bSwap64 = test casesW64 bswap64 slowBswap64
+
+test :: (Eq a, Show a, Num a) => [a] -> (a -> a) -> (a -> a) -> String
+test cases fast slow = case failing of
+    [] -> "OK"
+    ((_, e, a, i):xs) ->
+        "FAIL\n" ++ "   Input: " ++ show i ++ "\nExpected: " ++ show e ++
+        "\n  Actual: " ++ show a
+  where
+    failing = dropWhile ( \(b,_,_,_) -> b)
+              . map (\ x -> (slow x == fast x, slow x, fast x, x)) $ cases
+    expected = map slow cases
+    actual = map fast cases
+
+casesW16 = [0xff00,0xf021,0x1234,0x5620,0x5463,0x0000,0xa00f,0x0201,0x2901]
+casesW32 = [1480294021,1626858410,2316287658,1246556957,3806579062,65945563,
+            1521588071,791321966,1355466914,2284998160]
+casesW64 = [11004539497957619752,5625461252166958202,1799960778872209546,
+            16979826074020750638,12789915432197771481,11680809699809094550,
+            13208678822802632247,13794454868797172383,13364728999716654549,
+            17516539991479925226]
diff --git a/tests/codeGen/should_run/cgrun072.stdout b/tests/codeGen/should_run/cgrun072.stdout
new file mode 100644
index 0000000..cfa280a
--- /dev/null
+++ b/tests/codeGen/should_run/cgrun072.stdout
@@ -0,0 +1,4 @@
+OK
+OK
+OK
+