Add a test for the calling convention of "foreign import prim" on x86_64 and AArch64

5 files changed, 96 insertions, 0 deletions

diff --git a/testsuite/tests/codeGen/should_run/CallConv.hs b/testsuite/tests/codeGen/should_run/CallConv.hs
new file mode 100644
index 0000000000..937e51ba09
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CallConv.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE MagicHash, GHCForeignImportPrim, UnboxedTuples, UnliftedFFITypes #-}
+import GHC.Exts
+
+foreign import prim "someFuncF"
+  someFuncF :: Float# -> Float# -> Float# -> Float# -> (# Float#, Float#, Float#, Float# #)
+
+foreign import prim "someFuncD"
+  someFuncD :: Double# -> Double# -> Double# -> Double# -> (# Double#, Double#, Double#, Double# #)
+
+{-
+someFuncF :: Float# -> Float# -> Float# -> Float# -> (# Float#, Float#, Float#, Float# #)
+someFuncF x y z w = (# x `plusFloat#` y, x `minusFloat#` y, z `timesFloat#` w, z `divideFloat#` w #)
+
+someFuncD :: Double# -> Double# -> Double# -> Double# -> (# Double#, Double#, Double#, Double# #)
+someFuncD x y z w = (# x +## y, x -## y, z *## w, z /## w #)
+-}
+
+main = do
+  case someFuncF 1.0# 3.0# 4.0# 2.0# of
+    (# a, b, c, d #) -> do
+      print (F# a)
+      print (F# b)
+      print (F# c)
+      print (F# d)
+  case someFuncD 1.0## 3.0## 4.0## 2.0## of
+    (# a, b, c, d #) -> do
+      print (D# a)
+      print (D# b)
+      print (D# c)
+      print (D# d)
diff --git a/testsuite/tests/codeGen/should_run/CallConv.stdout b/testsuite/tests/codeGen/should_run/CallConv.stdout
new file mode 100644
index 0000000000..23b7f8f2cf
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CallConv.stdout
@@ -0,0 +1,8 @@
+4.0
+-2.0
+8.0
+2.0
+4.0
+-2.0
+8.0
+2.0
diff --git a/testsuite/tests/codeGen/should_run/CallConv_aarch64.s b/testsuite/tests/codeGen/should_run/CallConv_aarch64.s
new file mode 100644
index 0000000000..ccff9cbe04
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CallConv_aarch64.s
@@ -0,0 +1,25 @@
+	.globl _someFuncF
+_someFuncF:
+	.globl someFuncF
+someFuncF:
+	fadd s16, s8, s9
+	fsub s9, s8, s9
+	fmov s8, s16
+	fmul s16, s10, s11
+	fdiv s11, s10, s11
+	fmov s10, s16
+	ldr x8, [x20]
+	blr x8
+
+	.globl _someFuncD
+_someFuncD:
+	.globl someFuncD
+someFuncD:
+	fadd d16, d12, d13
+	fsub d13, d12, d13
+	fmov d12, d16
+	fmul d16, d14, d15
+	fdiv d15, d14, d15
+	fmov d14, d16
+	ldr x8, [x20]
+	blr x8
diff --git a/testsuite/tests/codeGen/should_run/CallConv_x86_64.s b/testsuite/tests/codeGen/should_run/CallConv_x86_64.s
new file mode 100644
index 0000000000..e108724aa0
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CallConv_x86_64.s
@@ -0,0 +1,27 @@
+	.globl _someFuncF
+_someFuncF:
+	.globl someFuncF
+someFuncF:
+	movss %xmm1,%xmm0
+	subss %xmm2,%xmm0
+	addss %xmm2,%xmm1
+	movss %xmm0,%xmm2
+	movss %xmm3,%xmm0
+	divss %xmm4,%xmm0
+	mulss %xmm4,%xmm3
+	movss %xmm0,%xmm4
+	jmp *(%rbp)
+
+	.globl _someFuncD
+_someFuncD:
+	.globl someFuncD
+someFuncD:
+	movsd %xmm1,%xmm0
+	subsd %xmm2,%xmm0
+	addsd %xmm2,%xmm1
+	movsd %xmm0,%xmm2
+	movsd %xmm3,%xmm0
+	divsd %xmm4,%xmm0
+	mulsd %xmm4,%xmm3
+	movsd %xmm0,%xmm4
+	jmp *(%rbp)
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index 71c53b07ea..b744ec97e9 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -210,3 +210,9 @@ test('T16846', [only_ways(['optasm']), exit_code(1)], compile_and_run, [''])
 test('T17920', cmm_src, compile_and_run, [''])
 test('T18527', normal, compile_and_run, ['T18527FFI.c'])
 test('T19149', only_ways('sanity'), compile_and_run, ['T19149_c.c'])
+
+test('CallConv', [when(unregisterised(), skip),
+                  unless(arch('x86_64') or arch('aarch64'), skip),
+                  when(arch('x86_64'), extra_hc_opts('CallConv_x86_64.s')),
+                  when(arch('aarch64'), extra_hc_opts('CallConv_aarch64.s'))],
+     compile_and_run, [''])