Added support for timing tests in the automatic test cases

common/TestHarness.hs

@@ -24,17 +24,19 @@ There is an initial prologue, assumed to be source code.  Any lines beginning wi
 to be destinations for substitution.  The prologue is terminated by the first test.
 
 Each test has a starting line that begins with a single % followed by either PASS or FAIL,
+optionally followed by an * (indicating this test is a good benchmark for timing)
 followed by a test name.  The lines that run to the start of the next test are the source substitution.
 
 The file is terminated by a single percent on its own line.
 
 -}
 
-module TestHarness (automaticTest) where
+module TestHarness (automaticTest, automaticTimeTest) where
 
 import Control.Monad.Error
 import Control.Monad.State
 import Data.List
+import Data.Maybe
 import System.IO
 import Test.HUnit hiding (performTest)
 import Text.Regex
@@ -44,11 +46,15 @@ import ParseOccam
 import Pass
 import PassList
 import PreprocessOccam
+import TestUtils
 import Utils
 
 automaticTest :: FilePath -> IO Test
 automaticTest fileName = readFile fileName >>* performTest fileName
 
+automaticTimeTest :: (Int, Int, Int) -> FilePath -> IO [TimedTask]
+automaticTimeTest scale fileName = readFile fileName >>* performTimeTest scale fileName
+
 -- Bit of a hard-hack, until usage-checking is on by default:
 defaultState :: CompState
 defaultState = emptyState {csUsageChecking = True}
@@ -62,6 +68,12 @@ testOccam source = do result <- evalStateT (runErrorT compilation) defaultState
                                  Right _  -> Nothing
   where
     compilation = preprocessOccamSource source >>= parseOccamProgram >>= runPasses (getPassList defaultState)
+
+-- | Substitutes each substitution into the prologue
+substitute :: String -> [(Bool, Bool, String, String)] -> [(Bool, Bool, String, String)]
+substitute prologue = map (\(a,b,c,subst) -> (a,b,c,subRegex (mkRegex "%%") prologue subst))
+
+
 -- | Given a file's contents, tests it
 performTest :: String -> String -> Test
 performTest fileName fileContents
@@ -70,33 +82,42 @@ performTest fileName fileContents
       Right (prologue,tests) -> TestLabel fileName $ TestList $ map performTest' (substitute prologue tests)
       
   where
-    -- Substitutes each substitution into the prologue
+    performTest' :: (Bool, Bool, String, String) -> Test
-    substitute :: String -> [(Bool, String, String)] -> [(Bool, String, String)]
+    performTest' (expPass, _, testName, testText)
-    substitute prologue = map (\(a,b,subst) -> (a,b,subRegex (mkRegex "%%") prologue subst))
-    
-    performTest' :: (Bool, String, String) -> Test
-    performTest' (expPass, testName, testText)
       = TestCase $ 
         do result <- testOccam testText
            case result of
              Just err -> if expPass then assertFailure (testName ++ " failed with error: " ++ err) else return ()
              Nothing  -> if expPass then return () else assertFailure (testName ++ " expected to fail but passed")
 
+performTimeTest :: (Int, Int, Int) -> String -> String -> [TimedTask]
+performTimeTest scale fileName fileContents
+  = case parseTestFile fileContents of
+      Left err -> error $ "Error processing file \"" ++ fileName ++ "\": " ++ err
+      Right (prologue,tests) -> mapMaybe performTimeTest' (substitute prologue tests)
+  
+  where
+    performTimeTest' :: (Bool, Bool, String, String) -> Maybe TimedTask
+    performTimeTest' (_, False, _, _) = Nothing
+    performTimeTest' (_, True, testName, testText) = Just $ timeTask testName scale (testOccam testText >> return ())
+
 -- | Splits a file's contents into the prologue, and subsequent testcases
-parseTestFile :: String -> Either String (String, [(Bool, String, String)])
+parseTestFile :: String -> Either String (String, [(Bool, Bool, String, String)])
 parseTestFile wholeText = seqPair (return $ unlines prologue, splitCases testcases)
   where
     allLines = lines wholeText
     (prologue, testcases) = span (\l -> ("%%" `isPrefixOf` l) || (not $ "%" `isPrefixOf` l)) allLines
     
-    splitCases :: [String] -> Either String [(Bool, String, String)]
+    splitCases :: [String] -> Either String [(Bool, Bool, String, String)]
     splitCases [] = throwError "Unexpected EOF"
     splitCases (headLine:otherLines)
-      | "%PASS" `isPrefixOf` headLine = joinM (True, drop 5 headLine , unlines testCaseLines) (splitCases furtherLines) 
+      | "%PASS" `isPrefixOf` headLine = joinM (True, hasStar, testTitle, unlines testCaseLines) (splitCases furtherLines) 
-      | "%FAIL" `isPrefixOf` headLine = joinM (False, drop 5 headLine , unlines testCaseLines) (splitCases furtherLines)
+      | "%FAIL" `isPrefixOf` headLine = joinM (False, hasStar, testTitle, unlines testCaseLines) (splitCases furtherLines)
       | "%" == headLine               = return []
       | otherwise = throwError $ "Unexpected format in testcase-header line: \"" ++ headLine ++ "\""
         where
+          (hasStar, testTitle) = if headLine !! 5 == '*' then (True, drop 6 headLine) else (False, drop 5 headLine)
+        
           (testCaseLines, furtherLines) = span (not . isPrefixOf "%") otherLines
     
     joinM :: Monad m => a -> m [a] -> m [a]