Update examples

testsuite/README

@@ -0,0 +1,17 @@
+These examples illustrate the various uses of hs-plugins.
+
+conf		a configuration file edsl using plugins
+dynload		dynamically typed load
+eval		runtime evaluation of haskell strings, from Haskell and C
+hmake		the 'plugs' haskell interpreter
+iface		test the interface file parser
+load		load a plugin
+make		build a Haskell file
+makewith	merge and build a Haskell file
+multi		load multiple plugins at once
+objc		load Haskell plugins into object C programs
+pkgconf		test package.conf parsing
+popen		test popen
+reload		reload a plugin when it changes
+shell		a simple string filter
+unload		test unloading of plugins

testsuite/TIMINGS

@@ -0,0 +1,45 @@
+Method:
+	* "pdynload" 
+		comes from pdynload/small
+	* "load + ghc" 
+		comes from pdynload/null, with lines 13-14
+		uncommented from prog/Main.hs
+	* "dynload" 
+		from dynload/simple
+	* "load, no check"
+		from pdynload/null, with lines 13-14 of prog/Main.hs
+		commented out
+
+For example, to run the "pdynload" test:
+	$ cd pdynload/small
+	$ make
+	$ make check	  # to prime caches, etc.
+	$ time make check
+	$ time make check
+	$ time make check # run 'time make check' until value converges
+
+The converged value is entered into the "Raw" timings, and then the
+scaled timing is calculated for each machine. These scaled values were
+then averaged over the number of machines, yielding the final
+"Average" scores -- the average over a number of machines and os.
+
+Raw timing:
+pdynload 	load+ghc	dynload		load, no check
+
+0.33		0.25		0.22		0.21	-- P4 2.6 ,  OpenBSD
+0.38		0.31		0.29		0.27	-- P4 2.66,  Linux
+0.84		0.77		0.64		0.55	-- Quad P4 2.4, Linux
+0.76		0.60		0.52		0.50	-- AMD 1.1G, Linux
+0.95            0.83            0.75            0.72    -- G5 2.0G,  Mac OS X
+							-- Quad Itanium 1,Linux
+
+Scaled:
+1.57		1.19		1.05		1
+1.40		1.15		1.07
+1.52		1.4		1.16
+1.52		1.2		1.04
+1.32            1.15            1.04
+
+Average:
+=1.46         =	1.218	      = 1.07
+					

testsuite/build.mk

@@ -0,0 +1,40 @@
+# how to build the default projects
+
+include $(TOP)/config.mk
+include $(TOP)/testsuite/check.mk
+
+BIN= 		prog/a.out
+OBJ=		prog/Main.o
+SRC=		prog/Main.hs
+
+BINDIR=		prog
+REALBIN=	./a.out
+
+API_OBJ=	api/API.o
+
+INCLUDES=   	-i$(TOP)/testsuite/$(TEST)/api
+GHCFLAGS=   	-Onot -cpp -fglasgow-exts
+
+.SUFFIXES : .o .hs .hi .lhs .hc .s
+
+all: $(BIN)
+
+$(BIN) : $(PRIOR_OBJS) $(API_OBJ) $(SRC) $(EXTRA_OBJS)
+	@rm -f $@
+	@$(GHC) --make -o $@ $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) $(API) $(SRC)
+
+# Standard suffix rules
+.o.hi:
+	@:
+.hs.o:
+	@$(GHC) $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) -c $<
+
+clean:
+	find . -name '*~' -exec rm {} \;
+	rm -rf *.{o,hi,dep}
+	rm -rf */*.{hi,o,old} */a.out
+	rm -rf */*core
+	rm -rf */*.a
+	rm -rf */package.conf
+	rm -rf *.a
+

testsuite/check.mk

@@ -0,0 +1,24 @@
+include $(TOP)/config.mk
+
+check: $(BIN)
+	@(cd $(BINDIR) ;\
+	  expected="expected" ;\
+          if [ -f "expected" -o -f "expected.$(GLASGOW_HASKELL)" ] ;\
+	  then \
+		actual_out="/tmp/hs-plugins-actual.out.$$$$"	   ;\
+		diff_out="/tmp/hs-plugins.diff.$$$$"		   ;\
+		$(REALBIN) > $$actual_out  2>&1         || true ;\
+		if [ -f "expected.$(GLASGOW_HASKELL)" ] ; then \
+			expected="expected.$(GLASGOW_HASKELL)" ;\
+		fi ;\
+		diff -u $$expected $$actual_out > $$diff_out || true ;\
+		if [ -s "$$diff_out" ] ; then \
+			echo "failed with:"	;\
+			cat "$$diff_out" | sed '1,3d' ;\
+		else \
+			echo "ok." 	;\
+		fi ;\
+		rm $$actual_out $$diff_out	;\
+	 else \
+		$(REALBIN) 2>&1 || true ;\
+	 fi)

