suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Provided more helpful errors in the test harness when something is wrong

Browse Source
This commit is contained in:
Neil Brown 2009-01-23 14:42:46 +00:00
parent d184721979
commit c2aaf2fcf7
1 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
common/TestHarness.hs
View File

@ -96,18 +96,20 @@ testRain source = do (result,_) <- runPassM (defaultState FrontendRain) compila
-- | Substitutes each substitution into the prologue -- | Substitutes each substitution into the prologue
substitute :: AutoTest -> Either String [(Bool, String, String)] substitute :: AutoTest -> Either String [(Bool, String, String)]
substitute t = sequence [ do ls <- execWriterT $ subst (prologueLines t, ss) substitute t = sequence [ do ls <- execWriterT $ subst n (prologueLines t, ss)
return (p, n, unlines ls) return (p, n, unlines ls)
| TestBody p n ss <- bodies t] | TestBody p n ss <- bodies t]
where where
subst :: ([TestLine], [(String, [String])]) -> WriterT [String] (Either String) () subst :: String -> ([TestLine], [(String, [String])]) -> WriterT [String] (Either String) ()
subst ([], []) = return () subst _ ([], []) = return ()
subst ([], subs) = throwError $ "Left over substitutions: " ++ show subs subst n ([], subs) = throwError $ "Left over substitutions: " ++ show subs
subst (Line l : ls, subs) = tell [l] >> subst (ls, subs) ++ " in " ++ n
subst (Sub s : ls, subs) subst n (Line l : ls, subs) = tell [l] >> subst n (ls, subs)
subst n (Sub s : ls, subs)
= case lookup s subs of = case lookup s subs of
Just subLines -> tell subLines >> subst (ls, filter ((/= s) . fst) subs) Just subLines -> tell subLines >> subst n (ls, filter ((/= s) . fst) subs)
Nothing -> throwError $ "Could not find substitution \"" ++ s ++ "\"" Nothing -> throwError $ "Could not find substitution \"" ++ s
++ "\" in test: " ++ n
-- | Given a file's contents, tests it -- | Given a file's contents, tests it