testsuite: Add test for #21465wip/T21465

4 files changed, 64 insertions, 0 deletions

diff --git a/testsuite/tests/rts/T21465/T21465.hs b/testsuite/tests/rts/T21465/T21465.hs
new file mode 100644
index 0000000000..1465359054
--- /dev/null
+++ b/testsuite/tests/rts/T21465/T21465.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Main where
+
+foreign import ccall "test_c" testC :: IO ()
+
+helper :: IO ()
+helper = putStrLn "This is the helper function"
+
+foreign export ccall helper :: IO ()
+
+main :: IO ()
+main = do
+    x <- testC
+    putStrLn "Done."
diff --git a/testsuite/tests/rts/T21465/T21465.stdout b/testsuite/tests/rts/T21465/T21465.stdout
new file mode 100644
index 0000000000..2ae74934f3
--- /dev/null
+++ b/testsuite/tests/rts/T21465/T21465.stdout
@@ -0,0 +1,18 @@
+This is the helper function
+Done.
+ 0: 01 01
+ 1: 02 02
+ 2: 03 03
+ 3: 04 04
+ 4: 05 05
+ 5: 06 06
+ 6: 07 07
+ 7: 08 08
+ 8: 09 09
+ 9: 0a 0a
+10: 0b 0b
+11: 0c 0c
+12: 0d 0d
+13: 0e 0e
+14: 0f 0f
+15: 10 10
diff --git a/testsuite/tests/rts/T21465/T21465_c.c b/testsuite/tests/rts/T21465/T21465_c.c
new file mode 100644
index 0000000000..3351027a91
--- /dev/null
+++ b/testsuite/tests/rts/T21465/T21465_c.c
@@ -0,0 +1,28 @@
+#include <stdio.h>
+
+// Haskell function
+extern void helper();
+
+void test_c() {
+    unsigned char blah[16] = {0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0A, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, 0x10};
+    unsigned char foo[16] = {0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+    // Copy blah into xmm6
+    asm (
+        "movups %[blah], %%xmm6"
+        :
+        : [blah] "m" (blah)
+        : "xmm6"
+    );
+    // Call to Haskell
+    helper();
+    // Copy xmm6 to foo
+    asm (
+        "movups %%xmm6, %[foo]"
+        : [foo] "=m" (foo)
+        :
+        : "xmm6"
+    );
+    for (int i = 0; i < 16; i++) {
+        printf("%2i: %02x %02x\n", i, blah[i], foo[i]);
+    }
+}
diff --git a/testsuite/tests/rts/T21465/all.T b/testsuite/tests/rts/T21465/all.T
new file mode 100644
index 0000000000..fd514113cd
--- /dev/null
+++ b/testsuite/tests/rts/T21465/all.T
@@ -0,0 +1,4 @@
+# Check that the full width of callee-saved XMM registers are preserved across
+# calls into Haskell on Windows.
+
+test('T21465', unless(opsys('mingw32') and arch('x86_64'), skip), compile_and_run, ['T21465_c.c'])