diff options
Diffstat (limited to 'testsuite/tests/ffi/should_run/fed001.hs')
-rw-r--r-- | testsuite/tests/ffi/should_run/fed001.hs | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/testsuite/tests/ffi/should_run/fed001.hs b/testsuite/tests/ffi/should_run/fed001.hs new file mode 100644 index 0000000000..a832c58ac4 --- /dev/null +++ b/testsuite/tests/ffi/should_run/fed001.hs @@ -0,0 +1,30 @@ +import Control.Monad +import Foreign +import Foreign.Ptr + +type CInt = Int32 +type CSize = Word32 + +foreign import ccall "wrapper" + mkComparator :: (Ptr Int -> Ptr Int -> IO CInt) + -> IO (Ptr (Ptr Int -> Ptr Int -> IO CInt)) + +foreign import ccall + qsort :: Ptr Int -> CSize -> CSize -> Ptr (Ptr Int -> Ptr Int -> IO CInt) + -> IO () + +compareInts :: Ptr Int -> Ptr Int -> IO CInt +compareInts a1 a2 = do + i1 <- peek a1 + i2 <- peek a2 + return (fromIntegral (i1 - i2 :: Int)) + +main :: IO () +main = do + let values = [ 12, 56, 90, 34, 78 ] :: [Int] + n = length values + buf <- mallocArray n + zipWithM_ (pokeElemOff buf) [ 0 .. ] values + c <- mkComparator compareInts + qsort buf (fromIntegral n) (fromIntegral (sizeOf (head values))) c + mapM (peekElemOff buf) [ 0 .. n-1 ] >>= (print :: [Int] -> IO ()) |