test suite now forces build if necessary

This commit is contained in:
ekmett 2010-06-27 23:56:14 -07:00
parent acfc8b473b
commit 7949de10ea
4 changed files with 44 additions and 15 deletions

View File

@ -1,7 +1,6 @@
module Main where
import Criterion.Main
import Criterion
fib :: Int -> Int
fib 0 = 0

View File

@ -2,35 +2,59 @@
\begin{code}
{-# LANGUAGE CPP #-}
import System.Exit (ExitCode(..))
import Control.Monad (unless, mplus)
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
import Distribution.Simple.Program (programFindLocation, lookupKnownProgram )
import Distribution.Verbosity (normal)
import Distribution.Simple (defaultMainWithHooks, UserHooks(..), simpleUserHooks)
import System.IO (openFile, IOMode (..))
import System.FilePath ( (</>), splitDirectories, isAbsolute )
import System.Process
import System.Directory (getCurrentDirectory, createDirectoryIfMissing, setCurrentDirectory, findExecutable, canonicalizePath)
main = defaultMainWithHooks simpleUserHooks { runTests = testHook }
import Distribution.PackageDescription (PackageDescription)
import Distribution.Verbosity (normal)
import Distribution.Simple.Build (build)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.PreProcess (knownSuffixHandlers)
import Distribution.Simple.Program (programFindLocation, lookupKnownProgram )
import Distribution.Simple.Setup (defaultBuildFlags)
import Distribution.Simple
( Args, defaultMainWithHooks, UserHooks(..), simpleUserHooks)
import System.Exit (ExitCode(..))
import System.FilePath ( (</>), splitDirectories, isAbsolute )
import System.IO (openFile, IOMode (..))
import System.Process
import System.Directory
( getCurrentDirectory, createDirectoryIfMissing
, setCurrentDirectory, findExecutable, canonicalizePath
, removeFile, doesDirectoryExist
)
main :: IO ()
main = defaultMainWithHooks hooks
hooks :: UserHooks
hooks = simpleUserHooks { runTests = testHook }
findHPC :: LocalBuildInfo -> IO FilePath
findHPC lbi = do
Just hpcProgram <- return $ lookupKnownProgram "hpc" $ withPrograms lbi
Just hpc <- programFindLocation hpcProgram normal
return hpc
`catch` \e -> do
`catch` \_ -> do
Just hpc <- findExecutable "hpc"
return hpc
testHook args0 _ _ lbi = do
testHook :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
testHook args0 _unknown pd lbi = do
let args = if null args0 then [] else "-t" : args0
-- dir <- getWorkingDirectory
let testDir = buildDir lbi </> "test-speculation"
baseDir <- getCurrentDirectory
canonicalBuildDir <- canonicalizePath (buildDir lbi)
t <- doesDirectoryExist testDir
unless t $ do
putStrLn "building tests"
build pd lbi defaultBuildFlags knownSuffixHandlers
putStrLn "tests built"
setCurrentDirectory testDir
do removeFile "test-speculation.tix"
putStrLn $ "removed test-speculation.tix"
`catch` \_ -> return ()
exitcode <- system $ unwords $ "test-speculation" : args
unless (exitcode == ExitSuccess) $
fail "test failed"
@ -52,4 +76,7 @@ testHook args0 _ _ lbi = do
unless (exitcode == ExitSuccess) $
fail "hpc report failed"
putStrLn $ "Code coverage created: " ++ (markupDir (buildDir lbi) </> "hpc_index.html")
\end{code}

View File

@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
module Main where
import Prelude hiding ((||),(&&))
@ -20,5 +21,7 @@ tests =
[ testGroup "cases" $ zipWith (testCase . show) [1 :: Int ..] $
[]
, testGroup "properties" $ zipWith (testProperty . show) [1 :: Int ..] $
[ property $ \ a -> spec a (*2) a == ((*2) $! a :: Int) ]
[ property $ \ a -> spec a (*2) a == ((*2) a :: Int) -- unevaluated
, property $ \ !a -> spec a (*2) a == ((*2) $! a :: Int) -- evaluated
]
]

View File

@ -122,7 +122,7 @@ executable benchmark-speculation
if !flag(benchmarks)
buildable: False
else
ghc-options: -Wall
ghc-options: -Wall -threaded
if flag(optimize)
ghc-options: -O2 -fspec-constr -funbox-strict-fields -fdicts-cheap
build-depends: