c797f343be2f3619bb1f5569753166ec49d27bdbChristian Maeder{- |

c797f343be2f3619bb1f5569753166ec49d27bdbChristian MaederModule : $Header$

c797f343be2f3619bb1f5569753166ec49d27bdbChristian MaederCopyright : (c) Andy Gimblett and Markus Roggenbach and Uni Bremen 2004

97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

c797f343be2f3619bb1f5569753166ec49d27bdbChristian Maeder

b4fbc96e05117839ca409f5f20f97b3ac872d1edTill MossakowskiMaintainer : a.m.gimblett@swan.ac.uk

c797f343be2f3619bb1f5569753166ec49d27bdbChristian MaederStability : provisional

c797f343be2f3619bb1f5569753166ec49d27bdbChristian MaederPortability : portable

f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder

f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederTest case wrapper for CspCASL specs and fragments.

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian MaederThis is a standalone `main' wrapper for CspCASL-related tests

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maederperformed locally to the CspCASL codebase. It's probably only of

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maederinterest to the CspCASL maintainers.

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder

b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian MaederUsage:

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder testwrap [options] targets

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian MaederOptions:

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder

b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maeder -t Don't parse any .cspcasl files; useful for just running tests.

04dada28736b4a237745e92063d8bdd49a362debChristian Maeder

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder -c Don't run any tests; useful for just parsing .cspcasl files.

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder Obviously, specifying both of these options stops this program from

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder doing anything useful.

89054b2b95a3f92e78324dc852f3d34704e2ca49Christian Maeder

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian MaederParameters:

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder

8b9fda012e5ee53b7b2320c0638896a0ff6e99f3Christian Maeder targets - a list of targets, where each target can be:

8b9fda012e5ee53b7b2320c0638896a0ff6e99f3Christian Maeder

8b9fda012e5ee53b7b2320c0638896a0ff6e99f3Christian Maeder - a .cspcasl file; parse the file as a Core-CspCASL specification,

8b9fda012e5ee53b7b2320c0638896a0ff6e99f3Christian Maeder unparse the parse tree, and print out the result of the unparse.

b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian Maeder In case of parse error, report the error.

b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian Maeder

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder - a .testcase file; execute the test and report the outcome. A

04dada28736b4a237745e92063d8bdd49a362debChristian Maeder testcase file specifies one test case, whose source is contained

b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian Maeder in another file, and whose output we will check against expected

b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian Maeder contents. See below for the file format.

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maeder - a .testcases file; execute the tests and report their outcomes.

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder A testcases file specifies multiple test cases, with source

b190f5c7cf3ddda73724efe5ce82b9585ed76be1Christian Maeder integrated with each test case, and outputs we will check

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder against expected contents. See below for the file format.

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder - a directory; find all .cspcasl, .testcase and .testcases files

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder in the directory (recursively) and operate on them as described

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder above.

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian MaederPostive & negative tests:

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder A positive test is one where we expect the parse to succeed; here

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder the expected output is the result of unparsing the resultant parse

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder tree. The test can fail with a parse error, or with unexpected

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder output.

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder A negative test is one where we expect the parse to fail; here the

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder expected output is the error message produced. The test can fail

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder with a successful parse, or with unexpected output.

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian MaederFormat of .testcase files:

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder A .testcase file contains a single test case. The first line is the

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder path to the file containing the source to be parsed/tested, relative

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder to the .testcase file; it also acts as the name of the test case.

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder The second line identifies the test sense ("++" is positive, "--" is

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder negative). The third line is the name of the parser to be used. The

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder remaining lines contain the expected output of the test.

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian MaederFormat of .testcases files:

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder A .testcases file contains multiple test cases including their

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder source. Individual test cases are separated by lines containing

f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder twenty '-' characters and nothing else. The format of an individual

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder test case is similar but not identical to the format of a standalone

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder test case (above). The first line is the name of the test (used for

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder reporting). The second line identifies the test sense ("++" is

f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder positive, "--" is negative). The third line is the name of the

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder parser to be used. This is followed by the expected outcome of the

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder test and the source (input) of the test, in that order, both of

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder which may span multiple lines; they are separated by a line

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder containing ten '-' characters and nothing else.

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder-}

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maedermodule Main where

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport Distribution.Compat.FilePath

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport List

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport Monad

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport System.Directory

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport System.Environment (getArgs)

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport System.IO

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport Text.ParserCombinators.Parsec

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport Common.AnnoState (emptyAnnos)

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport Common.DocUtils

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport CspCASL.Parse_CspCASL(basicCspCaslSpec)

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maederimport CspCASL.Parse_CspCASL_Process(csp_casl_process)

15bb922b665fcd44c6230a1202785d0c7890e90cChristian Maederimport CspCASL.Print_CspCASL()

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maedermain :: IO ()

462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maedermain = do args <- getArgs

f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder dirs <- filterM doesDirectoryExist args

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder dir_contents <- (liftM concat) (mapM listFilesR dirs)

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder files <- filterM doesFileExist (sort $ nub (args ++ dir_contents))

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder doIf ("-t" `notElem` args) (parseCspCASLs (filter isCspCASL files))

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder doIf ("-c" `notElem` args) (performTests (filter isTest files))

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder where isCspCASL = (".cspcasl" `isSuffixOf`)

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder isTest f = (isSuffixOf ".testcase" f) || (isSuffixOf ".testcases" f)

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder doIf c f = if c then f else putStr ""

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder-- | Given a list of paths to .cspcasl files, parse each in turn,

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder-- printing results as you go.

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian MaederparseCspCASLs :: [FilePath] -> IO ()

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian MaederparseCspCASLs [] = do putStr ""

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian MaederparseCspCASLs (f:fs) = do putStrLn "--------------------"

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder prettyCspCASLFromFile f

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder parseCspCASLs fs

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder-- | Parse one .cspcasl file; print error or pretty print parse tree.

04dada28736b4a237745e92063d8bdd49a362debChristian MaederprettyCspCASLFromFile :: FilePath -> IO ()

04dada28736b4a237745e92063d8bdd49a362debChristian MaederprettyCspCASLFromFile fname

15bb922b665fcd44c6230a1202785d0c7890e90cChristian Maeder = do putStrLn ("Parsing " ++ fname)

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder input <- readFile fname

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder case (runParser basicCspCaslSpec (emptyAnnos ()) fname input) of

04dada28736b4a237745e92063d8bdd49a362debChristian Maeder Left err -> do putStr "parse error at "

76fa667489c5e0868ac68de9f0253ac10f73d0b5Christian Maeder print err

76fa667489c5e0868ac68de9f0253ac10f73d0b5Christian Maeder Right x -> do putStrLn $ showDoc x ""

76fa667489c5e0868ac68de9f0253ac10f73d0b5Christian Maeder

76fa667489c5e0868ac68de9f0253ac10f73d0b5Christian Maeder-- | Test sense: do we expect parse success or failure? What is the

76fa667489c5e0868ac68de9f0253ac10f73d0b5Christian Maeder-- nature of the expected output?

76fa667489c5e0868ac68de9f0253ac10f73d0b5Christian Maederdata TestSense = Positive | Negative

76fa667489c5e0868ac68de9f0253ac10f73d0b5Christian Maeder deriving (Eq, Ord)

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maederinstance Show TestSense where

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder show Positive = "++"

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder show Negative = "--"

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder-- | Test case details: where is source, what is it, which parser, etc.

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maederdata TestCase = TestCase {

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder -- | @name@ - test name

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder name :: String,

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder -- | @parser@ - name of parser to apply

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder parser :: String,

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder -- | @sense@ - sense of test (positive or negative)

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder sense :: TestSense,

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder -- | @src@ - source to be parsed

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder src :: String,

15bb922b665fcd44c6230a1202785d0c7890e90cChristian Maeder -- | @expected@ - expected output of test

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder expected :: String

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder} deriving (Eq, Ord)

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maederinstance Show TestCase where

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder show a = (name a) ++ " (" ++ (show (sense a)) ++ (parser a) ++ ")"

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maederdata TestOutcome = TestPass TestCase

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder | TestFail TestCase String

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian MaederperformTests :: [FilePath] -> IO ()

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian MaederperformTests tcs = do putStrLn "Performing tests"

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder tests <- (liftM concat) (mapM readTestFile tcs)

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder doThoseTests tests

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian MaederreadTestFile :: FilePath -> IO [TestCase]

e76e6a43f51438215737d6fc176c89da05bb86daChristian MaederreadTestFile f

ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder | ".testcase" `isSuffixOf` f = readTestCaseFile f

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder | ".testcases" `isSuffixOf` f = readTestCasesFile f

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder | otherwise = do return []

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian MaederreadTestCaseFile :: FilePath -> IO [TestCase]

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian MaederreadTestCaseFile f =

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder do hdl <- openFile f ReadMode

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder contents <- hGetContents hdl

962d5c684e2b86d1f9c556c096b426e10cc74026Christian Maeder let (a, b, c, d) = (interpretTestCase contents)

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder hdl_s <- openFile (joinPaths (dirName f) a) ReadMode

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder e <- hGetContents hdl_s

962d5c684e2b86d1f9c556c096b426e10cc74026Christian Maeder return [TestCase { name=a, parser=b, sense=c, expected=d,

962d5c684e2b86d1f9c556c096b426e10cc74026Christian Maeder src=e

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder }]

962d5c684e2b86d1f9c556c096b426e10cc74026Christian Maeder

962d5c684e2b86d1f9c556c096b426e10cc74026Christian MaederreadTestCasesFile :: FilePath -> IO [TestCase]

962d5c684e2b86d1f9c556c096b426e10cc74026Christian MaederreadTestCasesFile f =

962d5c684e2b86d1f9c556c096b426e10cc74026Christian Maeder do hdl <- openFile f ReadMode

962d5c684e2b86d1f9c556c096b426e10cc74026Christian Maeder contents <- hGetContents hdl

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder putStrLn "Interpreting"

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder let tests = interpretTestCases contents

b984ff0ba75221f64451c1e69b3977967d4e99a1Christian Maeder putStrLn "Done interpreting"

ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder print (show tests)

ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder putStrLn "Woo"

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder return tests

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian MaederinterpretTestCases :: String -> [TestCase]

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian MaederinterpretTestCases s = map interpretTestCasesOne (split "--------------------\n" s)

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian MaederinterpretTestCasesOne :: String -> TestCase

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian MaederinterpretTestCasesOne s

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder | (length parts) == 2 = TestCase { name = a, parser=b, sense=c,

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder expected=d, src=e }

6cca02cb6a5ae882d887a879f8b7a71941c3715cChristian Maeder | otherwise = error s

ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder where parts = split "----------\n" s

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder (a, b, c, d) = interpretTestCase (parts !! 0)

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder e = parts !! 1

4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder

c797f343be2f3619bb1f5569753166ec49d27bdbChristian Maeder

15bb922b665fcd44c6230a1202785d0c7890e90cChristian Maederfoo :: TestCase

15bb922b665fcd44c6230a1202785d0c7890e90cChristian Maederfoo = TestCase { name = "foo", parser = "Process", sense=Positive, expected="Skip", src="Skip" }

15bb922b665fcd44c6230a1202785d0c7890e90cChristian Maeder

b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maeder

-- | Given a list of test cases, perform the tests in turn, printing

-- results as you go.

doThoseTests :: [TestCase] -> IO ()

doThoseTests [] = do putStr ""

doThoseTests (t:ts) = do putStrLn "--------------------"

print (show t)

doThoseTests ts

printResults :: [TestOutcome] -> IO ()

printResults [] = do putStr ""

printResults ((TestPass tc):xs) = do putStrLn ((show tc) ++ " passed")

printResults xs

printResults ((TestFail tc o):xs) = do putStrLn ((show tc) ++ " failed")

putStrLn (o ++ "\nvs\n" ++ (expected tc))

putStrLn "--"

printResults xs

-- | Perform a test and record 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).

performTest :: TestCase -> TestOutcome

performTest tc =

case (sense tc, (parseTestCase tc)) of

(Positive, Right o) -> if (trim o) == (trim (expected tc))

then TestPass tc -- case 1

else TestFail tc o -- case 3

(Positive, Left err) -> TestFail tc (show err) -- case 2

(Negative, Right o) -> TestFail tc o -- case 5

(Negative, Left err) -> if (trim es) == (trim (expected tc))

then TestPass tc -- case 4

else TestFail tc es -- case 6

where es = (show err)

where trim = applyTwice (reverse . trim1)

trim1 = dropWhile (`elem` delim)

delim = [' ', '\t', '\n', '\r']

applyTwice f = f . f

-- | Run a test case.

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.

-- It's all file I/O from here down.

-- | Given the path to a .testcase file, return TestCase value

-- described therein.

readOneTestCase :: FilePath -> FilePath -> IO TestCase

readOneTestCase dir tc =

do hdl <- openFile tc ReadMode

contents <- hGetContents hdl

let (a, b, c, d) = (interpretTestCase contents)

hdl_s <- openFile (joinPaths dir a) ReadMode

e <- hGetContents hdl_s

return TestCase { name=a, parser=b, sense=c, expected=d, src=e }

-- | Given the textual content of a .testcase file, split it into

-- strings representing the various parts of the test case.

interpretTestCase :: String -> (String, String, TestSense, String)

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

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

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

dirs <- filterM doesDirectoryExist no_dots

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

files <- filterM doesFileExist no_dots

return $ files ++ subdirfiles

where

isDODD f = not $ ("/." `isSuffixOf` f) || ("/.." `isSuffixOf` f)

-- | String split in style of python string.split()

split :: String -> String -> [String]

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)