Permalink
Browse files

Test refactored

  • Loading branch information...
1 parent 7a2b5a0 commit e2ce65537df83c46072039f31ce8a5209c2a60e9 @bergmark committed Oct 3, 2012
Showing with 60 additions and 86 deletions.
  1. +60 −86 src/Test.hs
View
@@ -19,46 +19,71 @@ import qualified Parser as P
import ParserTest
import qualified Tokenizer as T
import TokenTest
+import Types
import qualified Warn as W
import WarnTest (warnExpected)
-dropSuffix :: FilePath -> FilePath
-dropSuffix = reverse . drop 1 . dropWhile (/= '.') . reverse
+main :: IO ()
+main = do
+ testfiles <- (\v -> if null v then Nothing else Just v) . filter dotMo <$> getArgs
+ runnerArgs <- filter (not . dotMo) <$> getArgs
+ tokenizer <- mkTest testfiles tokenizerTests "Tokenizer" "tests"
+ parser <- mkTest testfiles parserTests "Parser" "tests"
+ p <- mkTest testfiles printTests "Print" "tests/print"
+ w <- mkTest testfiles warnTests "Warn" "tests/warn"
+ defaultMainWithArgs [tokenizer, parser, p, w] runnerArgs
+
+parserTests :: FilePath -> String -> Test
+parserTests file name =
+ let expected = name `lookup` parserExpected in
+ testCase file $ do
+ fmaybe expected
+ (fail $ name ++ " is missing in parserExpected")
+ (\exp -> tokenize file name $
+ parse (eq name exp))
+
+printTests :: FilePath -> String -> Test
+printTests file name =
+ testCase file $
+ tokenize file name $
+ parse (const $ assertBool "..." True)
+
+tokenizerTests :: FilePath -> String -> Test
+tokenizerTests file name =
+ let expected = name `lookup` tokenExpected in
+ testCase file $
+ when (isJust expected) $ do
+ result <- T.parseFile <$> readFile file
+ feither result
+ (assertEqual file (show $ fromJust expected) . show)
+ (assertEqual file (fromJust expected))
+
+warnTests :: FilePath -> String -> Test
+warnTests file name =
+ testCase file $ do
+ tokenize file name $
+ parse (\r -> do
+ fmaybe (name `lookup` warnExpected)
+ (fail $ name ++ " is missing in warnExpected")
+ (\exp -> assertEqual name exp (W.check r)))
+
+mkTest :: Maybe [FilePath] -> (FilePath -> String -> Test) -> TestName -> FilePath -> IO Test
+mkTest fs p tgName dir = do
+ files <- maybe (findTestFiles dir) return fs
+ return . testGroup tgName $ map (\f -> p f (takeFileName $ dropExtension f)) files
-tokenizerTests :: IO Test
-tokenizerTests = do
- files <- fmap (map ("tests" </>) . sort . filter dotMo) $ getDirectoryContents "tests"
- return $ testGroup "Tokenizer" $ flip map files $ \file ->
- testCase file $ do
- let name = (reverse . drop 1 . dropWhile (/= '.') . reverse . drop 1 . dropWhile (/= '/')) file
- let expected = name `lookup` tokenExpected
- when (isJust expected) $ do
- result <- T.parseFile <$> readFile file
- feither result
- (assertEqual file (show $ fromJust expected) . show)
- (assertEqual file (fromJust expected))
+findTestFiles :: FilePath -> IO [FilePath]
+findTestFiles fp = fmap (map (fp </>) . sort . filter dotMo) . getDirectoryContents $ fp
-parserTests :: Maybe [FilePath] -> IO Test
-parserTests jfiles = do
- files <- fmaybe jfiles
- (fmap (map ("tests" </>) . sort . filter dotMo) $ getDirectoryContents "tests")
- return
--- let files = map ("tests" </>) ["Funcall.mo"]
- return $ testGroup "Tests" $ flip map files $ \file ->
- testCase file $ do
- let name = (reverse . drop 1 . dropWhile (/= '.') . reverse . drop 1 . dropWhile (/= '/')) file
- let expected = name `lookup` parserExpected
- assertBool (name ++ " is missing in parserExpected") (isJust expected)
- when (isJust expected) $ do
- tokens <- T.parseFile <$> readFile file
- feither tokens
- (\err -> assertBool ("Could not tokenize " ++ name ++ ": " ++ show err) False)
- (\toks -> do
- r <- P.parse toks
- case r of
- Left (P.ParseError perr (P.ParseState { P.lastToken = lt, P.parseTokens = ts })) ->
- error . show $ (perr, lt, take 3 ts)
- Right res -> eq name (fromJust expected) res)
+tokenize :: FilePath -> String -> (T.Program -> IO ()) -> IO ()
+tokenize file name f = do
+ contents <- readFile file
+ let tokens = T.parseFile contents
+ either (\err -> assertBool ("Could not tokenize " ++ name ++ ": " ++ show err) False) f tokens
+
+parse :: ([AST] -> IO b) -> T.Program -> IO b
+parse f toks =
+ P.parse toks >>= either (\(P.ParseError perr (P.ParseState { P.parseTokens = ts })) -> error $ show (perr, take 3 ts)) f
eq :: (Eq a, Show a) => String -> a -> a -> IO ()
eq preface expected actual =
@@ -68,54 +93,3 @@ eq preface expected actual =
fail :: String -> IO ()
fail s = assertBool s False
-
-printTests :: IO Test
-printTests = do
- files <- fmap (map ("tests/print" </>) . sort . filter dotMo) $ getDirectoryContents "tests/print"
- return $ testGroup "Printing" $ flip map files $ \file ->
- testCase file $ do
- let name = (reverse . drop 1 . dropWhile (/= '.') . reverse . drop 1 . dropWhile (/= '/')) file
- contents <- readFile file
- let tokens = T.parseFile contents
- feither tokens
- (\err -> assertBool ("Could not tokenize " ++ name ++ ": " ++ show err) False)
- (\toks -> do
- res <- P.parse toks
- feither res
- (\(P.ParseError perr (P.ParseState { P.parseTokens = ts })) -> error $ show (perr, take 3 ts))
- (const $ assertBool "..." True))
--- (\r -> assertEqual name contents (Print.printSrc r)))
-
-warnTests :: IO Test
-warnTests = do
- files <- fmap (map ("tests/warn" </>) . sort . filter dotMo) $ getDirectoryContents "tests/warn"
- return $ testGroup "Warn" $ flip map files $ \file ->
- testCase file $ do
- let name = (drop 1 . dropWhile (/= '/') . reverse . drop 1 . dropWhile (/= '.') . reverse . drop 1 . dropWhile (/= '/')) file
- contents <- readFile file
- let tokens = T.parseFile contents
- feither tokens
- (\err -> assertBool ("Could not tokenize " ++ name ++ ": " ++ show err) False)
- (\toks -> do
- res <- P.parse toks
- feither res
- (\(P.ParseError perr (P.ParseState { P.parseTokens = ts })) -> error $ show (perr, take 3 ts))
- (\r -> do
- fmaybe (name `lookup` warnExpected)
- (fail $ name ++ " is missing in warnExpected")
- (\exp -> assertEqual name exp (W.check r))))
-
-main :: IO ()
-main = do
- testfiles <- (\v -> if null v then Nothing else Just v) . filter dotMo <$> getArgs
- runnerArgs <- filter (not . dotMo) <$> getArgs
- tests <- fmaybe testfiles
- (do
- tokenizer <- tokenizerTests
- parser <- parserTests Nothing
- pr <- printTests
- w <- warnTests
- return [tokenizer, parser, pr, w])
- (\j -> (: []) <$> parserTests (Just j))
-
- defaultMainWithArgs tests runnerArgs

0 comments on commit e2ce655

Please sign in to comment.