testwrap.hs revision ae6d8241c2ce8132a6e22d9f854edb612c2f637d
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.
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy GimblettThe "test" directory contains (negative & positive) test cases. Each
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimbletttest case is identified by a *.testcase file, with the following
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett - The first line is the name of the file containing the input source
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett to use for this test case (also in the test directory).
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett - The second line identifies which parser is being tested (eg
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett "Process", "Core-CspCASL").
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett - The third line identifies whether this is a positive (++) or
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett negative (--) test case.
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett - If it's a positive test case, the remaining lines contain the
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett expected output of the pretty printer.
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblett - If it's a negative test case, the remaining lines contain
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblett information about the expected error.
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettmodule Main where
2cf5a456da8bb3a2bbb695414d8304426e3bd277Andy Gimblettimport Directory
9ebbce450fb242e1a346f9f89367d8c46fcb2ec8Andy Gimblettimport Common.AnnoState (emptyAnnos)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettimport CspCASL.Parse_CspCASL(basicCspCaslSpec)
b5301fa0ef9e88a488e5cfe8c395a05c2f6884d3Andy Gimblettimport CspCASL.Parse_CspCASL_Process(csp_casl_process)
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 -- | expect parse failure; check error message.
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 {
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) ++ ")"
d40dd10adffcf341489a1310092fcc99de75f225Andy Gimblettdata TestOutcome = TestPass TestCase
d40dd10adffcf341489a1310092fcc99de75f225Andy Gimblett | TestFail TestCase String
d40dd10adffcf341489a1310092fcc99de75f225Andy Gimblettmain = do contents <- readAllTests "test"
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett printResults (map performTest (sort contents))
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettprintResults :: [TestOutcome] -> IO ()
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettprintResults [] = do putStr ""
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettprintResults ((TestPass tc):xs) = do putStr ((show tc) ++ " passed\n")
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett printResults xs
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy GimblettprintResults ((TestFail tc o):xs) = do putStr ((show tc) ++ " failed\n")
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett putStr (o ++ "\nvs\n" ++ (expected tc) ++ "\n--\n")
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett printResults xs
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
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-- | 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-- 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-- It's all I/O from here down.
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
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
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett let cases = (map (\x -> path ++ "/" ++ x) (filter isTestCase files))
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett endswith sub tgt = drop (length sub - length tgt) sub == tgt
ae6d8241c2ce8132a6e22d9f854edb612c2f637dAndy Gimblett isTestCase f = endswith f ".testcase"
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-- | 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
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"