{- |
Module : $Id$
Copyright : (c) Andy Gimblett and Markus Roggenbach and Uni Bremen 2004
License : GPLv2 or higher, see LICENSE.txt
Maintainer : a.m.gimblett@swan.ac.uk
Stability : provisional
Portability : portable
Test case wrapper for CspCASL specs and fragments.
This is a standalone `main' wrapper for CspCASL-related tests
performed locally to the CspCASL codebase. It's probably only of
interest to the CspCASL maintainers.
Usage:
testwrap [options] targets
Options:
-t Don't parse any .cspcasl files; useful for just running tests.
-c Don't run any tests; useful for just parsing .cspcasl files.
Obviously, specifying both of these options stops this program from
doing anything useful.
Parameters:
targets - a list of targets, where each target can be:
- a .cspcasl file; parse the file as a Core-CspCASL specification,
unparse the parse tree, and print out the result of the unparse.
In case of parse error, report the error.
- a .testcase file; execute the test and report the outcome. A
testcase file specifies one test case, whose source is contained
in another file, and whose output we will check against expected
contents. See below for the file format.
- a .testcases file; execute the tests and report their outcomes.
A testcases file specifies multiple test cases, with source
integrated with each test case, and outputs we will check
against expected contents. See below for the file format.
- a directory; find all .cspcasl, .testcase and .testcases files
in the directory (recursively) and operate on them as described
above.
Postive and negative tests:
A positive test is one where we expect the parse to succeed; here
the expected output is the result of unparsing the resultant parse
tree. The test can fail with a parse error, or with unexpected
output.
A negative test is one where we expect the parse to fail; here the
expected output is the error message produced. The test can fail
with a successful parse, or with unexpected output.
Format of .testcase files:
A .testcase file contains a single test case. The first line is the
path to the file containing the source to be parsed/tested, relative
to the .testcase file; it also acts as the name of the test case.
The second line identifies the test sense ("++" is positive, "--" is
negative). The third line is the name of the parser to be used. The
remaining lines contain the expected output of the test.
Format of .testcases files:
A .testcases file contains multiple test cases including their
source. Individual test cases are separated by lines containing
twenty '-' characters and nothing else. The format of an individual
test case is similar but not identical to the format of a standalone
test case (above). The first line is the name of the test (used for
reporting). The second line identifies the test sense ("++" is
positive, "--" is negative). The third line is the name of the
parser to be used. This is followed by the expected outcome of the
test and the source (input) of the test, in that order, both of
which may span multiple lines; they are separated by a line
containing ten '-' characters and nothing else.
-}
module Main where
import Data.List
import Control.Monad
import System.Directory
import System.Environment (getArgs)
import System.FilePath (combine, dropFileName)
import System.IO
import Common.AnnoState (emptyAnnos)
import Common.DocUtils
import CspCASL.Parse_CspCASL (cspBasicExt)
import CspCASL.Parse_CspCASL_Process (csp_casl_process)
import CspCASL.Print_CspCASL ()
main :: IO ()
main = do args <- getArgs
dirs <- filterM doesDirectoryExist args
dir_contents <- liftM concat (mapM listFilesR dirs)
files <- filterM doesFileExist (sort $ nub (args ++ dir_contents))
doIf ("-t" `notElem` args) (parseCspCASLs (filter isCspCASL files))
doIf ("-c" `notElem` args) (performTests (filter isTest files))
where isCspCASL = (".cspcasl" `isSuffixOf`)
isTest f = isSuffixOf ".testcase" f || isSuffixOf ".testcases" f
doIf c f = if c then f else putStr ""
{- | Given a list of paths to .cspcasl files, parse each in turn,
printing results as you go. -}
parseCspCASLs :: [FilePath] -> IO ()
parseCspCASLs [] = putStr ""
parseCspCASLs (f : fs) = do putStrLn dash20
prettyCspCASLFromFile f
parseCspCASLs fs
-- | Parse one .cspcasl file; print error or pretty print parse tree.
prettyCspCASLFromFile :: FilePath -> IO ()
prettyCspCASLFromFile fname
= do putStrLn ("Parsing " ++ fname)
input <- readFile fname
case runParser cspBasicExt (emptyAnnos ()) fname input of
Left err -> do putStr "parse error at "
print err
Right x -> do putStrLn $ showDoc x ""
print x
{- | Test sense: do we expect parse success or failure? What is the
nature of the expected output? -}
data TestSense = Positive | Negative
deriving (Eq, Ord)
instance Show TestSense where
show Positive = "++"
show Negative = "--"
-- | Test case details: where is source, what is it, which parser, etc.
data TestCase = TestCase {
-- | @name@ - test name
name :: String,
-- | @parser@ - name of parser to apply
parser :: String,
-- | @sense@ - sense of test (positive or negative)
sense :: TestSense,
-- | @src@ - source to be parsed
src :: String,
-- | @expected@ - expected output of test
expected :: String
} deriving (Eq, Ord)
instance Show TestCase where
show a = name a ++ " (" ++ show (sense a) ++ parser a ++ ")"
-- | Given a list of paths of test case files, read & perform them.
performTests :: [FilePath] -> IO ()
performTests tcs = do putStrLn "Performing tests"
tests <- liftM concat (mapM readTestFile tcs)
doTests tests
-- | Turn a .testcase or .testcases file into list of test cases therein.
readTestFile :: FilePath -> IO [TestCase]
readTestFile f
| ".testcase" `isSuffixOf` f = readTestCaseFile f
| ".testcases" `isSuffixOf` f = readTestCasesFile f
| otherwise = return []
-- | Turn a .testcase file into the test case therein.
readTestCaseFile :: FilePath -> IO [TestCase]
readTestCaseFile f =
do hdl <- openFile f ReadMode
contents <- hGetContents hdl
let (a, b, c, d) = testCaseParts contents
hdl_s <- openFile (combine (dropFileName f) a) ReadMode
e <- hGetContents hdl_s
return [TestCase { name = a, parser = b, sense = c, expected = d, src = e }]
-- | Turn a .testcases file into the test cases therein.
readTestCasesFile :: FilePath -> IO [TestCase]
readTestCasesFile f =
do hdl <- openFile f ReadMode
s <- hGetContents hdl
let tests = map (interpretTestCasesOne . strip) (split dash20 s)
return tests
-- | Turn test case string from a .testcases file into its test case.
interpretTestCasesOne :: String -> TestCase
interpretTestCasesOne s
| length parts == 2 = TestCase { name = a, parser = b, sense = c,
expected = d, src = e }
| otherwise = error s
where parts = map strip (split dash10 s)
(a, b, c, d) = testCaseParts (head parts)
e = parts !! 1
-- | Turn test case string into its constituent parts (except source).
testCaseParts :: String -> (String, String, TestSense, String)
testCaseParts s = (head ls,
head (tail ls),
interpretSense (head (tail (tail ls))),
unlines (tail (tail (tail ls))))
where ls = lines s
-- | Interpret a test case sense (++ or --, positive or negative)
interpretSense :: String -> TestSense
interpretSense s = case s of
"++" -> Positive
"--" -> Negative
_ -> error ("Bad test sense " ++ s)
{- | Given a list of test cases, perform the tests in turn, printing
results as you go. -}
doTests :: [TestCase] -> IO ()
doTests [] = putStr ""
doTests (tc : ts) = do -- putStrLn dash20
let output = parseTestCase tc
putStr (show tc ++ " ")
printOutcome tc output
doTests ts
{- | Perform a test and report its outcome. There are six
possibilities: 1) positive test succeeds; 2) postive test
fail/non-parse (parse fails); 3) positive test error (unparse not
as expected); 4) negative test succeeds; 5) negative test
fail/parse (parse succeeds); 6) negative test error (error not as
expected). -}
printOutcome :: TestCase -> Either ParseError (String, String) -> IO ()
printOutcome tc out =
case (sense tc, out) of
(Positive, Right (o, tree)) ->
if strip o == strip (expected tc)
then testPass -- case 1
else do testFail "unparse" (expected tc) o -- case 3
putStrLn ("-> tree:\n" ++ tree)
(Positive, Left err) ->
testFail "parse failure" "" (show err) -- case 2
(Negative, Right (o, _)) ->
testFail "parse success" (expected tc) o -- case 5
(Negative, Left err) ->
if strip (show err) == strip (expected tc)
then testPass -- case 4
else testFail "error" (expected tc) (show err) -- case 6
-- Report on a test pass
testPass :: IO ()
testPass = putStrLn "passed"
-- Report on a test failure
testFail :: String -> String -> String -> IO ()
testFail nature expect got =
do putStrLn ("failed - unexpected " ++ nature)
if expect /= ""
then putStrLn ("-> expected:\n" ++ strip expect)
else putStr ""
putStrLn "-> got:"
putStrLn $ strip got
-- | Run a test case through its parser.
parseTestCase :: TestCase -> Either ParseError (String, String)
parseTestCase t =
case parser t of
"CoreCspCASL" -> case runWithEof cspBasicExt of
Left err -> Left err
Right x -> Right (showDoc x "", show x)
"Process" -> case runWithEof csp_casl_process of
Left err -> Left err
Right x -> Right (showDoc x "", show x)
_ -> error "Parser name"
where runWithEof p = runParser p' (emptyAnnos ()) (name t) (src t)
where p' = do n <- p
eof
return n
{- The above implemenation is horrible. There must be a nice way to
abstract the parser out from the code to run it and collect/unparse
the result. Alas, I don't know it, or don't know that I know it. -}
dash20, dash10 :: String
dash10 = "----------"
dash20 = dash10 ++ dash10
-- Utility functions which really should be in the standard library!
{- | Recursive file lister adapted from
listFilesR :: FilePath -> IO [FilePath]
listFilesR path =
do allfiles <- getDirectoryContents path
nodots <- filterM (return . isDODD) (map (combine path) allfiles)
dirs <- filterM doesDirectoryExist nodots
subdirfiles <- liftM concat $ mapM listFilesR dirs
files <- filterM doesFileExist nodots
return $ files ++ subdirfiles
where
isDODD f = not $ ("/." `isSuffixOf` f) || ("/.." `isSuffixOf` f)
{- | A function inspired by python's string.split(). A list is split
on a separator which is itself a list (not a single element). -}
split :: Eq a => [a] -> [a] -> [[a]]
split tok = unfoldr (sp1 tok)
where sp1 _ [] = Nothing
sp1 t s = case find (t `isSuffixOf`) (inits s) of
Nothing -> Just (s, [])
Just p -> Just (take (length p - length t) p,
drop (length p) s)
-- | String strip in style of python string.strip()
strip :: String -> String
strip s = dropWhile ws $ reverse $ dropWhile ws $ reverse s
where ws = (`elem` " \n\t\r")