YamlReference-0.4: yaml2yeast-test/Main.hs
-------------------------------------------------------------------------------
-- |
-- Module : yaml2yeast-test
-- Copyright : (c) Oren Ben-Kiki 2007
-- License : LGPL
--
-- Maintainer : oren@ben-kiki.org
-- Stability : alpha
-- Portability : portable
--
-- Execute all test cases located in a specified list of directories. Usage
-- is:
-- @
-- yaml2yeast-test [directories...]
-- @
-- If no directories are given, @yaml2yeast-test@ looks for tests in the
-- current working directory (\"@.@\"). Note that @yaml2yeast-test@ does not
-- recurse into sub-directories.
--
-- Each tests consists of two files, with the names
-- \"/production/@.@/testcase/@.input@\" and
-- \"/production/@.@/testcase/@.output@\", where /production/ is the syntax
-- production to be tested and /testcase/ is an arbitrary name. The @.input@
-- file contains the YAML text fed to the parser and the @.output@ file
-- contains the expected output, which is either a set of YEAST tokens or the
-- expected parsing error message.
--
-- If the @.output@ file is missing, the test will automatically fail. If a
-- test fails, a @.error@ file is created. This makes it easy to set up new
-- tests, simply create the input files, run @yaml2yeast-test@, and rename the
-- @.error@ files to @.output@ files (after reviewing them for correctness, of
-- course).
--
-- Exit status is the number of failed tests (0 - success - if all tests pass).
-------------------------------------------------------------------------------
module Main (main) where
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.HashTable as Hash
import System.Directory
import System.Environment
import System.Exit
import System.IO
import Test.HUnit
import Text.Regex
import Text.Yaml.Reference
-- | Map each tokenizer name to whether a test for it was seen.
type Seen = Hash.HashTable String Bool
-- | @allTokenizers@ returns a hash table populated with all known tokenizers
-- where each has the initial value of @False@.
allTokenizers :: IO Seen
allTokenizers = do hash <- Hash.new (==) Hash.hashString
mapM (\name -> Hash.insert hash name False) tokenizerNames
return hash
-- | @reportMissing seen@ reports the productions (tokenizers) which were not
-- /seen/ and returns their number.
reportMissing :: Seen -> IO Int
reportMissing seen = do list <- Hash.toList seen
missing <- foldM reportTest 0 list
if missing > 0
then hPutStrLn stderr $ "Missing: " ++ (show missing)
else return ()
return missing
where reportTest count (name, wasSeen)
| wasSeen = return count
| otherwise = do hPutStrLn stderr $ "No tests for " ++ name
return $ count + 1
-- | Different types of test files.
data TestType = Plain -- ^ Production without arguments.
| WithN -- ^ Production requiring $n$ argument.
| WithC -- ^ Production requiring $c$ argument.
| WithS -- ^ Production requiring $s$ argument.
| WithT -- ^ Production requiring $t$ argument.
| WithNC -- ^ Production requiring $n$ and $c$ arguments.
| WithNS -- ^ Production requiring $n$ and $s$ arguments.
| WithNT -- ^ Production requiring $n$ and $t$ arguments.
deriving Eq
-- | @show testType@ converts a /testType/ to a human-friendly name for error
-- messages.
instance Show TestType where
show testType =
case testType of
Plain -> ""
WithN -> " n"
WithC -> " c"
WithS -> " s"
WithT -> " t"
WithNC -> " n c"
WithNS -> " n s"
WithNT -> " n t"
-- | @isTestInputFile file@ returns whether the specified /file/ is a test
-- input file (ends with \"@.input@\").
isTestInputFile :: FilePath -> IO Bool
isTestInputFile file = do isFile <- doesFileExist file
if not isFile
then return False
else case matchRegex (mkRegex "\\.input$") file of
Just _ -> return True
Nothing -> return False
-- | @isWith parameter file@ returns whether the specified /file/ is for a production
-- that requires the specified /parameter/ (file name contains @.@/parameter/@=@).
isWith :: String -> FilePath -> IO Bool
isWith parameter file =
case matchRegex (mkRegex $ "\\." ++ parameter ++ "=") file of
Just _ -> return True
Nothing -> return False
-- | @testType file@ deduces the type of test stored in the /file/.
testType :: FilePath -> IO TestType
testType file = do withN <- isWith "n" file
withC <- isWith "c" file
withS <- isWith "s" file
withT <- isWith "t" file
case (withN, withC, withS, withT) of
(False, False, False, False) -> return Plain
(True, False, False, False) -> return WithN
(False, False, True, False) -> return WithS
(False, True, False, False) -> return WithC
(False, False, False, True) -> return WithT
(True, True, False, False) -> return WithNC
(True, False, True, False) -> return WithNS
(True, False, False, True) -> return WithNT
(_, _, _, _) -> error $ file ++ ": unknown parameters combination"
-- | @testProduction file@ extracts the production name from a test input
-- /file/ name (file name starts with \"/pattern/@.@\").
testProduction :: FilePath -> String
testProduction file = subRegex (mkRegex "^.*/([0-9a-z+-]+)\\.[^/]*$") file "\\1"
-- | @testParameter parameter file@ extracts the /parameter/ value from a test
-- input /file/ name (file name contains \"@.@/parameter/@=@/value/@.@\"). Also
-- patch the @-@ characters in the @c@ parameter into @_@ to make it possible
-- for the built-in lexer to handle them.
testParameter :: (Read t) => String -> FilePath -> t
testParameter parameter file =
read $ subRegex patchRegex (subRegex extractRegex file "\\1") "\\1_"
where extractRegex = mkRegex $ "^.*\\." ++ parameter ++ "=([^.]+)\\.[^/]*$"
patchRegex = mkRegex "([a-z])-"
-- | @testOutputFile file@ converts a test input /file/ name to test output
-- file name.
testOutputFile :: FilePath -> FilePath
testOutputFile file = subRegex (mkRegex "\\.input$") file ".output"
-- | @testErrorFile file@ converts a test input /file/ name to test error
-- file name.
testErrorFile :: FilePath -> FilePath
testErrorFile file = subRegex (mkRegex "\\.input$") file ".error"
-- | @embedVariables text inputFile@ embeds variables in the /text/ instead of
-- their expanded values; currently only /InputFile/ is embedded instead of the
-- input file name (we cheat by replacing whatever looks like one).
embedVariables :: String -> String
embedVariables text = subRegex (mkRegex "!.*: line ") text "!$InputFile$: line "
-- | @assertTest inputFile@ runs the parser on the input contained in the
-- /inputFile/ using the production extracted from the file name, asserting the
-- result is identical to the content of the matching output file.
assertTest :: FilePath -> Assertion
assertTest inputFile =
do input <- C.readFile inputFile
let outputFile = testOutputFile inputFile
existsOutputFile <- doesFileExist outputFile
expected <- if existsOutputFile
then readFile outputFile
else return "(missing file)"
runType <- testType inputFile
let result = case runType of
Plain -> tokenizer (testProduction inputFile)
WithN -> tokenizerWithN (testProduction inputFile) (testParameter "n" inputFile)
WithC -> tokenizerWithC (testProduction inputFile) (testParameter "c" inputFile)
WithS -> tokenizerWithS (testProduction inputFile) (testParameter "s" inputFile)
WithT -> tokenizerWithT (testProduction inputFile) (testParameter "t" inputFile)
WithNC -> tokenizerWithNC (testProduction inputFile) (testParameter "n" inputFile) (testParameter "c" inputFile)
WithNS -> tokenizerWithNS (testProduction inputFile) (testParameter "n" inputFile) (testParameter "s" inputFile)
WithNT -> tokenizerWithNT (testProduction inputFile) (testParameter "n" inputFile) (testParameter "t" inputFile)
case result of
Nothing -> assertFailure $ inputFile ++ ": unknown production" ++ (show runType) ++ ": " ++ (testProduction inputFile)
Just resolved -> do let actual = embedVariables $ showTokens $ resolved inputFile input False
when (actual /= expected) $ writeFile (testErrorFile inputFile) actual
assertEqual inputFile expected actual
-- | @fileTest seen file@ wraps @assertTest@ in a test case named after the
-- /file/ and marks it as /seen/.
fileTest :: Seen -> FilePath -> IO Test
fileTest seen file = do Hash.update seen (testProduction file) True
return $ TestLabel file $ TestCase $ assertTest file
-- | @directoryTestInputFiles directory@ returns the list of test input files
-- contained in the /directory/.
directoryTestInputFiles :: String -> IO [FilePath]
directoryTestInputFiles directory = do entries <- getDirectoryContents directory
filterM isTestInputFile $ map ((directory ++) . ("/" ++)) entries
-- | @directoryTests seen directory@ returns the list of test cases contained
-- in the /directory/, wrapped in a test case named after it, and updates the
-- /seen/ hash.
directoryTests :: Seen -> String -> IO Test
directoryTests seen directory = do files <- directoryTestInputFiles directory
tests <- mapM (fileTest seen) files
return $ TestLabel directory $ TestList tests
-- | @allTests seen directories@ returns the list of test cases contained in
-- the /directories/ (or \"@.@\" if none is specified), wrapped in a test case
-- named @all@ if there is more than one directory, updating the /seen/ hash.
allTests :: Seen -> [String] -> IO Test
allTests seen directories = do case directories of
[] -> directoryTests seen "."
[directory] -> directoryTests seen directory
_ -> do tests <- mapM (directoryTests seen) directories
return $ TestLabel "all" $ TestList tests
-- | @main@ executes all the tests contained in the directories specified in
-- the command line (or \"@.@\" if none is specified).
main :: IO ()
main = do directories <- getArgs
seen <- allTokenizers
tests <- allTests seen directories
missing <- reportMissing seen
results <- runTestTT tests
case missing + (errors results) + (failures results) of
0 -> exitWith ExitSuccess
n -> exitWith $ ExitFailure n