2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann{- |

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannModule : $Header$

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannCopyright : (c) Andy Gimblett and Markus Roggenbach and Uni Bremen 2004

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannMaintainer : a.m.gimblett@swan.ac.uk

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannStability : provisional

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannPortability : portable

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannTest case wrapper for CspCASL specs and fragments.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannThis is a standalone `main' wrapper for CspCASL-related tests

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannperformed locally to the CspCASL codebase. It's probably only of

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmanninterest to the CspCASL maintainers.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannUsage:

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann testwrap [options] targets

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannOptions:

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann -t Don't parse any .cspcasl files; useful for just running tests.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann -c Don't run any tests; useful for just parsing .cspcasl files.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann Obviously, specifying both of these options stops this program from

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann doing anything useful.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannParameters:

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann targets - a list of targets, where each target can be:

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann - a .cspcasl file; parse the file as a Core-CspCASL specification,

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann unparse the parse tree, and print out the result of the unparse.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann In case of parse error, report the error.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann - a .testcase file; execute the test and report the outcome. A

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann testcase file specifies one test case, whose source is contained

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann in another file, and whose output we will check against expected

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann contents. See below for the file format.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann - a .testcases file; execute the tests and report their outcomes.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann A testcases file specifies multiple test cases, with source

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann integrated with each test case, and outputs we will check

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann against expected contents. See below for the file format.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann - a directory; find all .cspcasl, .testcase and .testcases files

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann in the directory (recursively) and operate on them as described

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann above.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannPostive & negative tests:

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann A positive test is one where we expect the parse to succeed; here

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann the expected output is the result of unparsing the resultant parse

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann tree. The test can fail with a parse error, or with unexpected

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann output.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann A negative test is one where we expect the parse to fail; here the

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann expected output is the error message produced. The test can fail

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann with a successful parse, or with unexpected output.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannFormat of .testcase files:

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann A .testcase file contains a single test case. The first line is the

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann path to the file containing the source to be parsed/tested, relative

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann to the .testcase file; it also acts as the name of the test case.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann The second line identifies the test sense ("++" is positive, "--" is

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann negative). The third line is the name of the parser to be used. The

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann remaining lines contain the expected output of the test.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannFormat of .testcases files:

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann A .testcases file contains multiple test cases including their

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann source. Individual test cases are separated by lines containing

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann twenty '-' characters and nothing else. The format of an individual

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann test case is similar but not identical to the format of a standalone

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann test case (above). The first line is the name of the test (used for

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann reporting). The second line identifies the test sense ("++" is

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann positive, "--" is negative). The third line is the name of the

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann parser to be used. This is followed by the expected outcome of the

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann test and the source (input) of the test, in that order, both of

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann which may span multiple lines; they are separated by a line

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann containing ten '-' characters and nothing else.

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann-}

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannmodule Main where

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport Distribution.Compat.FilePath (dirName, joinPaths)

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport Data.List

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport Control.Monad

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport System.Directory

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport System.Environment (getArgs)

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport System.IO

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport Text.ParserCombinators.Parsec

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport Common.AnnoState (emptyAnnos)

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport Common.DocUtils

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport CspCASL.Parse_CspCASL(basicCspCaslSpec)

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport CspCASL.Parse_CspCASL_Process(csp_casl_process)

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannimport CspCASL.Print_CspCASL()

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannmain :: IO ()

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmannmain = do args <- getArgs

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann dirs <- filterM doesDirectoryExist args

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann dir_contents <- (liftM concat) (mapM listFilesR dirs)

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann files <- filterM doesFileExist (sort $ nub (args ++ dir_contents))

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann doIf ("-t" `notElem` args) (parseCspCASLs (filter isCspCASL files))

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann doIf ("-c" `notElem` args) (performTests (filter isTest files))

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann where isCspCASL = (".cspcasl" `isSuffixOf`)

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann isTest f = (isSuffixOf ".testcase" f) || (isSuffixOf ".testcases" f)

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann doIf c f = if c then f else putStr ""

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann-- | Given a list of paths to .cspcasl files, parse each in turn,

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann-- printing results as you go.

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannparseCspCASLs :: [FilePath] -> IO ()

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannparseCspCASLs [] = do putStr ""

2450a4210dee64b064499a3a1154129bdfc74981Daniel HausmannparseCspCASLs (f:fs) = do putStrLn dash20

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann prettyCspCASLFromFile f

2450a4210dee64b064499a3a1154129bdfc74981Daniel Hausmann 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 basicCspCaslSpec (emptyAnnos ()) fname input) of

Left err -> do putStr "parse error at "

print err

Right x -> do putStrLn $ showDoc 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 = do 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 (joinPaths (dirName 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 (map 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 (parts !! 0)

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 [] = do 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 -> IO ()

printOutcome tc out =

case (sense tc, out) of

(Positive, Right o) ->

if (strip o) == (strip $ expected tc)

then testPass -- case 1

else testFail "unparse" (expected tc) o -- case 3

(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 = do 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

parseTestCase t =

case (parser t) of

"CoreCspCASL" -> case (runParser basicCspCaslSpec es fn s) of

Left err -> Left err

Right x -> Right (showDoc x "")

"Process" -> case (runParser csp_casl_process es fn s) of

Left err -> Left err

Right x -> Right (showDoc x "")

_ -> error "Parser name"

where es = emptyAnnos ()

fn = name t

s = src t

-- 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

-- http://therning.org/magnus/archives/228

listFilesR :: FilePath -> IO [FilePath]

listFilesR path =

do allfiles <- getDirectoryContents path

nodots <- filterM (return . isDODD) (map (joinPaths path) allfiles)

dirs <- filterM doesDirectoryExist nodots

subdirfiles <- (mapM listFilesR dirs >>= return . concat)

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 splitme = unfoldr (sp1 tok) splitme

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'])