From 42e01adfea287ed89f36c6641cc7437a7b8fe3aa Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 26 Apr 2000 10:43:23 +0000 Subject: [PATCH] [project @ 2000-04-26 10:43:23 by simonmar] Add Sven's qsort foreign export dynamic test. --- ghc/tests/ccall/should_run/Makefile | 5 ++++- ghc/tests/ccall/should_run/fed001.hs | 24 ++++++++++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) create mode 100644 ghc/tests/ccall/should_run/fed001.hs create mode 100644 ghc/tests/ccall/should_run/fed001.stdout diff --git a/ghc/tests/ccall/should_run/Makefile b/ghc/tests/ccall/should_run/Makefile index ee5edb1..c0e5e3e 100644 --- a/ghc/tests/ccall/should_run/Makefile +++ b/ghc/tests/ccall/should_run/Makefile @@ -1,5 +1,5 @@ #----------------------------------------------------------------------------- -# $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 diff --git a/ghc/tests/ccall/should_run/fed001.hs b/ghc/tests/ccall/should_run/fed001.hs new file mode 100644 index 0000000..22a4352 --- /dev/null +++ b/ghc/tests/ccall/should_run/fed001.hs @@ -0,0 +1,24 @@ +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 ()) diff --git a/ghc/tests/ccall/should_run/fed001.stdout b/ghc/tests/ccall/should_run/fed001.stdout new file mode 100644 index 0000000..e69de29 -- 1.7.10.4