mirror of
https://github.com/ekmett/speculation.git
synced 2024-10-04 00:38:45 +03:00
test suite now forces build if necessary
This commit is contained in:
parent
acfc8b473b
commit
7949de10ea
@ -1,7 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Criterion.Main
|
||||
import Criterion
|
||||
|
||||
fib :: Int -> Int
|
||||
fib 0 = 0
|
||||
|
51
Setup.lhs
51
Setup.lhs
@ -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}
|
||||
|
||||
|
||||
|
5
Test.hs
5
Test.hs
@ -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
|
||||
]
|
||||
]
|
||||
|
@ -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:
|
||||
|
Loading…
Reference in New Issue
Block a user