Added a helper function for timing tasks in the TestUtils module

common/TestUtils.hs

@@ -42,6 +42,7 @@ import Control.Monad.Error
 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
 
@@ -86,6 +87,49 @@ mkPassResult = Result (Just True) [] []
 mkFailResult :: String -> Result
 mkFailResult s = Result (Just False) [s] []
 
+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))
+  
+
+
 -- | An abbreviation for using 'emptyMeta'.  TODO: This should really be removed (and all uses of it replaced with 'emptyMeta') for clarity.
 m :: Meta
 m = emptyMeta