Update examples

testsuite/pdynload/badint/Makefile

@@ -0,0 +1,5 @@
+
+TEST=pdynload/badint
+
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/badint/Plugin.hs

@@ -0,0 +1,4 @@
+module Plugin where
+
+resource :: Num t => t
+resource = 0xBAD

testsuite/pdynload/badint/api/API.hs

@@ -0,0 +1,9 @@
+module API where
+
+data Interface = Interface { 
+                transform :: String -> String
+     }
+
+rsrc :: Interface
+rsrc = Interface { transform = id }
+

testsuite/pdynload/badint/prog/Main.hs

@@ -0,0 +1,18 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e-> mapM_ putStrLn e
+                
+   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+                case v of
+                  LoadSuccess _ a -> putStrLn $ (transform a) "foo"
+                  _               -> putStrLn "wrong types"
+

testsuite/pdynload/badint/prog/expected

@@ -0,0 +1 @@
+wrong types

testsuite/pdynload/bayley1/Load.hs

@@ -0,0 +1,34 @@
+module Load where
+
+import API
+import System.Plugins
+
+testload = do
+
+  s  <- make "../Plugin1.hs"     ["-i../api"]
+  o1 <- case s of
+    MakeSuccess _ o -> return o
+    MakeFailure e   -> mapM_ putStrLn e >> fail "o1"
+    
+  s  <- make "../Sub/Plugin2.hs" ["-i../api"]
+  o2 <- case s of
+    MakeSuccess _ o -> return o
+    MakeFailure e   -> mapM_ putStrLn e >> fail "o2"
+
+  fc <- pdynload o1 ["..","../api"] [] "API.PluginAPI" "action"
+
+  case fc of
+    LoadFailure msg -> mapM_ putStrLn msg 
+    LoadSuccess modul proc -> do
+      let ac :: API.PluginAPI; ac = proc
+      let s = proc 42
+      print s
+
+  print o2
+  fc <- pdynload o2 ["..","../api"] [] "API.PluginAPI" "action"
+  case fc of
+    LoadFailure msg -> mapM_ putStrLn msg 
+    LoadSuccess modul proc -> do
+      let ac :: API.PluginAPI; ac = proc
+      let s = proc 42
+      print s

testsuite/pdynload/bayley1/Makefile

@@ -0,0 +1,5 @@
+
+TEST=pdynload/bayley1
+
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/bayley1/Plugin1.hs

@@ -0,0 +1,6 @@
+module Plugin1 where
+
+import qualified API
+action :: API.PluginAPI
+action i = show i
+

testsuite/pdynload/bayley1/Sub/Plugin2.hs

@@ -0,0 +1,6 @@
+module Sub.Plugin2 where
+
+import qualified API
+action :: API.PluginAPI
+action i = show i
+

testsuite/pdynload/bayley1/api/API.hs

@@ -0,0 +1,6 @@
+module API where
+
+type PluginAPI = Int -> String
+action :: PluginAPI
+action i = show i
+

testsuite/pdynload/bayley1/prog/Main.hs

@@ -0,0 +1,4 @@
+module Main where
+import Load
+main = testload
+

testsuite/pdynload/null/Makefile

@@ -0,0 +1,4 @@
+
+TEST=   pdynload/null
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/null/Plugin.hs

@@ -0,0 +1,5 @@
+module Plugin where
+
+import API
+
+resource = D 1

testsuite/pdynload/null/api/API.hs

@@ -0,0 +1,5 @@
+
+module API where
+
+data Num t => Interface t = D t
+

testsuite/pdynload/null/prog/Main.hs

@@ -0,0 +1,19 @@
+
+import System.Plugins
+-- import System.Plugins.Utils
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e-> mapM_ putStrLn e
+
+   where f = do v     <- load "../Plugin.o" ["../api"] [] "resource"
+                --  (i,_) <- exec "ghc" ["--numeric-version"]
+                --  mapM_ putStrLn i
+                putStrLn "done."
+

testsuite/pdynload/null/prog/expected

@@ -0,0 +1 @@
+done.

testsuite/pdynload/numclass/Makefile

@@ -0,0 +1,4 @@
+
+TEST=   pdynload/numclass
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/numclass/Plugin.hs

@@ -0,0 +1,5 @@
+module Plugin where
+
+-- import API
+
+resource = "error"

testsuite/pdynload/numclass/api/API.hs