testsuite/conf/simple/Mailrc.conf

@@ -0,0 +1,11 @@
+import System.Directory
+
+resource = mail { 
+--	editor = do b <- doesFileExist "/usr/bin/emacs"
+--		    return $ if b then "emacs" else "vi" ,
+	editor = do b <- doesFileExist "/bin/sh"
+  		    return "sh",
+
+	attribution = \name -> "Today, "++name++" wrote :"
+}
+

testsuite/conf/simple/Mailrc.stub

@@ -0,0 +1,28 @@
+module Mailrc ( resource )  where
+
+import API
+
+resource :: Interface
+resource = mail
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

testsuite/conf/simple/Makefile

@@ -0,0 +1,4 @@
+TEST=	conf/simple
+
+TOP=../../..
+include ../../build.mk

testsuite/conf/simple/api/API.hs

@@ -0,0 +1,27 @@
+--
+-- the configuration file interface.
+--
+
+module API where
+
+data Color = Black | Grey | Green | Cyan | Yellow | Magenta | Red
+
+data Interface = Interface {
+        editor          :: IO String,
+        attribution     :: String -> String,
+        header_color    :: Color,
+        colorize        :: [String],
+        include         :: Bool
+     }
+
+-- Default settings
+mail :: Interface
+mail = Interface { 
+        editor = return "vi",
+
+        attribution = (\user -> user ++ " wrote:"),
+        header_color = Grey,
+        colorize = [],
+        include = True
+     }
+

testsuite/conf/simple/prog/Main.hs

@@ -0,0 +1,22 @@
+
+import System.Plugins
+import API
+
+conf    = "../Mailrc.conf"
+stub    = "../Mailrc.stub"
+apipath = "../api"
+
+main = do
+        status <- makeWith conf stub ["-i"++apipath]
+        o <- case status of
+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess _ o -> return o
+        status <- load o [apipath] [] "resource"
+        v <- case status of
+                LoadFailure err   -> mapM_ putStrLn err >> error "no"
+                LoadSuccess _ v -> return v
+        
+        user_editor <- editor v
+        putStrLn user_editor
+        makeCleaner o
+

testsuite/conf/simple/prog/expected

@@ -0,0 +1 @@
+sh

testsuite/dynload/io/Makefile

@@ -0,0 +1,6 @@
+TEST=dynload/io
+
+EXTRA_OBJS=TestIO.o
+
+TOP=../../..
+include ../../build.mk

testsuite/dynload/io/TestIO.hs

@@ -0,0 +1,86 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+--
+-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
+-- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html)
+--
+
+module TestIO ( resource_dyn )  where
+
+import API
+import AltData.Dynamic
+
+import System.IO
+import System.Posix.Types   ( ProcessID, Fd )
+import System.Posix.Process ( forkProcess, executeFile, getProcessID )
+import System.Posix.IO      ( createPipe, stdInput, 
+                              stdOutput, fdToHandle, closeFd, dupTo )
+
+resource_dyn :: Dynamic
+resource_dyn = toDyn resource
+
+resource :: TestIO
+resource = testio { field = date }
+
+
+--
+-- call a shell command , returning it's output
+--
+date :: IO String
+date = do (hdl,_,_) <- catch (popen "/bin/date") (\_->error "popen failed")
+          hGetLine hdl 
+
+------------------------------------------------------------------------
+--
+-- my implementation of $val = `cmd`; (if this was perl)
+--
+-- provide similar functionality to popen(3), 
+-- along with bidirectional ipc via pipes
+-- return's the pid of the child process
+--
+-- there are two different forkProcess functions. the pre-620 was a
+-- unix-fork style function, and the modern function has semantics more
+-- like the Awkward-Squad paper. We provide implementations of popen
+-- using both versions, depending on which GHC the user wants to try.
+-- 
+
+popen :: FilePath -> IO (Handle, Handle, ProcessID)
+popen cmd = do
+        (pr, pw) <- createPipe
+        (cr, cw) <- createPipe    
+
+        -- parent --
+        let parent = do closeFd cw
+                        closeFd pr
+        -- child --
+        let child  = do closeFd pw
+                        closeFd cr 
+                        exec cmd (pr,cw)
+                        error "exec cmd failed!" -- typing only
+
+-- if the parser front end understood cpp, this would work
+-- #if __GLASGOW_HASKELL__ >= 601
+        pid <- forkProcess child -- fork child
+        parent                   -- and run parent code
+-- #else
+--          p   <- forkProcess
+--          pid <- case p of
+--                  Just pid -> parent >> return pid
+--                  Nothing  -> child
+-- #endif
+
+        hcr <- fdToHandle cr
+        hpw <- fdToHandle pw
+
+        return (hcr,hpw,pid)
+
+--
+-- execve cmd in the child process, dup'ing the file descriptors passed
+-- as arguments to become the child's stdin and stdout.
+--
+exec :: FilePath -> (Fd,Fd) -> IO ()
+exec cmd (pr,cw) = do
+        dupTo pr stdInput
+        dupTo cw stdOutput
+        executeFile cmd False [] Nothing
+
+------------------------------------------------------------------------

