Update examples

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"