diff --git a/common/TestHarness.hs b/common/TestHarness.hs index f89ffc6..111e86f 100644 --- a/common/TestHarness.hs +++ b/common/TestHarness.hs @@ -31,7 +31,7 @@ The file is terminated by a single percent on its own line. -} -module TestHarness (automaticTest, automaticTimeTest) where +module TestHarness (automaticTest) where import Control.Monad.Error import Data.List @@ -45,15 +45,11 @@ 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} @@ -89,17 +85,6 @@ performTest fileName fileContents 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, Bool, String, String)]) parseTestFile wholeText = seqPair (return $ unlines prologue, splitCases testcases) diff --git a/common/TestUtils.hs b/common/TestUtils.hs index aea2f80..e70e0b3 100644 --- a/common/TestUtils.hs +++ b/common/TestUtils.hs @@ -41,7 +41,6 @@ module TestUtils where import Control.Monad.State import Data.Generics import qualified Data.Map as Map -import System.Time import Test.HUnit hiding (State,Testable) import Test.QuickCheck @@ -74,47 +73,6 @@ scaleQC (low,med,high,ext) test level run :: Testable a => Int -> a -> IO () run n = check (defaultConfig { configMaxTest = n }) -data TimedTaskLevel = TT_Low | TT_Medium | TT_High - --- | The numbers are mean, variance -type TimedTask = TimedTaskLevel -> IO (String, Integer, Maybe Integer) - -timeTask :: String -> (Int,Int,Int) -> IO () -> TimedTask -timeTask label (low,med,high) test level - = case level of - TT_Low -> runLow low test - TT_Medium -> run med test - TT_High -> run high test - where - average :: [Integer] -> Integer - average xs = sum xs `div` (toInteger $ length xs) - - -- Despite what you might expect, there is no equivalent to this function provided - -- by the standard libraries - timeDiffToMicros :: TimeDiff -> Integer - timeDiffToMicros (TimeDiff _ _ day hour min sec pico) - = toInteger (((((((day * 24) + hour) * 60) + min) * 60) + sec) * 1000000) + (pico `div` 1000000) - - -- Times a task in microseconds - time :: IO () -> IO Integer - time task = do startTime <- getClockTime - task - endTime <- getClockTime - let duration = diffClockTimes endTime startTime - return $ timeDiffToMicros duration - - -- Run all tests together then estimate mean and set variance to Nothing: - runLow :: Int -> IO () -> IO (String, Integer, Maybe Integer) - runLow n task = do time <- time $ replicateM_ n task - return (label, time `div` toInteger n, Nothing) - - - -- Run each test separately and calculate mean and variance - run :: Int -> IO () -> IO (String, Integer, Maybe Integer) - run n task = do times <- replicateM n (time task) - let mean = average times - return (label, mean, Just $ average (map (\x -> (x - mean) * (x - mean)) times)) - -- | Creates a 'A.Name' object with the given 'String' as 'A.nameName', and 'A.nameType' as 'A.VariableName'. simpleName :: String -> A.Name simpleName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.VariableName }