testsuite/dynload/io/api/API.hs

@@ -0,0 +1,19 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module API where
+
+import AltData.Typeable
+
+data TestIO = TestIO { 
+                field :: IO String 
+        }
+
+instance Typeable TestIO where
+#if __GLASGOW_HASKELL__ >= 603
+    typeOf i = mkTyConApp (mkTyCon "API.TestIO") []
+#else
+    typeOf i = mkAppTy (mkTyCon "API.TestIO") []
+#endif
+
+testio :: TestIO
+testio = TestIO { field = return "default value" }

testsuite/dynload/io/prog/Main.hs

@@ -0,0 +1,12 @@
+
+import System.Plugins
+import API
+
+main = do
+        m_v   <- dynload "../TestIO.o" ["../api"] 
+                                       [] "resource_dyn"
+        case m_v of
+                LoadFailure _   -> error "couldn't compile"
+                LoadSuccess _ v -> do 
+                        s <- field v
+                        if s /= [] then print True else print False

testsuite/dynload/io/prog/expected

@@ -0,0 +1 @@
+True

testsuite/dynload/poly/Makefile

@@ -0,0 +1,4 @@
+TEST=dynload/poly
+EXTRA_OBJS=Plugin.o
+TOP=../../..
+include ../../build.mk

testsuite/dynload/poly/Plugin.hs

@@ -0,0 +1,12 @@
+module Plugin where
+
+import API
+import AltData.Dynamic
+
+my_fun = plugin { 
+                equals = \x y -> (x /= y)  -- a strange equals function :)
+         }
+
+resource_dyn :: Dynamic
+resource_dyn = toDyn my_fun
+

testsuite/dynload/poly/api/API.hs

