testwrap.hs revision 34a4c8c6f861104cdc198282f30fae36cf3858ad
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett{- |
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettModule : $Header$
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettCopyright : (c) Andy Gimblett and Markus Roggenbach and Uni Bremen 2004
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettMaintainer : a.m.gimblett@swan.ac.uk
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettStability : provisional
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettPortability : portable
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettTest case wrapper for CspCASL specs and fragments.
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettThis is a standalone `main' wrapper for CspCASL-related tests
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettperformed locally to the CspCASL codebase. It's probably only of
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettinterest to the CspCASL maintainers.
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettUsage:
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett testwrap targets
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett where each target can be:
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett - a .cspcasl file; parse the file as a Core-CspCASL specification,
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett unparse the parse tree, and print out the result of the unparse.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett In case of parse error, report the error.
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett - a .testcase file; execute the test and report the outcome. A
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett testcase file specifies one test case, whose source is contained
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett in another file, and whose output we will check against expected
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett contents. See below for the file format.
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett - a .testcases file; execute the tests and report their outcomes.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett A testcases file specifies multiple test cases, with source
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett integrated with each test case, and outputs we will check
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett against expected contents. See below for the file format.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett - a directory; read all .testcase and .testcases files in the
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett directory (non-recursively) and operate on them as described
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett above.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettPostive & negative tests:
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett A positive test is one where we expect the parse to succeed; here
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett the expected output is the result of unparsing the resultant parse
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett tree. The test can fail with a parse error, or with unexpected
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett output.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett A negative test is one where we expect the parse to fail; here the
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett expected output is the error message produced. The test can fail
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett with a successful parse, or with unexpected output.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettFormat of .testcase files:
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett A .testcase file contains a single test case. The first line is the
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett name of the file containing the source to be parsed/tested (it also
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett acts as the name of the test case). The second line identifies the
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett test sense ("++" is positive, "--" is negative). The third line is
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett the name of the parser to be used. The remaining lines contain the
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett expected output of the test.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettFormat of .testcases files:
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett A .testcases file contains multiple test cases including their
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett source. Individual test cases are separated by lines containing
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett twenty '-' characters and nothing else. The format of an individual
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett test case is similar but not identical to the format of a standalone
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett test case (above). The first line is the name of the test (used for
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett reporting). The second line identifies the test sense ("++" is
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett positive, "--" is negative). The third line is the name of the
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett parser to be used. This is followed by the source of the test and
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett the expected outcome of the test, both of which may span multiple
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett lines; they are separated by a line containing ten '-' characters
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett and nothing else.
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett-}
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettmodule Main where
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett
d40dd10adffcf341489a1310092fcc99de75f225Andy Gimblettimport List
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblettimport Monad
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblettimport System.Directory
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblettimport System.Environment (getArgs)
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettimport System.IO
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettimport Text.ParserCombinators.Parsec
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettimport Common.AnnoState (emptyAnnos)
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettimport Common.DocUtils
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettimport CspCASL.Parse_CspCASL(basicCspCaslSpec)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettimport CspCASL.Parse_CspCASL_Process(csp_casl_process)
aa0d5f8be9950e788884f7431cf4cb7bee74788cAndy Gimblettimport CspCASL.Print_CspCASL()
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblettmain :: IO ()
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblettmain = do args <- getArgs
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett ccs <- filterSuffix args ".cspcasl"
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett tests <- (liftM2 (++) (filterSuffix args ".testcase")
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett (filterSuffix args ".testcases"))
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett parseCspCASLs ccs
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett --print tests
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett where
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett -- Filter existing files with given suffix
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett filterSuffix fs sfx = filterM doesFileExist (filter (sfx `isSuffixOf`) fs)
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett-- | Recursive file lister adapted from
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett-- http://therning.org/magnus/archives/228
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettlistFilesR :: FilePath -> IO [FilePath]
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettlistFilesR path =
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett do allfiles <- getDirectoryContents path
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett no_dots <- filterM (return . isDODD) (map (joinFN path) allfiles)
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett dirs <- listDirs no_dots
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett subdirfiles <- (mapM listFilesR dirs >>= return . concat)
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett files <- listFiles no_dots
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett return $ files ++ subdirfiles
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett where
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett isDODD f = not $ ("/." `isSuffixOf` f) || ("/.." `isSuffixOf` f)
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett listDirs = filterM doesDirectoryExist
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett listFiles = filterM doesFileExist
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett joinFN p1 p2 = p1 ++ "/" ++ p2
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett-- | Given a list of paths to .cspcasl files, parse each in turn,
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett-- printing results as you go.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettparseCspCASLs :: [FilePath] -> IO ()
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettparseCspCASLs [] = do putStr ""
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettparseCspCASLs (f:fs) = do putStrLn "--------------------"
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett prettyCspCASLFromFile f
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett parseCspCASLs fs
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett-- | Parse one .cspcasl file; print error or pretty print parse tree.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettprettyCspCASLFromFile :: FilePath -> IO ()
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettprettyCspCASLFromFile fname
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett = do putStrLn ("Parsing " ++ fname)
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett input <- readFile fname
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett case (runParser basicCspCaslSpec (emptyAnnos ()) fname input) of
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett Left err -> do putStr "parse error at "
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett print err
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett Right x -> do putStrLn $ showDoc x ""
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Test sense: do we expect parse success or failure? What is the
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- nature of the expected output?
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblettdata TestSense
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett -- | expect successful parse; check unparsed result.
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett = Positive
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett -- | expect parse failure; check error message.
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett | Negative
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett deriving (Eq, Ord)
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblettinstance Show TestSense where
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett show Positive = "++"
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett show Negative = "--"
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Test case details: where is source, what is it, which parser, etc.
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettdata TestCase = TestCase {
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett -- | @src_file@ - name of file containing source code of test case
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett src_file :: String,
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett -- | @parser@ - name of parser to apply to that source
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett parser :: String,
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett -- | @sense@ - sense of test (positive or negative)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett sense :: TestSense,
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett -- | @expected@ - expected output of test
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett expected :: String,
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett -- | @src@ - actual source contained in src_file
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett src :: String
d40dd10adffcf341489a1310092fcc99de75f225Andy Gimblett} deriving (Eq, Ord)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettinstance Show TestCase where
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett show a = (src_file a) ++ " (" ++ (show (sense a)) ++ (parser a) ++ ")"
b34e5090387d45b3a35f88eaa23477a83d2a2962Andy Gimblett
d40dd10adffcf341489a1310092fcc99de75f225Andy Gimblettdata TestOutcome = TestPass TestCase
d40dd10adffcf341489a1310092fcc99de75f225Andy Gimblett | TestFail TestCase String
d40dd10adffcf341489a1310092fcc99de75f225Andy Gimblett
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimbletttcMain :: IO ()
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimbletttcMain = do contents <- readAllTests "test"
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett printResults (map performTest (sort contents))
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettprintResults :: [TestOutcome] -> IO ()
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettprintResults [] = do putStr ""
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettprintResults ((TestPass tc):xs) = do putStrLn ((show tc) ++ " passed")
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett printResults xs
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettprintResults ((TestFail tc o):xs) = do putStrLn ((show tc) ++ " failed")
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett putStrLn (o ++ "\nvs\n" ++ (expected tc))
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett putStrLn "--"
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett printResults xs
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Perform a test and record its outcome. There are six
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- possibilities: 1) positive test succeeds; 2) postive test
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- fail/non-parse (parse fails); 3) positive test error (unparse not
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- as expected); 4) negative test succeeds; 5) negative test
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- fail/parse (parse succeeds); 6) negative test error (error not as
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- expected).
d40dd10adffcf341489a1310092fcc99de75f225Andy GimblettperformTest :: TestCase -> TestOutcome
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettperformTest tc =
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett case (sense tc, (parseTestCase tc)) of
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett (Positive, Right o) -> if (trim o) == (trim (expected tc))
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett then TestPass tc -- case 1
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett else TestFail tc o -- case 3
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett (Positive, Left err) -> TestFail tc (show err) -- case 2
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett (Negative, Right o) -> TestFail tc o -- case 5
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett (Negative, Left err) -> if (trim es) == (trim (expected tc))
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett then TestPass tc -- case 4
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett else TestFail tc es -- case 6
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett where es = (show err)
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett where trim = applyTwice (reverse . trim1)
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett trim1 = dropWhile (`elem` delim)
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett delim = [' ', '\t', '\n', '\r']
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett applyTwice f = f . f
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Run a test case.
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettparseTestCase :: TestCase -> Either ParseError String
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy GimblettparseTestCase t =
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett case (parser t) of
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett "CoreCspCASL" -> case (runParser basicCspCaslSpec es fn s) of
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett Left err -> Left err
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett Right x -> Right (showDoc x "")
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett "Process" -> case (runParser csp_casl_process es fn s) of
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett Left err -> Left err
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett Right x -> Right (showDoc x "")
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett _ -> error "Parser name"
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett where es = emptyAnnos ()
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett fn = src_file t
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett s = src t
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- The above implemenation is horrible. There must be a nice way to
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- abstract the parser out from the code to run it and collect/unparse
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- the result. Alas, I don't know it, or don't know that I know it.
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- It's all I/O from here down.
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Given a path to a directory containing test cases, return a list
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett-- of test case values.
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy GimblettreadAllTests :: FilePath -> IO [TestCase]
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy GimblettreadAllTests path = do tests <- listTestCases path
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett mapM (readOneTestCase path) tests
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | List every file in the test directory ending with '.testcase'
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy GimblettlistTestCases :: FilePath -> IO [FilePath]
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettlistTestCases path =
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett do files <- getDirectoryContents path
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett let cases = (map (\x -> path ++ "/" ++ x)
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett (filter (".testcase" `isSuffixOf`) files))
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett return cases
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Given the path to a .testcase file, return TestCase value
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett-- described therein.
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy GimblettreadOneTestCase :: FilePath -> FilePath -> IO TestCase
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettreadOneTestCase dir tc =
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett do hdl <- openFile tc ReadMode
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett contents <- hGetContents hdl
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett let (a, b, c, d) = (interpret contents)
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett hdl_s <- openFile (dir ++ "/" ++ a) ReadMode
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett e <- hGetContents hdl_s
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett return TestCase { src_file=a, parser=b, sense=c, expected=d,
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett src=e
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett }
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Given the textual content of a .testcase file, split it into
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett-- strings representing the various parts of the test case.
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettinterpret :: String -> (String, String, TestSense, String)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettinterpret s = (head ls,
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett head (tail ls),
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett interpretSense (head (tail (tail ls))),
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett unlines (tail (tail (tail ls))))
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett where ls = lines s
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Interpret a test case sense (++ or --, positive or negative)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy GimblettinterpretSense :: String -> TestSense
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy GimblettinterpretSense s = case s of
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett "++" -> Positive
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett "--" -> Negative
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett _ -> error "Test sense"