From: simonmar <unknown>
Date: Tue, 2 Nov 1999 11:57:16 +0000 (+0000)
Subject: [project @ 1999-11-02 11:57:15 by simonmar]
X-Git-Tag: Approximately_9120_patches~5614
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=c6f67e9416e0688a950a079efef8449d3c5c4c6e;p=ghc-hetmet.git

[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
--- 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
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
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
index 0000000..587be6b
--- /dev/null
+++ b/ghc/tests/ccall/should_run/callback.stdout
@@ -0,0 +1 @@
+x