[added testing utilities
martin.hofmann@uni-bamberg.de**20090513171543] hunk ./src/UI/UIStarter.hs 7
-import Control.Monad (when)
+import Control.Monad (when, liftM4)
hunk ./src/UI/UIStarter.hs 21
+import Data.Function (on)
+import Data.Maybe (isJust, fromJust)
+import qualified Data.Map as M
hunk ./src/UI/UIStarter.hs 27
+import UI.IOInterpreter
hunk ./src/UI/UIStarter.hs 67
+    , history  :: M.Map ([Name],[Name]) [String]  
hunk ./src/UI/UIStarter.hs 71
+modifyHistory :: EnvState -> ([Name],[Name]) -> [[Dec]] -> EnvState
+modifyHistory s k v = 
+    let v' = map (unlines.(map (show.pretty))) v
+    in s{history = M.insert k v' (history s)}
+                   
hunk ./src/UI/UIStarter.hs 85
+    , history   = M.empty
hunk ./src/UI/UIStarter.hs 137
+runCmd s (Test i tgts bgks expr)= evalExpr s i (tgts,bgks) expr >> return (False,s)
hunk ./src/UI/UIStarter.hs 217
-          
+
+evalExpr :: EnvState -> Int -> ([Name],[Name]) -> String -> IO ()
+evalExpr s i k@(ts,bs) e = do
+    let dec = M.lookup k (history s)
+    if (not.isJust $ dec) then printerr >> return ()
+       else do let (Just d) = dec
+               if (i < 1) || (i > (length d))
+                 then mapM_ (test d) [1..(length d)]
+                 else test d i 
+    where
+    test d i = do
+        r <- interprete $ prepare (d !! (i-1)) e
+        hPutDoc stdout $ text "Testing" <+> int i <> text ". hypothesis" <+> 
+                         text "of:" <+> setDoc <^> 
+                         text e <+> text " == " <+> text r <$> linebreak
+    prepare d c = "let " ++ (concatMap (++ "; ") (lines d)) ++ "in " ++ c
+    printerr = hPutDoc stdout $ text "No such setting in history:" <+> setDoc <$> linebreak
+    setDoc = encloseSep squote squote comma (map pretty ts) <> 
+             (if not.null $ bs 
+                then empty <+> text "with" <+> encloseSep squote squote comma (map pretty bs)
+                else text "")
+              
hunk ./src/UI/UIStarter.hs 246
-            printResult s t res
-            return (False, s)
+            let s' = either (const s) (modifyHistory s (tgts,bgks)) (fst res) 
+            printResult s' t res
+            return (False, s')
+    
hunk ./src/UI/UIStarter.hs 334
- | Test String Int
+ | Test Int [Name] [Name] String
hunk ./src/UI/UIStarter.hs 343
-    [ (":help",                         "Show this help.",          return (Help False))
+    [ ( ":help",                         "Show this help.",          return (Help False))
hunk ./src/UI/UIStarter.hs 350
+    , (":test i \"tgts\" [with \"bgks\"] on \"command\"",      "Test a generalised program.",            pTest)
hunk ./src/UI/UIStarter.hs 391
-    if verbose s then  pretty (context s) else text ""  <> linebreak
+    if verbose s 
+      then pretty (context s) <$> pretty (history s) <$> linebreak
+      else text ""  <$> linebreak
hunk ./src/UI/UIStarter.hs 415
-         , reservedOpNames = [":",";","+","-","=", "with"]
+         , reservedOpNames = [":",";","+","-","=", "with", "on"]
hunk ./src/UI/UIStarter.hs 500
-            
+
+pTest :: Parser Cmd
+pTest = do{ i       <- liftM fromInteger integer
+          ; targets <- pNames
+          ; bgkldg  <- liftM (maybe [] id) $ optionMaybe (do{reservedOp "with"; pNames})
+          ; exprssn <- do{reservedOp "on"; stringLiteral}
+          ; return $ Test i targets bgkldg exprssn
+           }
+     <?> " <hypoNo> \"t1 t2 ...\" [with \"b1 b2 ...\"] on \" expression \""            