[commit: testsuite] master: add a test for stack pointer alignment (see #5250) (2cecdca)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/2cecdca7ed27a64dcf05cc4bd2187d96397bb055

>---------------------------------------------------------------

commit 2cecdca7ed27a64dcf05cc4bd2187d96397bb055
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Wed Jun 29 11:51:02 2011 +0100

    add a test for stack pointer alignment (see #5250)

>---------------------------------------------------------------

 tests/ghc-regress/rts/5250.hs   |   60 +++++++++++++++++++++++++++++++++++++++
 tests/ghc-regress/rts/all.T     |   10 ++++++
 tests/ghc-regress/rts/spalign.c |   30 +++++++++++++++++++
 3 files changed, 100 insertions(+), 0 deletions(-)

diff --git a/tests/ghc-regress/rts/5250.hs b/tests/ghc-regress/rts/5250.hs
new file mode 100644
index 0000000..f10c2e7
--- /dev/null
+++ b/tests/ghc-regress/rts/5250.hs
@@ -0,0 +1,60 @@
+module Main where
+
+import Foreign
+import Foreign.C
+import Text.Printf
+import System.Exit
+import Control.Monad
+
+foreign import ccall "getesp" getesp :: IO CInt
+
+main = do
+  checkSpAlignment
+  wrap checkSpAlignment >>= run
+  wrap1 args1 >>= \f -> run1 f 3
+  wrap2 args2 >>= \f -> run2 f 3 4
+  wrap3 args3 >>= \f -> run3 f 3 4 5
+  wrap4 args4 >>= \f -> run4 f 3 4 5 6
+
+foreign import ccall "wrapper" wrap :: IO () -> IO (FunPtr (IO ()))
+foreign import ccall "dynamic" run  :: FunPtr (IO ()) -> IO ()
+
+type Args1 = Int -> IO ()
+
+foreign import ccall "wrapper" wrap1 :: Args1 -> IO (FunPtr Args1)
+foreign import ccall "dynamic" run1  :: FunPtr Args1 -> Args1
+
+args1 :: Args1
+args1 _ = checkSpAlignment
+
+type Args2 = Int -> Int -> IO ()
+
+foreign import ccall "wrapper" wrap2 :: Args2 -> IO (FunPtr Args2)
+foreign import ccall "dynamic" run2  :: FunPtr Args2 -> Args2
+
+args2 :: Args2
+args2 _ _ = checkSpAlignment
+
+type Args3 = Int -> Int -> Int -> IO ()
+
+foreign import ccall "wrapper" wrap3 :: Args3 -> IO (FunPtr Args3)
+foreign import ccall "dynamic" run3  :: FunPtr Args3 -> Args3
+
+args3 :: Args3
+args3 _ _ _ = checkSpAlignment
+
+type Args4 = Int -> Int -> Int -> Int -> IO ()
+
+foreign import ccall "wrapper" wrap4 :: Args4 -> IO (FunPtr Args4)
+foreign import ccall "dynamic" run4  :: FunPtr Args4 -> Args4
+
+args4 :: Args4
+args4 _ _ _ _ = checkSpAlignment
+
+checkSpAlignment :: IO ()
+checkSpAlignment = do
+  esp <- getesp
+  when (((esp + fromIntegral (sizeOf (undefined :: Ptr ()))) .&. 15) /= 0) $ do
+     printf "esp not aligned correctly: %x\n" (fromIntegral esp :: Word32)
+     exitWith (ExitFailure 1)
+
diff --git a/tests/ghc-regress/rts/all.T b/tests/ghc-regress/rts/all.T
index a008e3b..172c295 100644
--- a/tests/ghc-regress/rts/all.T
+++ b/tests/ghc-regress/rts/all.T
@@ -105,3 +105,13 @@ test('return_mem_to_os', normal, compile_and_run, [''])
 
 test('4850', extra_clean(['4850.o','4850.hi','4850']),
              run_command, ['$MAKE -s --no-print-directory 4850'])
+
+def config_5250(opts):
+    if not (config.arch in ['i386','x86_64']):
+        opts.skip = 1;
+
+test('5250', [ config_5250,
+               extra_clean(['spalign.o']),
+               omit_ways(['ghci']) ],
+             compile_and_run, ['spalign.c'])
+
diff --git a/tests/ghc-regress/rts/spalign.c b/tests/ghc-regress/rts/spalign.c
new file mode 100644
index 0000000..0b776e1
--- /dev/null
+++ b/tests/ghc-regress/rts/spalign.c
@@ -0,0 +1,30 @@
+#include "Rts.h"
+
+#ifdef darwin_HOST_OS
+#define STG_GLOBAL ".globl "
+#else
+#define STG_GLOBAL ".global "
+#endif
+
+#ifdef LEADING_UNDERSCORE
+#define GETESP "_getesp"
+#else
+#define GETESP "getesp"
+#endif
+
+void __dummy__(void)
+{
+        __asm__ volatile (
+        STG_GLOBAL GETESP "\n"
+        GETESP ":\n\t"
+
+#if defined(i386_HOST_ARCH)
+        "movl %%esp, %%eax\n\t"
+#elif defined(x86_64_HOST_ARCH)
+        "movq %%rsp, %%rax\n\t"
+#else
+#error splign.c: not implemented for this architecture
+#endif
+        "ret"
+        : : );
+}