testwrap.hs revision bf7d1ec09971b005fff4133bb8b6964ab7d264e7
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 GimblettMaintainer : a.m.gimblett@swan.ac.uk
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettStability : provisional
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettPortability : portable
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy GimblettTest case wrapper for CspCASL specs and fragments.
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.
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett testwrap [options] targets
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett -t Don't parse any .cspcasl files; useful for just running tests.
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett -c Don't run any tests; useful for just parsing .cspcasl files.
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett Obviously, specifying both of these options stops this program from
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett doing anything useful.
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett targets - a list of targets, where each target can be:
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.
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.
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.
fe9b4842ac7b63bc2a5042ae829759e2874acd05Andy Gimblett - a directory; find all .cspcasl, .testcase and .testcases files
fe9b4842ac7b63bc2a5042ae829759e2874acd05Andy Gimblett in the directory (recursively) and operate on them as described
8e97dcf353ac3afc326ecfd167abd47897215436Andy GimblettPostive and negative tests:
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 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 GimblettFormat of .testcase files:
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett A .testcase file contains a single test case. The first line is the
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett path to the file containing the source to be parsed/tested, relative
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett to the .testcase file; it also acts as the name of the test case.
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett The second line identifies the test sense ("++" is positive, "--" is
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett negative). The third line is the name of the parser to be used. The
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett remaining lines contain the expected output of the test.
34a4c8c6f861104cdc198282f30fae36cf3858adAndy GimblettFormat of .testcases files:
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
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett parser to be used. This is followed by the expected outcome of the
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett test and the source (input) of the test, in that order, both of
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett which may span multiple lines; they are separated by a line
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett containing ten '-' characters and nothing else.
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettmodule Main where
bf7d1ec09971b005fff4133bb8b6964ab7d264e7Andy Gimblettimport System.FilePath (combine, dropFileName)
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettimport Common.AnnoState (emptyAnnos)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettimport CspCASL.Parse_CspCASL(basicCspCaslSpec)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettimport CspCASL.Parse_CspCASL_Process(csp_casl_process)
fe9b4842ac7b63bc2a5042ae829759e2874acd05Andy Gimblettmain = do args <- getArgs
fe9b4842ac7b63bc2a5042ae829759e2874acd05Andy Gimblett dirs <- filterM doesDirectoryExist args
fe9b4842ac7b63bc2a5042ae829759e2874acd05Andy Gimblett dir_contents <- (liftM concat) (mapM listFilesR dirs)
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett files <- filterM doesFileExist (sort $ nub (args ++ dir_contents))
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett doIf ("-t" `notElem` args) (parseCspCASLs (filter isCspCASL files))
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett doIf ("-c" `notElem` args) (performTests (filter isTest files))
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett where isCspCASL = (".cspcasl" `isSuffixOf`)
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett isTest f = (isSuffixOf ".testcase" f) || (isSuffixOf ".testcases" f)
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett doIf c f = if c then f else putStr ""
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 ""
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy GimblettparseCspCASLs (f:fs) = do putStrLn dash20
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett prettyCspCASLFromFile f
34a4c8c6f861104cdc198282f30fae36cf3858adAndy Gimblett parseCspCASLs fs
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 Right x -> do putStrLn $ showDoc x ""
29ac9ecacf0983a565b89f133ff2bdf2ac02b0c4Andy Gimblett putStrLn $ (show x)
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Test sense: do we expect parse success or failure? What is the
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- nature of the expected output?
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblettdata TestSense = Positive | Negative
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett deriving (Eq, Ord)
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblettinstance Show TestSense where
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett show Positive = "++"
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett show Negative = "--"
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett-- | Test case details: where is source, what is it, which parser, etc.
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettdata TestCase = TestCase {
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett -- | @name@ - test name
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett name :: String,
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett -- | @parser@ - name of parser to apply
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett parser :: String,
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett -- | @sense@ - sense of test (positive or negative)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett sense :: TestSense,
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett -- | @src@ - source to be parsed
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett src :: String,
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett -- | @expected@ - expected output of test
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett expected :: String
d40dd10adffcf341489a1310092fcc99de75f225Andy Gimblett} deriving (Eq, Ord)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettinstance Show TestCase where
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett show a = (name a) ++ " (" ++ (show (sense a)) ++ (parser a) ++ ")"
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett-- | Given a list of paths of test case files, read & perform them.
fe9b4842ac7b63bc2a5042ae829759e2874acd05Andy GimblettperformTests :: [FilePath] -> IO ()
fe9b4842ac7b63bc2a5042ae829759e2874acd05Andy GimblettperformTests tcs = do putStrLn "Performing tests"
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett tests <- (liftM concat) (mapM readTestFile tcs)
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett doTests tests
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett-- | Turn a .testcase or .testcases file into list of test cases therein.
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettreadTestFile :: FilePath -> IO [TestCase]
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettreadTestFile f
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett | ".testcase" `isSuffixOf` f = readTestCaseFile f
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett | ".testcases" `isSuffixOf` f = readTestCasesFile f
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett | otherwise = do return []
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett-- | Turn a .testcase file into the test case therein.
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettreadTestCaseFile :: FilePath -> IO [TestCase]
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettreadTestCaseFile f =
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett do hdl <- openFile f ReadMode
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett contents <- hGetContents hdl
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett let (a, b, c, d) = (testCaseParts contents)
bf7d1ec09971b005fff4133bb8b6964ab7d264e7Andy Gimblett hdl_s <- openFile (combine (dropFileName f) a) ReadMode
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett e <- hGetContents hdl_s
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett return [TestCase { name=a, parser=b, sense=c, expected=d, src=e }]
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett-- | Turn a .testcases file into the test cases therein.
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettreadTestCasesFile :: FilePath -> IO [TestCase]
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettreadTestCasesFile f =
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett do hdl <- openFile f ReadMode
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett s <- hGetContents hdl
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett let tests = map interpretTestCasesOne (map strip (split dash20 s))
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett-- | Turn test case string from a .testcases file into its test case.
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettinterpretTestCasesOne :: String -> TestCase
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettinterpretTestCasesOne s
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett | (length parts) == 2 = TestCase { name=a, parser=b, sense=c,
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett expected=d, src=e }
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett | otherwise = error s
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett where parts = map strip (split dash10 s)
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett (a, b, c, d) = testCaseParts (parts !! 0)
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett e = parts !! 1
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett-- | Turn test case string into its constituent parts (except source).
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy GimbletttestCaseParts :: String -> (String, String, TestSense, String)
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy GimbletttestCaseParts s = (head ls,
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett head (tail ls),
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett interpretSense (head (tail (tail ls))),
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett unlines (tail (tail (tail ls))))
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett where ls = lines s
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett-- | Interpret a test case sense (++ or --, positive or negative)
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy GimblettinterpretSense :: String -> TestSense
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy GimblettinterpretSense s = case s of
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett "++" -> Positive
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett "--" -> Negative
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett _ -> error ("Bad test sense " ++ s)
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett-- | Given a list of test cases, perform the tests in turn, printing
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett-- results as you go.
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy GimblettdoTests :: [TestCase] -> IO ()
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy GimblettdoTests [] = do putStr ""
69b3701bf367eacfedd3efef1b95f697228e592aAndy GimblettdoTests (tc:ts) = do --putStrLn dash20
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett let output = parseTestCase tc
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett putStr ((show tc) ++ " ")
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett printOutcome tc output
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett-- | Perform a test and report 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
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy GimblettprintOutcome :: TestCase -> Either ParseError String -> IO ()
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy GimblettprintOutcome tc out =
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett case (sense tc, out) of
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett (Positive, Right o) ->
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett if (strip o) == (strip $ expected tc)
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett then testPass -- case 1
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett else testFail "unparse" (expected tc) o -- case 3
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett (Positive, Left err) ->
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett testFail "parse failure" "" (show err) -- case 2
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett (Negative, Right o) ->
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett testFail "parse success" (expected tc) o -- case 5
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett (Negative, Left err) ->
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett if (strip $ show $ err) == (strip $ expected tc)
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett then testPass -- case 4
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett else testFail "error" (expected tc) (show err) -- case 6
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett-- Report on a test pass
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy GimbletttestPass :: IO ()
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy GimbletttestPass = do putStrLn "passed"
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett-- Report on a test failure
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy GimbletttestFail :: String -> String -> String -> IO()
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy GimbletttestFail nature expect got =
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett do putStrLn ("failed - unexpected " ++ nature)
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett if expect /= ""
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett then putStrLn ("-> expected:\n" ++ (strip expect))
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett else putStr ""
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett putStrLn "-> got:"
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett putStrLn $ strip got
29ac9ecacf0983a565b89f133ff2bdf2ac02b0c4Andy GimblettrunWithEof f fn s = runParser f' es fn s
29ac9ecacf0983a565b89f133ff2bdf2ac02b0c4Andy Gimblett where es = emptyAnnos ()
29ac9ecacf0983a565b89f133ff2bdf2ac02b0c4Andy Gimblett f' = do n <- f
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett-- | Run a test case through its parser.
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettparseTestCase :: TestCase -> Either ParseError String
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy GimblettparseTestCase t =
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett case (parser t) of
29ac9ecacf0983a565b89f133ff2bdf2ac02b0c4Andy Gimblett "CoreCspCASL" -> case (runWithEof basicCspCaslSpec fn s) of
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett Left err -> Left err
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett Right x -> Right (showDoc x "")
29ac9ecacf0983a565b89f133ff2bdf2ac02b0c4Andy Gimblett "Process" -> case (runWithEof csp_casl_process fn s) of
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett Left err -> Left err
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett Right x -> Right (showDoc x "")
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett _ -> error "Parser name"
29ac9ecacf0983a565b89f133ff2bdf2ac02b0c4Andy Gimblett where fn = name 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.
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblettdash20, dash10 :: String
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblettdash10 = "----------"
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblettdash20 = dash10 ++ dash10
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett-- Utility functions which really should be in the standard library!
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett-- | Recursive file lister adapted from
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettlistFilesR :: FilePath -> IO [FilePath]
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy GimblettlistFilesR path =
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett do allfiles <- getDirectoryContents path
bf7d1ec09971b005fff4133bb8b6964ab7d264e7Andy Gimblett nodots <- filterM (return . isDODD) (map (combine path) allfiles)
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett dirs <- filterM doesDirectoryExist nodots
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett subdirfiles <- (mapM listFilesR dirs >>= return . concat)
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett files <- filterM doesFileExist nodots
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett return $ files ++ subdirfiles
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett isDODD f = not $ ("/." `isSuffixOf` f) || ("/.." `isSuffixOf` f)
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett-- | A function inspired by python's string.split(). A list is split
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett-- on a separator which is itself a list (not a single element).
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblettsplit :: Eq a => [a] -> [a] -> [[a]]
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblettsplit tok splitme = unfoldr (sp1 tok) splitme
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett where sp1 _ [] = Nothing
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett sp1 t s = case find (t `isSuffixOf`) $ (inits s) of
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett Nothing -> Just (s, [])
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblett Just p -> Just (take (length p - length t) p,
b6499fa6826cfdc288dc841be705aab6e4cc6c95Andy Gimblett drop (length p) s)
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett-- | String strip in style of python string.strip()
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblettstrip :: String -> String
4690e532c5ebfbf9d71880a5c912ce09ab1fa2feAndy Gimblettstrip s = dropWhile ws $ reverse $ dropWhile ws $ reverse s
9890f5274aa35d7b8c073cd5bbc3c4028b18dc7dAndy Gimblett where ws = (`elem` [' ', '\n', '\t', '\r'])