@@ -0,0 +1,24 @@
+{-# OPTIONS -cpp #-}
+
+module API where
+
+import AltData.Typeable
+
+data Interface = Interface { 
+        equals :: forall t. Eq t => t -> t -> Bool
+     }
+
+--
+-- see how it hides the internal type.. but to compile GHC still checks
+-- the type.
+--
+instance Typeable Interface where
+#if __GLASGOW_HASKELL__ >= 603
+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []
+#else
+    typeOf i = mkAppTy (mkTyCon "API.Interface") []
+#endif
+
+plugin :: Interface
+plugin = Interface  { equals = (==) }
+

testsuite/dynload/poly/prog/Main.hs

@@ -0,0 +1,17 @@
+{-# OPTIONS -cpp #-}
+
+#include "../../../../config.h"
+
+import System.Plugins
+import API
+
+main = do 
+        m_v <- dynload "../Plugin.o" ["../api"]
+                                     [] 
+                                     "resource_dyn"
+        case m_v of
+                LoadFailure _ -> error "didn't compile"
+                LoadSuccess _ (Interface eq) -> do
+                                 putStrLn $ show $   1 `eq` 2
+                                 putStrLn $ show $ 'a' `eq` 'b'
+

testsuite/dynload/poly/prog/expected

@@ -0,0 +1,2 @@
+True
+True

testsuite/dynload/should_fail/Makefile

@@ -0,0 +1,4 @@
+TEST=   dynload/should_fail
+EXTRA_OBJS=Plugin.o
+TOP=../../..
+include ../../build.mk

testsuite/dynload/should_fail/Plugin.hs

@@ -0,0 +1,12 @@
+{-# OPTIONS -fglasgow-exts #-}
+module Plugin where
+
+import API
+import AltData.Dynamic
+
+v :: Int
+v = 0xdeadbeef
+
+resource_dyn :: Dynamic
+resource_dyn = toDyn v
+

testsuite/dynload/should_fail/api/API.hs

@@ -0,0 +1,20 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module API where
+
+import AltData.Typeable
+
+data Interface = Interface { 
+        function :: String
+   }
+
+instance Typeable Interface where
+#if __GLASGOW_HASKELL__ >= 603
+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []
+#else
+    typeOf i = mkAppTy (mkTyCon "API.Interface") []
+#endif
+
+plugin :: Interface
+plugin = Interface  { function = "goodbye" }
+

testsuite/dynload/should_fail/prog/Main.hs

@@ -0,0 +1,14 @@
+
+import System.Plugins
+import API
+
+main = do 
+    m_v   <- dynload "../Plugin.o" 
+                     ["../api"] 
+                     [] 
+                     "resource_dyn"
+
+    case m_v of
+        LoadFailure _    -> putStrLn "didn't compile"
+        LoadSuccess _ v  -> putStrLn $ function v
+

testsuite/dynload/should_fail/prog/expected

@@ -0,0 +1,4 @@
+Couldn't match `API.Interface' against `Int'
+	Expected type: API.Interface
+	Inferred type: Int
+didn't compile

testsuite/dynload/should_fail_1/Makefile

@@ -0,0 +1,4 @@
+TEST=   dynload/should_fail_1
+EXTRA_OBJS=Plugin.o
+TOP=../../..
+include ../../build.mk

testsuite/dynload/should_fail_1/Plugin.hs

@@ -0,0 +1,15 @@
+--
+-- trying to be really mean.
+--
+
+module Plugin where
+
+import API
+import AltData.Dynamic
+
+v :: Int -> Int
+v = \x -> 0xdeadbeef
+
+resource_dyn :: Dynamic
+resource_dyn = toDyn v
+

testsuite/dynload/should_fail_1/api/API.hs

@@ -0,0 +1,20 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module API where
+
+import AltData.Typeable
+
+data Interface = Interface { 
+        function :: String
+   }
+
+instance Typeable Interface where
+#if __GLASGOW_HASKELL__ >= 603
+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []
+#else
+    typeOf i = mkAppTy (mkTyCon "API.Interface") []
+#endif
+
+plugin :: Interface
+plugin = Interface  { function = "goodbye" }
+

testsuite/dynload/should_fail_1/prog/Main.hs

@@ -0,0 +1,11 @@
+
+import System.Plugins
+import API
+
+main = do 
+    m_v   <- dynload "../Plugin.o" ["../api"] 
+                                   [] "resource_dyn"
+    case m_v of
+        LoadFailure _   -> putStrLn "didn't compile"
+        LoadSuccess _ v -> putStrLn $ (function v)
+

testsuite/dynload/should_fail_1/prog/expected

@@ -0,0 +1,4 @@
+Couldn't match `API.Interface' against `Int -> Int'
+	Expected type: API.Interface
+	Inferred type: Int -> Int
+didn't compile

testsuite/dynload/should_fail_2/Makefile

@@ -0,0 +1,4 @@
+TEST=		dynload/should_fail_2
+
+TOP=../../..
+include ../../build.mk

testsuite/dynload/should_fail_2/Plugin.in

@@ -0,0 +1,19 @@
+--
+-- the plugin doesn't even make the resource_dyn a Dynamic.
+--
+-- let's hope that makeWith strips out the invalid declarations
+--
+
+{-# OPTIONS -fglasgow-exts #-}
+
+module Plugin where
+
+import API
+import AltData.Typeable
+import GHC.Base
+
+v :: Int
+v = 0xdeadbeef
+
+resource_dyn = (typeOf v, unsafeCoerce v)
+

testsuite/dynload/should_fail_2/Plugin.stub

@@ -0,0 +1,12 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module Plugin ( resource_dyn )  where
+
+import API
+import AltData.Dynamic
+
+resource = plugin
+
+resource_dyn :: Dynamic
+resource_dyn = toDyn resource
+

testsuite/dynload/should_fail_2/api/API.hs

@@ -0,0 +1,22 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module API where
+
+import AltData.Typeable
+import GHC.Base
+
+data Interface = Interface { 
+        function :: String
+   }
+        
+instance Typeable Interface where
+#if __GLASGOW_HASKELL__ >= 603
+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []
+#else
+    typeOf i = mkAppTy (mkTyCon "API.Interface") []
+#endif
+
+plugin :: Interface
+plugin = Interface  { function = "goodbye" }
+
+unsafeCoerce = unsafeCoerce#

testsuite/dynload/should_fail_2/prog/Main.hs

@@ -0,0 +1,19 @@
+
+import System.Plugins
+import API
+
+conf    = "../Plugin.in"
+stub    = "../Plugin.stub"
+
+main = do 
+        status <- makeWith conf stub ["-i../api", "-i../../../../src/altdata/"]
+        case status of
+         MakeFailure e   -> mapM_ putStrLn e >> putStrLn "failed"
+         MakeSuccess _ o -> do {
+              ; m_v <- dynload o ["../api"] [] "resource_dyn"
+              ; makeCleaner o
+              ; case m_v of
+                        LoadFailure _   -> putStrLn "didn't load"
+                        LoadSuccess _ v -> putStrLn $ (function v)
+         }
+

testsuite/dynload/should_fail_2/prog/expected

@@ -0,0 +1,8 @@
+
+../Plugin.in:18:
+    Couldn't match `Dynamic' against `(t, t1)'
+	Expected type: Dynamic
+	Inferred type: (t, t1)
+    In the definition of `resource_dyn':
+	resource_dyn = (typeOf v, unsafeCoerce v)
+failed

testsuite/dynload/should_fail_2/prog/expected.604

@@ -0,0 +1,7 @@
+
+../Plugin.in:18:15:
+    Couldn't match `Dynamic' against `(a, b)'
+      Expected type: Dynamic
+      Inferred type: (a, b)
+    In the definition of `resource_dyn': resource_dyn = (typeOf v, unsafeCoerce v)
+failed

testsuite/dynload/should_fail_2/prog/expected.605

@@ -0,0 +1,7 @@
+
+../Plugin.in:18:15:
+    Couldn't match `Dynamic' against `(a, b)'
+      Expected type: Dynamic
+      Inferred type: (a, b)
+    In the definition of `resource_dyn': resource_dyn = (typeOf v, unsafeCoerce v)
+failed

testsuite/dynload/should_fail_3/Makefile

@@ -0,0 +1,4 @@
+TEST=		dynload/should_fail_3
+
+TOP=../../..
+include ../../build.mk

testsuite/dynload/should_fail_3/Plugin.in

@@ -0,0 +1,19 @@
+--
+-- the plugin doesn't even make the resource_dyn a Dynamic.
+-- let's hope that makeWith strips out the invalid declarations
+--
+
+{-# OPTIONS -fglasgow-exts #-}
+
+module Plugin where
+
+import API
+
+import AltData.Typeable
+import GHC.Base
+
+v :: Int
+v = 0xdeadbeef
+
+resource_dyn = (typeOf plugin, unsafeCoerce v)
+

testsuite/dynload/should_fail_3/Plugin.stub

@@ -0,0 +1,12 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module Plugin ( resource_dyn )  where
+
+import API
+import AltData.Dynamic
+
+resource = plugin
+
+resource_dyn :: Dynamic
+resource_dyn = toDyn resource
+

testsuite/dynload/should_fail_3/api/API.hs

@@ -0,0 +1,22 @@
+{-# OPTIONS -cpp -fglasgow-exts #-}
+
+module API where
+
+import AltData.Typeable
+import GHC.Base
+
+data Interface = Interface { 
+        function :: String
+   }
+
+instance Typeable Interface where
+#if __GLASGOW_HASKELL__ >= 603
+    typeOf _ = mkTyConApp (mkTyCon "API.Interface") []
+#else
+    typeOf _ = mkAppTy (mkTyCon "API.Interface") []
+#endif
+
+plugin :: Interface
+plugin = Interface  { function = "goodbye" }
+
+unsafeCoerce = unsafeCoerce#

testsuite/dynload/should_fail_3/prog/Main.hs

@@ -0,0 +1,18 @@
+
+import System.Plugins
+import API
+
+conf    = "../Plugin.in"
+stub    = "../Plugin.stub"
+
+main = do 
+        status <- makeWith conf stub ["-i../api", "-i../../../../src/altdata"]
+        o <- case status of
+                MakeFailure e -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess _ o -> return o
+        m_v <- dynload o ["../api"] [] "resource_dyn"
+        case m_v of
+                LoadFailure _   -> error "didn't compile"
+                LoadSuccess _ v -> do putStrLn $ (function v)
+                                      makeCleaner o
+

testsuite/dynload/should_fail_3/prog/expected

@@ -0,0 +1,9 @@
+
+../Plugin.in:18:
+    Couldn't match `Dynamic' against `(t, t1)'
+	Expected type: Dynamic
+	Inferred type: (t, t1)
+    In the definition of `resource_dyn':
+	resource_dyn = (typeOf plugin, unsafeCoerce v)
+
+Fail: failed

testsuite/dynload/should_fail_3/prog/expected.604

@@ -0,0 +1,8 @@
+
+../Plugin.in:18:15:
+    Couldn't match `Dynamic' against `(a, b)'
+      Expected type: Dynamic
+      Inferred type: (a, b)
+    In the definition of `resource_dyn':
+	resource_dyn = (typeOf plugin, unsafeCoerce v)
+a.out: failed

testsuite/dynload/should_fail_3/prog/expected.605

@@ -0,0 +1,8 @@
+
+../Plugin.in:18:15:
+    Couldn't match `Dynamic' against `(a, b)'
+      Expected type: Dynamic
+      Inferred type: (a, b)
+    In the definition of `resource_dyn':
+	resource_dyn = (typeOf plugin, unsafeCoerce v)
+a.out: failed

testsuite/dynload/simple/Makefile

@@ -0,0 +1,4 @@
+TEST=dynload/simple
+EXTRA_OBJS=Plugin.o
+TOP=../../..
+include ../../build.mk

testsuite/dynload/simple/Plugin.hs

@@ -0,0 +1,11 @@
+{-# OPTIONS -fglasgow-exts #-}
+module Plugin where
+
+import API
+import AltData.Dynamic
+
+my_fun = plugin { function = "plugin says \"hello\"" }
+
+resource_dyn :: Dynamic
+resource_dyn = toDyn my_fun
+

testsuite/dynload/simple/api/API.hs

@@ -0,0 +1,20 @@
+{-# OPTIONS -cpp #-}
+
+module API where
+
+import AltData.Typeable
+
+data Interface = Interface { 
+        function :: String
+   }
+
+instance Typeable Interface where
+#if __GLASGOW_HASKELL__ >= 603
+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []
+#else
+    typeOf i = mkAppTy (mkTyCon "API.Interface") []
+#endif
+
+plugin :: Interface
+plugin = Interface  { function = "goodbye" }
+

testsuite/dynload/simple/prog/Main.hs

@@ -0,0 +1,15 @@
+{-# OPTIONS -cpp #-}
+
+#include "../../../../config.h"
+
+import System.Plugins
+import API
+
+main = do 
+        m_v <- dynload "../Plugin.o" ["../api"]
+                                     []
+                                     "resource_dyn"
+        case m_v of
+                LoadFailure _   -> error "didn't compile"
+                LoadSuccess _ v -> putStrLn $ (function v)
+

testsuite/dynload/simple/prog/expected

@@ -0,0 +1 @@
+plugin says "hello"

testsuite/eval.mk

@@ -0,0 +1,25 @@
+include $(TOP)/config.mk
+include $(TOP)/testsuite/check.mk
+
+BIN=a.out
+SRC=Main.hs
+
+BINDIR=		"."
+REALBIN=	./$(BIN)
+
+.SUFFIXES : .o .hs .hi .lhs .hc .s
+
+all: $(BIN)
+
+$(BIN): $(SRC) $(OBJS)
+	@rm -f $@
+	@$(GHC) --make -fglasgow-exts $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) $(SRC)
+
+# Standard suffix rules
+.o.hi:
+	@:
+.hs.o:
+	@$(GHC) $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) -c $<
+
+clean: 
+	@rm -rf *.hi *.o *~ $(BIN)

testsuite/eval/eval1/Main.hs

@@ -0,0 +1,5 @@
+
+import System.Eval.Haskell
+
+main = do i <- eval "1 + 6 :: Int" [] :: IO (Maybe Int)
+          if isJust i then putStrLn $ show (fromJust i) else return ()

testsuite/eval/eval1/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../eval.mk

testsuite/eval/eval1/expected

@@ -0,0 +1 @@
+7

testsuite/eval/eval2/Main.hs

@@ -0,0 +1,6 @@
+import System.Eval.Haskell
+
+main = do m_s <- eval "map toUpper \"haskell\"" ["Data.Char"]
+          case m_s of
+                Nothing -> putStrLn "typechecking failed"
+                Just s  -> putStrLn s

testsuite/eval/eval2/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../eval.mk

testsuite/eval/eval2/expected

@@ -0,0 +1 @@
+HASKELL

testsuite/eval/eval3/Main.hs

@@ -0,0 +1,38 @@
+{-# OPTIONS -cpp #-}
+--
+-- Should evaluate to '3', unless something goes wrong.
+--
+-- Not so bad to use AltData, as it is already derived for all the basic
+-- types. Then, just replace deriving Typeable, with hand-derived
+-- instance of Typeable (see hs-plugins/testsuite/eval/eval_fn1/Poly.hs
+--
+--
+
+#include "../../../config.h"
+
+import System.Eval
+import AltData.Dynamic
+
+main = do
+    a <- return $ toDyn (3::Integer)
+
+    -- so, we try to compile a function that takes a dyn.
+    -- looks like with GHC 6.4, we need to make sure the package.confs work:
+    m_b <- unsafeEval_ "\\dyn -> fromDyn dyn (7 :: Integer)"
+                ["AltData.Dynamic"]
+                [ ]
+                [ ]
+                []
+
+    case m_b of 
+        Left s   -> mapM_ putStrLn s
+        Right b  -> putStrLn $ show (b a :: Integer) -- now apply it
+                
+{-
+-- should work, but doesn't. type check fails 
+-- (due to static vs dynamic typing issue)
+
+     m_b <- unsafeEval_ "\\dyn -> fromMaybe (7 :: Int) (fromDynamic dyn)"
+                                ["Data.Dynamic","Data.Maybe"] [] []
+-}
+

testsuite/eval/eval3/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../eval.mk

testsuite/eval/eval3/expected

@@ -0,0 +1 @@
+3

testsuite/eval/eval_/Main.hs

@@ -0,0 +1,9 @@
+
+import System.Eval.Haskell
+
+main = do i <- eval_ "Just (7 :: Int)" 
+                     ["Maybe"] 
+                     ["-fglasgow-exts"] 
+                     []
+                     [] :: IO (Either [String] (Maybe (Maybe Int)))
+          print i

testsuite/eval/eval_/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../eval.mk

testsuite/eval/eval_/expected

@@ -0,0 +1 @@
+Right (Just (Just 7))

testsuite/eval/eval_fn/Main.hs

@@ -0,0 +1,10 @@
+--
+-- lambda abstraction!
+--
+--
+-- needs unsafeEval because eval has a broken Dynamic check
+--
+import System.Eval.Haskell
+
+main = do fn <- unsafeEval "(\\x -> (x,x::Int))" [] :: IO (Maybe (Int -> (Int,Int)))
+          when (isJust fn) $ putStrLn $ show $ (fromJust fn) 7

testsuite/eval/eval_fn/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../eval.mk

testsuite/eval/eval_fn/expected

@@ -0,0 +1 @@
+(7,7)

testsuite/eval/eval_fn1/Main.hs

@@ -0,0 +1,15 @@
+{-# OPTIONS -fglasgow-exts #-}
+--
+-- polymorphic eval!
+--
+
+module Main where
+
+import Poly
+import System.Eval.Haskell
+
+main = do m_f <- eval "Fn (\\x y -> x == y)" ["Poly"]
+          when (isJust m_f) $ do
+                let (Fn f) = fromJust m_f
+                putStrLn $ show (f True True)
+                putStrLn $ show (f 1 2)

testsuite/eval/eval_fn1/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../eval.mk

testsuite/eval/eval_fn1/Poly.hs

@@ -0,0 +1,16 @@
+{-# OPTIONS -cpp -fglasgow-exts #-} 
+module Poly where
+
+import AltData.Typeable
+
+data Fn = Fn {fn :: forall t. Eq t => t -> t -> Bool}
+
+--
+-- ignore type inside the Fn... is this correct?
+--
+instance Typeable Fn where
+#if __GLASGOW_HASKELL__ >= 603
+    typeOf _ = mkTyConApp (mkTyCon "Poly.Fn") []
+#else
+    typeOf _ = mkAppTy (mkTyCon "Poly.Fn") []
+#endif

testsuite/eval/eval_fn1/expected

@@ -0,0 +1,2 @@
+True
+False

testsuite/eval/foreign_eval/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../foreign.mk

testsuite/eval/foreign_eval/README

@@ -0,0 +1 @@
+run a string of Haskell code from a C program.

testsuite/eval/foreign_eval/expected

@@ -0,0 +1 @@
+10946

testsuite/eval/foreign_eval/main.c

@@ -0,0 +1,16 @@
+#include <stdio.h>
+
+#include "EvalHaskell.h"
+
+int main(int argc, char *argv[])
+{
+  int *p;
+  hs_init(&argc, &argv);
+  p = hs_eval_i("let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20 :: Int");
+  if (p == NULL)
+	  printf("failed!\n");
+  else
+	  printf("%d\n",*p);
+  hs_exit();
+  return 0;
+}

testsuite/eval/foreign_eval1/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../foreign.mk

testsuite/eval/foreign_eval1/expected

@@ -0,0 +1 @@
+10946

testsuite/eval/foreign_eval1/main.c

@@ -0,0 +1,16 @@
+#include <stdio.h>
+
+#include "EvalHaskell.h"
+
+int main(int argc, char *argv[])
+{
+  char *p;
+  hs_init(&argc, &argv);
+  p = hs_eval_s("show $ let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20");
+  if (p == NULL)
+  	  printf("failed!\n");
+  else
+	  printf("%s\n",p);
+  hs_exit();
+  return 0;
+}

testsuite/eval/foreign_should_fail/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../foreign.mk

testsuite/eval/foreign_should_fail/expected

@@ -0,0 +1,2 @@
+<eval>:1: parse error on input `in'
+failed!

testsuite/eval/foreign_should_fail/expected.604

@@ -0,0 +1 @@
+failed!

testsuite/eval/foreign_should_fail/expected.605

@@ -0,0 +1 @@
+failed!

testsuite/eval/foreign_should_fail/main.c

@@ -0,0 +1,16 @@
+#include <stdio.h>
+
+#include "EvalHaskell.h"
+
+int main(int argc, char *argv[])
+{
+  int *p;
+  hs_init(&argc, &argv);
+  p = hs_eval_i("show $ case 1 + 2 in{-wrong-} x -> x");
+  if (p == NULL)
+	  printf("failed!\n");
+  else
+	  printf("%d\n",*p);
+  hs_exit();
+  return 0;
+}

testsuite/eval/foreign_should_fail_illtyped/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../foreign.mk

testsuite/eval/foreign_should_fail_illtyped/expected

@@ -0,0 +1,4 @@
+Couldn't match `Int' against `[Char]'
+	Expected type: Int
+	Inferred type: [Char]
+failed!

testsuite/eval/foreign_should_fail_illtyped/expected.604

@@ -0,0 +1 @@
+failed!

testsuite/eval/foreign_should_fail_illtyped/expected.605

@@ -0,0 +1 @@
+failed!

testsuite/eval/foreign_should_fail_illtyped/main.c

@@ -0,0 +1,16 @@
+#include <stdio.h>
+
+#include "EvalHaskell.h"
+
+int main(int argc, char *argv[])
+{
+  int *p;
+  hs_init(&argc, &argv);
+  p = hs_eval_i("\"an ill-typed string\"");
+  if (p == NULL)
+	  printf("failed!\n");
+  else
+	  printf("%d\n",*p);
+  hs_exit();
+  return 0;
+}

testsuite/eval/unsafeidir/Main.hs

@@ -0,0 +1,16 @@
+
+import System.Plugins.Make
+import System.Eval.Haskell
+
+main = do make "a/Extra.hs" []
+        
+          i <- unsafeEval_ "show (Just (1 + 6 :: Int)) ++ extra" 
+                        ["Data.Maybe", "Extra"] 
+                        ["-ia"]      -- no make flags
+                        []           -- no package.confs
+                        ["a"]        -- include paths to load from
+                        :: IO (Either [String] String)
+               
+          case i of
+                Right i -> putStrLn $ show i
+                Left es -> mapM_ putStrLn es

testsuite/eval/unsafeidir/Makefile

@@ -0,0 +1,2 @@
+TOP=../../..
+include ../../eval.mk

testsuite/eval/unsafeidir/a/Extra.hs

@@ -0,0 +1,3 @@
+module Extra where
+
+extra = "an extra value"

testsuite/eval/unsafeidir/expected

@@ -0,0 +1 @@
+"Just 7an extra value"

testsuite/foreign.mk

@@ -0,0 +1,22 @@
+include $(TOP)/config.mk
+include $(TOP)/testsuite/check.mk
+
+
+INCLUDES=   -I$(TOP)
+
+# compile with GHC to save us setting all the necessary include and
+# lib flags. use ghc -v to find out what these are if you wish to go
+# via gcc.
+BIN=./a.out
+SRC=main.c
+
+BINDIR=		"."
+REALBIN=	$(BIN)
+
+all:  $(BIN)
+
+$(BIN): $(SRC)
+	$(GHC) -package plugins $(INCLUDES) $(PKGFLAGS) $(SRC)
+
+clean: 
+	rm -rf *.hi *.o *~ $(BIN)

testsuite/hier/hier1/Makefile

@@ -0,0 +1,8 @@
+TEST=   hier/hier1
+
+EXTRA_OBJS=Plugin.o
+PRIOR_OBJS=Modules/Flags.o
+EXTRAFLAGS=
+
+TOP=../../..
+include ../../build.mk

testsuite/hier/hier1/Modules/Flags.hs

@@ -0,0 +1,15 @@
+--
+-- A simple module
+--
+
+module Modules.Flags where
+
+
+data FlagRec = FlagRec {
+        f1 :: Int,
+        f2 :: Int
+}
+
+
+foo :: FlagRec -> Int
+foo x = f1 x

testsuite/hier/hier1/Modules/Makefile

@@ -0,0 +1,6 @@
+
+all:
+	ghc -O -c Flags.hs
+
+clean:
+	rm -f *.hi *.o