[project @ 1999-11-02 11:57:15 by simonmar]

Add simple "raw" style callback example (i.e. not using the FFI).  Just
for testing _ccall_GC really.

diff --git a/ghc/tests/ccall/Makefile b/ghc/tests/ccall/Makefile
index af26578..938bf28 100644 (file)
--- a/ghc/tests/ccall/Makefile
+++ b/ghc/tests/ccall/Makefile
@@ -1,7 +1,7 @@
 TOP = ..
 include $(TOP)/mk/boilerplate.mk
 
-SUBDIRS = should_compile should_fail
+SUBDIRS = should_compile should_fail should_run
 
 include $(TOP)/mk/target.mk
 

diff --git a/ghc/tests/ccall/should_run/Makefile b/ghc/tests/ccall/should_run/Makefile
new file mode 100644 (file)
index 0000000..ee5edb1
--- /dev/null
+++ b/ghc/tests/ccall/should_run/Makefile
@@ -0,0 +1,11 @@
+#-----------------------------------------------------------------------------
+# $Id: Makefile,v 1.1 1999/11/02 11:57:16 simonmar Exp $
+
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/should_run.mk
+
+SRC_HC_OPTS += -dcore-lint -fglasgow-exts
+
+include $(TOP)/mk/target.mk
+

diff --git a/ghc/tests/ccall/should_run/callback.hs b/ghc/tests/ccall/should_run/callback.hs
new file mode 100644 (file)
index 0000000..8f8d1d6
--- /dev/null
+++ b/ghc/tests/ccall/should_run/callback.hs
@@ -0,0 +1,16 @@
+module Main (main, hputc) where
+
+import IO
+
+main = _casm_GC_ ``rts_evalIO(
+                       rts_apply(
+                         &Main_hputc_closure,
+                         rts_mkChar('x')
+                         ),
+                       NULL
+                  );'' :: IO ()
+
+hputc :: Char -> IO ()
+hputc c = hPutChar stdout c >> hPutChar stdout '\n'
+
+foreign export hputc :: Char -> IO ()

diff --git a/ghc/tests/ccall/should_run/callback.stdout b/ghc/tests/ccall/should_run/callback.stdout
new file mode 100644 (file)
index 0000000..587be6b
--- /dev/null
+++ b/ghc/tests/ccall/should_run/callback.stdout
@@ -0,0 +1 @@
+x