summaryrefslogtreecommitdiff
path: root/testsuite/tests/rts/5250.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/rts/5250.hs')
-rw-r--r--testsuite/tests/rts/5250.hs60
1 files changed, 60 insertions, 0 deletions
diff --git a/testsuite/tests/rts/5250.hs b/testsuite/tests/rts/5250.hs
new file mode 100644
index 0000000000..f10c2e7c47
--- /dev/null
+++ b/testsuite/tests/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)
+