[project @ 2000-04-26 10:43:23 by simonmar]

Add Sven's qsort foreign export dynamic test.

ghc/tests/ccall/should_run/Makefile

 #-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.1 1999/11/02 11:57:16 simonmar Exp $
+# $Id: Makefile,v 1.2 2000/04/26 10:43:23 simonmar Exp $
 
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
@@ -7,5 +7,8 @@ include $(TOP)/mk/should_run.mk
 
 SRC_HC_OPTS += -dcore-lint -fglasgow-exts
 
+callback_LD_OPTS = callback_stub.o
+fed001_LD_OPTS = fed001_stub.o
+
 include $(TOP)/mk/target.mk
 

ghc/tests/ccall/should_run/fed001.hs

+import Foreign
+import Monad
+
+type CInt  = Int32
+type CSize = Word32
+
+foreign export dynamic mkComparator :: (Addr -> Addr -> IO CInt) -> IO Addr
+foreign import qsort :: Addr -> CSize -> CSize -> Addr -> IO ()
+
+compareInts :: Addr -> Addr -> 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 <- mallocElems (head values) 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 ())