testsuite: Add testcases for various machop issues

There were found by the test-primops testsuite.

11 files changed, 72 insertions, 0 deletions

diff --git a/testsuite/tests/cmm/should_run/machops/Makefile b/testsuite/tests/cmm/should_run/machops/Makefile
new file mode 100644
index 0000000000..1c39d1c1fe
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/Makefile
@@ -0,0 +1,3 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/cmm/should_run/machops/T20626a.cmm b/testsuite/tests/cmm/should_run/machops/T20626a.cmm
new file mode 100644
index 0000000000..0544e73dd3
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/T20626a.cmm
@@ -0,0 +1,3 @@
+test(bits64 buffer) {
+    return (%zx64(%shra(242::bits8, 1)));
+}
diff --git a/testsuite/tests/cmm/should_run/machops/T20626a.stdout b/testsuite/tests/cmm/should_run/machops/T20626a.stdout
new file mode 100644
index 0000000000..720fe955f1
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/T20626a.stdout
@@ -0,0 +1 @@
+249
diff --git a/testsuite/tests/cmm/should_run/machops/T20626b.cmm b/testsuite/tests/cmm/should_run/machops/T20626b.cmm
new file mode 100644
index 0000000000..e54b2e1691
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/T20626b.cmm
@@ -0,0 +1,4 @@
+test(bits64 buffer) {
+    return (%sx64((~(bits32[buffer])) >> (31::bits64)));
+}
+
diff --git a/testsuite/tests/cmm/should_run/machops/T20626b.stdout b/testsuite/tests/cmm/should_run/machops/T20626b.stdout
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/T20626b.stdout
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/cmm/should_run/machops/T20634.cmm b/testsuite/tests/cmm/should_run/machops/T20634.cmm
new file mode 100644
index 0000000000..c04a86b1c7
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/T20634.cmm
@@ -0,0 +1,11 @@
+test(bits64 buffer) {
+    bits64 ret;
+    ret = %zx64(%quot(%lobits8(0x00e1::bits16), 3::bits8));
+      //              ^^^^^^^^^^^^^^^^^^^^^^
+      //              == -31 signed
+      //        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      //        == -10 signed
+      //  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      //  == 0xf6 unsigned
+    return (ret);
+}
diff --git a/testsuite/tests/cmm/should_run/machops/T20634.stdout b/testsuite/tests/cmm/should_run/machops/T20634.stdout
new file mode 100644
index 0000000000..5d165ff285
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/T20634.stdout
@@ -0,0 +1 @@
+246
diff --git a/testsuite/tests/cmm/should_run/machops/T20638.cmm b/testsuite/tests/cmm/should_run/machops/T20638.cmm
new file mode 100644
index 0000000000..51fe449a76
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/T20638.cmm
@@ -0,0 +1,4 @@
+test(bits64 buffer) {
+  return (%zx64(%shrl(bits16[buffer + (128 :: bits64)], (1 :: bits64))) & (64711 :: bits64));
+}
+
diff --git a/testsuite/tests/cmm/should_run/machops/T20638.stdout b/testsuite/tests/cmm/should_run/machops/T20638.stdout
new file mode 100644
index 0000000000..5a54842902
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/T20638.stdout
@@ -0,0 +1 @@
+16576
diff --git a/testsuite/tests/cmm/should_run/machops/TestMachOp.hs b/testsuite/tests/cmm/should_run/machops/TestMachOp.hs
new file mode 100644
index 0000000000..08a81e9b63
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/TestMachOp.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE MagicHash #-}
+
+-- | This module is the driver for the Cmm machop tests. It expects to be
+-- linked with an object file (typically compiled Cmm) exposing a procedure
+-- named `test` which'
+--
+--   - takes a single pointer argument pointing to a buffer containing
+--     [0..bufferSz] (truncated to Word8).
+--
+--   - returns a Word#
+--
+-- The driver will print the returned result.
+
+module Main where
+
+import GHC.Exts
+import GHC.Ptr
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Unsafe as BS
+
+foreign import prim "test" test :: Addr# -> Word#
+
+bufferSz :: Int
+bufferSz = 1*1024*1024
+
+main :: IO ()
+main = do
+  let buf = BS.pack $ map fromIntegral [0..bufferSz]
+  BS.unsafeUseAsCString buf $ \(Ptr p) -> do
+    print $ W# (test p)
+
diff --git a/testsuite/tests/cmm/should_run/machops/all.T b/testsuite/tests/cmm/should_run/machops/all.T
new file mode 100644
index 0000000000..faad54a2ce
--- /dev/null
+++ b/testsuite/tests/cmm/should_run/machops/all.T
@@ -0,0 +1,10 @@
+setTestOpts(extra_files(['TestMachOp.hs']))
+
+def cmm_test(name):
+    test(name, normal, multi_compile_and_run,
+         ['TestMachOp', [(name+'.cmm', '')], ''])
+
+cmm_test('T20626a')
+cmm_test('T20626b')
+cmm_test('T20638')
+cmm_test('T20634')