From 2f6565cf5edd1d8b2d95f7c97d5875c05939c0ed Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Mon, 8 Nov 2021 10:25:40 -0500
Subject: [PATCH] testsuite: Add testcases for various machop issues
There were found by the test-primops testsuite.
---
.../tests/cmm/should_run/machops/Makefile | 3 ++
.../tests/cmm/should_run/machops/T20626a.cmm | 3 ++
.../cmm/should_run/machops/T20626a.stdout | 1 +
.../tests/cmm/should_run/machops/T20626b.cmm | 4 +++
.../cmm/should_run/machops/T20626b.stdout | 1 +
.../tests/cmm/should_run/machops/T20634.cmm | 11 +++++++
.../cmm/should_run/machops/T20634.stdout | 1 +
.../tests/cmm/should_run/machops/T20638.cmm | 4 +++
.../cmm/should_run/machops/T20638.stdout | 1 +
.../cmm/should_run/machops/TestMachOp.hs | 33 +++++++++++++++++++
testsuite/tests/cmm/should_run/machops/all.T | 10 ++++++
11 files changed, 72 insertions(+)
create mode 100644 testsuite/tests/cmm/should_run/machops/Makefile
create mode 100644 testsuite/tests/cmm/should_run/machops/T20626a.cmm
create mode 100644 testsuite/tests/cmm/should_run/machops/T20626a.stdout
create mode 100644 testsuite/tests/cmm/should_run/machops/T20626b.cmm
create mode 100644 testsuite/tests/cmm/should_run/machops/T20626b.stdout
create mode 100644 testsuite/tests/cmm/should_run/machops/T20634.cmm
create mode 100644 testsuite/tests/cmm/should_run/machops/T20634.stdout
create mode 100644 testsuite/tests/cmm/should_run/machops/T20638.cmm
create mode 100644 testsuite/tests/cmm/should_run/machops/T20638.stdout
create mode 100644 testsuite/tests/cmm/should_run/machops/TestMachOp.hs
create mode 100644 testsuite/tests/cmm/should_run/machops/all.T
diff --git a/testsuite/tests/cmm/should_run/machops/Makefile b/testsuite/tests/cmm/should_run/machops/Makefile
new file mode 100644
index 000000000000..1c39d1c1fed0
--- /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 000000000000..0544e73dd3d9
--- /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 000000000000..720fe955f189
--- /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 000000000000..e54b2e1691dc
--- /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 000000000000..d00491fd7e5b
--- /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 000000000000..c04a86b1c7e3
--- /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 000000000000..5d165ff28509
--- /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 000000000000..51fe449a767b
--- /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 000000000000..5a5484290252
--- /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 000000000000..08a81e9b63d8
--- /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 000000000000..faad54a2ce3f
--- /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')
--
GitLab