@@ -0,0 +1,5 @@
+
+module API where
+
+data Num t => Interface t = D t
+

testsuite/pdynload/numclass/prog/Main.hs

@@ -0,0 +1,19 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeFailure _   -> putStrLn "make failed"
+                MakeSuccess _ _ -> do {
+
+       ;v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface Integer" "resource"
+       ;case v of
+          LoadSuccess _ a -> let D i = snd a in putStrLn $ show i
+          _               -> putStrLn "wrong types"
+
+       }

testsuite/pdynload/numclass/prog/expected

@@ -0,0 +1 @@
+wrong types

testsuite/pdynload/poly/Makefile

@@ -0,0 +1,5 @@
+
+TEST=pdynload/poly
+
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/poly/Plugin.hs

@@ -0,0 +1,9 @@
+module Plugin where
+
+import Data.Generics.Schemes
+
+import API
+
+resource = rsrc { 
+     field = id listify
+}

testsuite/pdynload/poly/api/API.hs

@@ -0,0 +1,12 @@
+{-# OPTIONS -fglasgow-exts #-}
+-- a really nasty type:
+
+module API where
+
+import Data.Generics
+
+data Interface = Interface { field :: Typeable r => (r -> Bool) -> GenericQ [r] }
+
+rsrc :: Interface
+rsrc = Interface { field = listify }
+

testsuite/pdynload/poly/prog/Main.hs

@@ -0,0 +1,17 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e   -> mapM_ putStrLn e
+
+  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+               case v of
+                 LoadSuccess _ a  -> putStrLn "loaded .. yay!"
+                 _                -> putStrLn "wrong types"

testsuite/pdynload/poly/prog/expected

@@ -0,0 +1 @@
+loaded .. yay!

testsuite/pdynload/poly1/Makefile

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

testsuite/pdynload/poly1/Plugin.hs

@@ -0,0 +1,5 @@
+module Plugin where
+
+import API
+
+resource = plugin { function = (+) }

testsuite/pdynload/poly1/api/API.hs

@@ -0,0 +1,9 @@
+module API where
+
+data Interface = Interface { 
+        function :: (Num a) => a -> a -> a
+}
+
+plugin :: Interface
+plugin = Interface  { function = error "no function defined" }
+

testsuite/pdynload/poly1/prog/Main.hs

@@ -0,0 +1,18 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e -> mapM_ putStrLn e
+
+   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+                case v of
+                  LoadSuccess _ a -> let fn = function a in putStrLn $ show $ 1 `fn` 2
+                  _               -> putStrLn "wrong types"
+

testsuite/pdynload/poly1/prog/expected

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

testsuite/pdynload/should_fail0/Makefile

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

testsuite/pdynload/should_fail0/Plugin.hs

@@ -0,0 +1,9 @@
+module Plugin where
+
+import API
+
+resource = 0xBAD :: Int
+
+-- resource = tiny { 
+--     field = "hello strange world"
+-- }

testsuite/pdynload/should_fail0/api/API.hs

@@ -0,0 +1,13 @@
+{-# OPTIONS -fglasgow-exts #-}
+-- ^ needed to derive Typeable
+
+module API where
+
+import Data.Dynamic
+
+data Interface = Interface { field :: String }
+   deriving (Show)
+
+rsrc :: Interface
+rsrc = Interface { field = "default value" }
+

testsuite/pdynload/should_fail0/prog/Main.hs

@@ -0,0 +1,18 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e -> mapM_ putStrLn e
+    where 
+       f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+              case v of
+                LoadSuccess _ a  -> putStrLn "loaded .. yay!"
+                _              -> putStrLn "wrong types"
+

testsuite/pdynload/should_fail0/prog/expected

@@ -0,0 +1 @@
+wrong types

testsuite/pdynload/should_fail1/Makefile

@@ -0,0 +1,5 @@
+# Missing class constraint... can't do that in Clean
+
+TEST=   pdynload/should_fail1
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/should_fail1/Plugin.hs

@@ -0,0 +1,5 @@
+module Plugin where
+
+data I = I Int
+
+resource = I 1

testsuite/pdynload/should_fail1/api/API.hs

@@ -0,0 +1,8 @@
+
+module API where
+
+newtype Interface = I Int
+
+rsrc :: Interface
+rsrc = I 1
+

testsuite/pdynload/should_fail1/prog/Main.hs

@@ -0,0 +1,17 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e -> mapM_ putStrLn e
+
+   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+                case v of
+                  LoadSuccess _ a -> putStrLn "loaded .. yay!"
+                  _               -> putStrLn "wrong types"

testsuite/pdynload/should_fail1/prog/expected

@@ -0,0 +1 @@
+wrong types

testsuite/pdynload/small/Makefile

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

testsuite/pdynload/small/Plugin.hs

@@ -0,0 +1,5 @@
+module Plugin where
+
+import API
+
+resource = plugin { function = "good" }

testsuite/pdynload/small/api/API.hs

@@ -0,0 +1,9 @@
+module API where
+
+data Interface = Interface { 
+        function :: String
+}
+
+plugin :: Interface
+plugin = Interface  { function = "goodbye" }
+

testsuite/pdynload/small/prog/Main.hs

@@ -0,0 +1,18 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e -> mapM_ putStrLn e
+
+   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+                case v of
+                  LoadSuccess _ a  -> putStrLn "loaded .. yay!"
+                  _                -> putStrLn "wrong types"
+

testsuite/pdynload/small/prog/expected

@@ -0,0 +1 @@
+loaded .. yay!

testsuite/pdynload/spj1/Makefile

@@ -0,0 +1,5 @@
+
+TEST=pdynload/spj1
+
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/spj1/Plugin.hs

@@ -0,0 +1,17 @@
+module Plugin where
+
+-- user doesn't import the API
+-- and provides a polymorphic value
+
+-- import API
+-- resource :: Interface
+
+--
+-- should pass type check, and dump core
+--
+-- resource :: Num a => a
+
+-- import API
+
+resource :: Num a => a
+resource = 7

testsuite/pdynload/spj1/api/API.hs

@@ -0,0 +1,9 @@
+
+module API where
+
+-- data Interface = Interface { field :: Int }
+
+-- newtype Interface = Interface Int
+
+type Interface = Int
+

testsuite/pdynload/spj1/prog/Main.hs

@@ -0,0 +1,17 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e   -> mapM_ putStrLn e
+
+  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+               case v of
+                 LoadSuccess _ (a :: Interface) -> print $ a -- will crash
+                 LoadFailure es     -> putStrLn $ show es

testsuite/pdynload/spj2/Makefile

@@ -0,0 +1,5 @@
+
+TEST=pdynload/spj1
+
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/spj2/Plugin.hs

@@ -0,0 +1,13 @@
+module Plugin where
+
+-- user doesn't import the API
+-- and provides a polymorphic value
+
+import API
+resource :: Interface
+
+--
+-- should pass type check, and dump core
+--
+-- resource :: Num a => a
+resource = 7

testsuite/pdynload/spj2/api/API.hs

@@ -0,0 +1,6 @@
+
+module API where
+
+-- simple type
+type Interface = Int
+

testsuite/pdynload/spj2/prog/Main.hs

@@ -0,0 +1,17 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e   -> mapM_ putStrLn e
+
+  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+               case v of
+                 LoadSuccess _ (a :: Interface) -> putStrLn $ show a -- will crash
+                 LoadFailure es     -> putStrLn $ show es

testsuite/pdynload/spj2/prog/expected

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

testsuite/pdynload/spj3/Makefile

@@ -0,0 +1,3 @@
+TEST=   pdynload/spj3
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/spj3/Plugin.hs

@@ -0,0 +1,5 @@
+module Plugin where
+
+import API
+
+resource = plugin { function = (+) :: Int -> Int -> Int }

testsuite/pdynload/spj3/api/API.hs

@@ -0,0 +1,9 @@
+module API where
+
+data Interface = Interface { 
+        function :: (Num a) => a -> a -> a
+}
+
+plugin :: Interface
+plugin = Interface  { function = error "no function defined" }
+

testsuite/pdynload/spj3/prog/Main.hs

@@ -0,0 +1,18 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e -> mapM_ putStrLn e
+
+   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+                case v of
+                  LoadSuccess _ a -> let fn = function a in putStrLn $ show $ 1 `fn` 2
+                  _               -> putStrLn "wrong types"
+

testsuite/pdynload/spj3/prog/expected

@@ -0,0 +1,8 @@
+
+../Plugin.hs:5:
+    Cannot unify the type-signature variable `a' with the type `Int'
+	Expected type: a -> a -> a
+	Inferred type: Int -> Int -> Int
+    When checking the type signature of the expression:
+	  (+) :: Int -> Int -> Int
+    In the `function' field of a record

testsuite/pdynload/spj3/prog/expected.604

@@ -0,0 +1,9 @@
+
+../Plugin.hs:5:31:
+    Couldn't match the rigid variable `a' against `Int'
+      `a' is bound by the polymorphic type `forall a. (Num a) => a -> a -> a'
+			at ../Plugin.hs:5:11-56
+      Expected type: a -> a -> a
+      Inferred type: Int -> Int -> Int
+    In the expression: (+) :: Int -> Int -> Int
+    In the `function' field of a record

testsuite/pdynload/spj3/prog/expected.605

@@ -0,0 +1,9 @@
+
+../Plugin.hs:5:31:
+    Couldn't match the rigid variable `a' against `Int'
+      `a' is bound by the polymorphic type `forall a. (Num a) => a -> a -> a'
+			at ../Plugin.hs:5:11-56
+      Expected type: a -> a -> a
+      Inferred type: Int -> Int -> Int
+    In the expression: (+) :: Int -> Int -> Int
+    In the `function' field of a record

testsuite/pdynload/spj4/Makefile

@@ -0,0 +1,5 @@
+
+TEST=pdynload/spj4
+
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/spj4/Plugin.hs

@@ -0,0 +1,16 @@
+module Plugin where
+
+-- user doesn't import the API
+-- and provides a polymorphic value
+
+-- import API
+-- resource :: Interface
+
+--
+-- should pass type check, and dump core
+--
+-- resource :: Num a => a
+
+import API
+
+resource = Interface { field = 7 :: Num a => a }

testsuite/pdynload/spj4/api/API.hs

@@ -0,0 +1,5 @@
+
+module API where
+
+newtype Interface = Interface { field :: Int }
+

testsuite/pdynload/spj4/prog/Main.hs

@@ -0,0 +1,17 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e   -> error "there was a type error"
+
+  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+               case v of
+                 LoadSuccess _ (a :: Interface) -> print $ field a -- will crash
+                 LoadFailure es  -> mapM_ putStrLn es

testsuite/pdynload/spj4/prog/expected

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

testsuite/pdynload/typealias/Makefile

@@ -0,0 +1,5 @@
+# Missing class constraint... can't do that in Clean
+
+TEST=   pdynload/typealias
+TOP=../../..
+include ../../build.mk

testsuite/pdynload/typealias/Plugin.hs

@@ -0,0 +1,3 @@
+module Plugin where
+
+resource = 1 :: Int

testsuite/pdynload/typealias/api/API.hs

@@ -0,0 +1,8 @@
+
+module API where
+
+type Interface = Int
+
+rsrc :: Interface
+rsrc = 1
+

testsuite/pdynload/typealias/prog/Main.hs

@@ -0,0 +1,19 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e -> mapM_ putStrLn e
+
+  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+               case v of
+                  LoadSuccess _ a  -> putStrLn "loaded .. yay!"
+                  _           -> putStrLn "wrong types"
+
+

testsuite/pdynload/typealias/prog/expected

@@ -0,0 +1 @@
+loaded .. yay!

testsuite/pdynload/univquant/Makefile

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

testsuite/pdynload/univquant/Plugin.hs

@@ -0,0 +1,8 @@
+module Plugin where
+
+import API
+
+resource = plugin { function = my_id }
+
+my_id :: forall a. a -> a
+my_id x = x

testsuite/pdynload/univquant/api/API.hs

@@ -0,0 +1,9 @@
+module API where
+
+data Interface = Interface { 
+        function :: forall a. a -> a
+}
+
+plugin :: Interface
+plugin = Interface  { function = id }
+

testsuite/pdynload/univquant/prog/Main.hs

@@ -0,0 +1,17 @@
+
+import System.Plugins
+import API
+
+src     = "../Plugin.hs"
+wrap    = "../Wrapper.hs"
+apipath = "../api"
+
+main = do status <- make src ["-i"++apipath]
+          case status of
+                MakeSuccess _ _ -> f
+                MakeFailure e   -> mapM_ putStrLn e
+
+   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"
+                case v of
+                  LoadSuccess _ a  -> putStrLn "loaded .. yay!"
+                  _             -> putStrLn "wrong types"

testsuite/pdynload/univquant/prog/expected

@@ -0,0 +1 @@
+loaded .. yay!