From c6f67e9416e0688a950a079efef8449d3c5c4c6e Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Tue, 2 Nov 1999 11:57:16 +0000
Subject: [PATCH] [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.

---
 ghc/tests/ccall/Makefile                   |    2 +-
 ghc/tests/ccall/should_run/Makefile        |   11 +++++++++++
 ghc/tests/ccall/should_run/callback.hs     |   16 ++++++++++++++++
 ghc/tests/ccall/should_run/callback.stdout |    1 +
 4 files changed, 29 insertions(+), 1 deletion(-)
 create mode 100644 ghc/tests/ccall/should_run/Makefile
 create mode 100644 ghc/tests/ccall/should_run/callback.hs
 create mode 100644 ghc/tests/ccall/should_run/callback.stdout

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
-- 
1.7.10.4