Remove now-unused code for running timed tests.

This commit is contained in:
Adam Sampson 2008-03-12 18:21:22 +00:00
parent ba10c85fc0
commit 808277ca84
2 changed files with 1 additions and 58 deletions

View File

@ -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 Control.Monad.Error
import Data.List import Data.List
@ -45,15 +45,11 @@ import ParseOccam
import Pass import Pass
import PassList import PassList
import PreprocessOccam import PreprocessOccam
import TestUtils
import Utils import Utils
automaticTest :: FilePath -> IO Test automaticTest :: FilePath -> IO Test
automaticTest fileName = readFile fileName >>* performTest fileName 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: -- Bit of a hard-hack, until usage-checking is on by default:
defaultState :: CompState defaultState :: CompState
defaultState = emptyState {csUsageChecking = True} defaultState = emptyState {csUsageChecking = True}
@ -89,17 +85,6 @@ performTest fileName fileContents
Just err -> if expPass then assertFailure (testName ++ " failed with error: " ++ err) else return () 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") 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 -- | Splits a file's contents into the prologue, and subsequent testcases
parseTestFile :: String -> Either String (String, [(Bool, Bool, String, String)]) parseTestFile :: String -> Either String (String, [(Bool, Bool, String, String)])
parseTestFile wholeText = seqPair (return $ unlines prologue, splitCases testcases) parseTestFile wholeText = seqPair (return $ unlines prologue, splitCases testcases)

View File

@ -41,7 +41,6 @@ module TestUtils where
import Control.Monad.State import Control.Monad.State
import Data.Generics import Data.Generics
import qualified Data.Map as Map import qualified Data.Map as Map
import System.Time
import Test.HUnit hiding (State,Testable) import Test.HUnit hiding (State,Testable)
import Test.QuickCheck import Test.QuickCheck
@ -74,47 +73,6 @@ scaleQC (low,med,high,ext) test level
run :: Testable a => Int -> a -> IO () run :: Testable a => Int -> a -> IO ()
run n = check (defaultConfig { configMaxTest = n }) 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'. -- | Creates a 'A.Name' object with the given 'String' as 'A.nameName', and 'A.nameType' as 'A.VariableName'.
simpleName :: String -> A.Name simpleName :: String -> A.Name
simpleName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.VariableName } simpleName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.VariableName }