summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2019-04-02 11:59:06 -0400
committerBen Gamari <ben@well-typed.com>2019-06-08 13:42:16 -0400
commit5372ed22c18e514f7e7893a900f1b29dc602cc24 (patch)
treeca25d4bca8b51716b546192ad37b8877946b8626
parent709290b01c3c63137d863d6fdd97dabdfe47eb29 (diff)
downloadhaskell-wip/T16514.tar.gz
testsuite: Add test for #16514wip/T16514
-rw-r--r--testsuite/tests/rts/T16514.hs18
-rw-r--r--testsuite/tests/rts/T16514.stdout4
-rw-r--r--testsuite/tests/rts/T16514_c.cpp45
-rw-r--r--testsuite/tests/rts/all.T1
4 files changed, 68 insertions, 0 deletions
diff --git a/testsuite/tests/rts/T16514.hs b/testsuite/tests/rts/T16514.hs
new file mode 100644
index 0000000000..12e0d36221
--- /dev/null
+++ b/testsuite/tests/rts/T16514.hs
@@ -0,0 +1,18 @@
+-- ensure that the XMM register values are properly preserved across STG
+-- exit/entry. Note that this is very sensitive to code generation.
+
+module Main where
+
+import Control.Monad (when)
+import System.Exit (exitWith, ExitCode(..))
+
+foreign export ccall fn_hs :: IO ()
+
+fn_hs :: IO ()
+fn_hs = return ()
+
+foreign import ccall test :: IO Int
+
+main :: IO ()
+main = do res <- test
+ when (res /= 0) (exitWith $ ExitFailure res)
diff --git a/testsuite/tests/rts/T16514.stdout b/testsuite/tests/rts/T16514.stdout
new file mode 100644
index 0000000000..6b582809d2
--- /dev/null
+++ b/testsuite/tests/rts/T16514.stdout
@@ -0,0 +1,4 @@
+1.414210 1.732050 2.236070 2.828430 3.605550 4.582580
+1.414210 1.732050 2.236070 2.828430 3.605550 4.582580
+1.414210 1.732050 2.236070 2.828430 3.605550 4.582580
+
diff --git a/testsuite/tests/rts/T16514_c.cpp b/testsuite/tests/rts/T16514_c.cpp
new file mode 100644
index 0000000000..1474741ec0
--- /dev/null
+++ b/testsuite/tests/rts/T16514_c.cpp
@@ -0,0 +1,45 @@
+#include <iostream>
+#include <stdexcept>
+
+extern "C" {
+
+void fn_hs();
+void fn() {
+ fn_hs();
+}
+
+void check(double sqrt2, double sqrt3, double sqrt5,
+ double sqrt8, double sqrt13, double sqrt21) {
+ std::cout << std::fixed << sqrt2 << " " << sqrt3 << " " << sqrt5 << " "
+ << sqrt8 << " " << sqrt13 << " " << sqrt21 << std::endl;
+ if (sqrt2 != 1.41421 || sqrt3 != 1.73205 || sqrt5 != 2.23607 ||
+ sqrt8 != 2.82843 || sqrt13 != 3.60555 || sqrt21 != 4.58258) {
+ throw std::runtime_error("xmm registers have been scratched");
+ }
+}
+
+int test() {
+ try {
+ double sqrt2 = 1.41421;
+ double sqrt3 = 1.73205;
+ double sqrt5 = 2.23607;
+ double sqrt8 = 2.82843;
+ double sqrt13 = 3.60555;
+ double sqrt21 = 4.58258;
+ check(sqrt2, sqrt3, sqrt5, sqrt8, sqrt13, sqrt21);
+ fn();
+ check(sqrt2, sqrt3, sqrt5, sqrt8, sqrt13, sqrt21);
+ try {
+ fn();
+ } catch (const std::exception &) {
+ }
+ check(sqrt2, sqrt3, sqrt5, sqrt8, sqrt13, sqrt21);
+ } catch (const std::exception &e) {
+ std::cerr << e.what() << std::endl;
+ return 1;
+ }
+ return 0;
+}
+
+} // extern "C"
+
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 86f79c26f9..bf0b48ac08 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -390,3 +390,4 @@ test('keep-cafs',
],
makefile_test, ['KeepCafs'])
+test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp -lstdc++'])