Commit aba51309 authored by rubbernecking.trumpet.stephen's avatar rubbernecking.trumpet.stephen
Browse files

Ticket #89 part 2: Dependency-related test cases and a simple test harness

The purpose of these tests is mostly to pin down some existing behaviour to
ensure it doesn't get broken by the ticket #89 changes.
parent 8906bc19
module PackageTests.BuildDeps.GlobalBuildDepsNotAdditive1.Check where
import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import Data.List
suite :: Test
suite = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "GlobalBuildDepsNotAdditive1") []
result <- cabal_build spec
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
assertBool "cabal error should be \"Failed to load interface for `Prelude'\"" $
"Failed to load interface for `Prelude'" `isInfixOf` outputText result
name: GlobalBuildDepsNotAdditive1
version: 0.1
license: BSD3
cabal-version: >= 1.6
author: Stephen Blackheath
stability: stable
category: PackageTests
build-type: Simple
description:
If you specify 'base' in the global build dependencies, then define
a library without base, it fails to find 'base' for the library.
---------------------------------------
build-depends: base
Library
exposed-modules: MyLibrary
build-depends: bytestring, old-time
module MyLibrary where
import qualified Data.ByteString.Char8 as C
import System.Time
myLibFunc :: IO ()
myLibFunc = do
getClockTime
let text = "myLibFunc"
C.putStrLn $ C.pack text
import Distribution.Simple
main = defaultMain
module PackageTests.BuildDeps.GlobalBuildDepsNotAdditive2.Check where
import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import Data.List
suite :: Test
suite = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "GlobalBuildDepsNotAdditive2") []
result <- cabal_build spec
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
assertBool "cabal error should be \"Failed to load interface for `Prelude'\"" $
"Failed to load interface for `Prelude'" `isInfixOf` outputText result
name: GlobalBuildDepsNotAdditive1
version: 0.1
license: BSD3
cabal-version: >= 1.6
author: Stephen Blackheath
stability: stable
category: PackageTests
build-type: Simple
description:
If you specify 'base' in the global build dependencies, then define
an executable without base, it fails to find 'base' for the executable
---------------------------------------
build-depends: base
Executable lemon
main-is: lemon.hs
build-depends: bytestring, old-time
import Distribution.Simple
main = defaultMain
import qualified Data.ByteString.Char8 as C
import System.Time
main = do
getClockTime
let text = "lemon"
C.putStrLn $ C.pack text
module PackageTests.BuildDeps.InternalLibrary0.Check where
import Test.HUnit
import PackageTests.PackageTester
import Control.Monad
import System.FilePath
import Data.Version
import Data.List (isInfixOf)
suite :: Version -> Test
suite cabalVersion = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "InternalLibrary0") []
result <- cabal_build spec
assertEqual "cabal build should fail" False (successful result)
{-when (cabalVersion >= Version [1, 7] []) $ do
-- In 1.7 it should tell you how to enable the desired behaviour.
assertEqual "error should say 'refers to an internally defined library'" True $
"refers to an internally defined library" `isInfixOf` (outputText result)-}
module MyLibrary where
import qualified Data.ByteString.Char8 as C
import System.Time
myLibFunc :: IO ()
myLibFunc = do
getClockTime
let text = "myLibFunc"
C.putStrLn $ C.pack text
import Distribution.Simple
main = defaultMain
name: InternalLibrary0
version: 0.1
license: BSD3
cabal-version: >= 1.6
author: Stephen Blackheath
stability: stable
category: PackageTests
build-type: Simple
description:
Check that with 'cabal-version:' containing versions less than 1.7, we do *not*
have the new behaviour to allow executables to refer to the library defined
in the same module.
---------------------------------------
Library
exposed-modules: MyLibrary
build-depends: base, bytestring, old-time
Executable lemon
main-is: lemon.hs
hs-source-dirs: programs
build-depends: base, bytestring, old-time, InternalLibrary0
import System.Time
import MyLibrary
main = do
getClockTime
myLibFunc
module PackageTests.BuildDeps.SameDepsAllRound.Check where
import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
suite :: Test
suite = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "SameDepsAllRound") []
result <- cabal_build spec
assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
module MyLibrary where
import qualified Data.ByteString.Char8 as C
import System.Time
myLibFunc :: IO ()
myLibFunc = do
getClockTime
let text = "myLibFunc"
C.putStrLn $ C.pack text
name: SameDepsAllRound
version: 0.1
license: BSD3
cabal-version: >= 1.6
author: Stephen Blackheath
stability: stable
synopsis: Same dependencies all round
category: PackageTests
build-type: Simple
description:
Check for the "old build-dep behaviour" namely that we get the same
package dependencies on all build targets, even if different ones
were specified for different targets
.
Here all .hs files use the three packages mentioned, so this shows
that build-depends is not target-specific. This is the behaviour
we want when cabal-version contains versions less than 1.7.
---------------------------------------
Library
exposed-modules: MyLibrary
build-depends: base, bytestring
Executable lemon
main-is: lemon.hs
build-depends: old-time
Executable pineapple
main-is: pineapple.hs
import Distribution.Simple
main = defaultMain
import qualified Data.ByteString.Char8 as C
import System.Time
main = do
getClockTime
let text = "lemon"
C.putStrLn $ C.pack text
import qualified Data.ByteString.Char8 as C
import System.Time
main = do
getClockTime
let text = "pineapple"
C.putStrLn $ C.pack text
module PackageTests.PackageTester (
PackageSpec(..),
Success(..),
Result(..),
cabal_configure,
cabal_build,
cabal_install,
unregister,
run
) where
import qualified Control.Exception.Extensible as E
import System.Directory
import System.FilePath
import System.IO
import System.Posix.IO
import System.Process
import System.Exit
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Control.Concurrent
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C
data PackageSpec =
PackageSpec {
directory :: FilePath,
configOpts :: [String]
}
data Success = Failure | ConfigureSuccess | BuildSuccess | InstallSuccess deriving (Eq, Show)
data Result = Result {
successful :: Bool,
success :: Success,
outputText :: String
}
deriving Show
nullResult :: Result
nullResult = Result True Failure ""
recordRun :: (String, ExitCode, String) -> Success -> Result -> Result
recordRun (cmd, exitCode, exeOutput) thisSucc res =
res {
successful = successful res && exitCode == ExitSuccess,
success = if exitCode == ExitSuccess then thisSucc
else success res,
outputText =
(if null $ outputText res then "" else outputText res ++ "\n") ++
cmd ++ "\n" ++ exeOutput
}
cabal_configure :: PackageSpec -> IO Result
cabal_configure spec = do
res <- doCabalConfigure spec
record spec res
return res
doCabalConfigure :: PackageSpec -> IO Result
doCabalConfigure spec = do
cleanResult@(_, _, cleanOutput) <- cabal spec ["clean"]
requireSuccess cleanResult
res <- cabal spec $ ["configure", "--user"] ++ configOpts spec
return $ recordRun res ConfigureSuccess nullResult
doCabalBuild :: PackageSpec -> IO Result
doCabalBuild spec = do
configResult <- doCabalConfigure spec
if successful configResult
then do
res <- cabal spec ["build"]
return $ recordRun res BuildSuccess configResult
else
return configResult
cabal_build :: PackageSpec -> IO Result
cabal_build spec = do
res <- doCabalBuild spec
record spec res
return res
unregister :: String -> IO ()
unregister libraryName = do
res@(_, _, output) <- run Nothing "ghc-pkg" ["unregister", "--user", libraryName]
if "cannot find package" `isInfixOf` output
then return ()
else requireSuccess res
-- | Install this library in the user area
cabal_install :: PackageSpec -> IO Result
cabal_install spec = do
buildResult <- doCabalBuild spec
res <- if successful buildResult
then do
res <- cabal spec ["install"]
return $ recordRun res InstallSuccess buildResult
else
return buildResult
record spec res
return res
-- | Returns the command that was issued, the return code, and hte output text
cabal :: PackageSpec -> [String] -> IO (String, ExitCode, String)
cabal spec cabalArgs =
run (Just $ directory spec) "runhaskell" (["Setup"] ++ cabalArgs)
-- | Returns the command that was issued, the return code, and hte output text
run :: Maybe FilePath -> String -> [String] -> IO (String, ExitCode, String)
run cwd cmd args = do
-- Posix-specific
(outf, outf0) <- createPipe
(errf, errf0) <- createPipe
outh <- fdToHandle outf
outh0 <- fdToHandle outf0
errh <- fdToHandle errf
errh0 <- fdToHandle errf0
pid <- runProcess cmd args cwd Nothing Nothing (Just outh0) (Just errh0)
{-
-- ghc-6.10.1 specific
(Just inh, Just outh, Just errh, pid) <-
createProcess (proc cmd args){ std_in = CreatePipe,
std_out = CreatePipe,
std_err = CreatePipe,
cwd = cwd }
hClose inh -- done with stdin
-}
-- fork off a thread to start consuming the output
outChan <- newChan
forkIO $ suckH outChan outh
forkIO $ suckH outChan errh
output <- suckChan outChan
hClose outh
hClose errh
-- wait on the process
ex <- waitForProcess pid
let fullCmd = intercalate " " $ cmd:args
return ("\"" ++ fullCmd ++ "\" in " ++ fromMaybe "" cwd,
ex, output)
where
suckH chan h = do
eof <- hIsEOF h
if eof
then writeChan chan Nothing
else do
c <- hGetChar h
writeChan chan $ Just c
suckH chan h
suckChan chan = sc' chan 2 []
where
sc' _ 0 acc = return $ reverse acc
sc' chan eofs acc = do
mC <- readChan chan
case mC of
Just c -> sc' chan eofs (c:acc)
Nothing -> sc' chan (eofs-1) acc
requireSuccess :: (String, ExitCode, String) -> IO ()
requireSuccess (cmd, exitCode, output) = do
case exitCode of
ExitSuccess -> return ()
ExitFailure r -> do
ioError $ userError $ "Command " ++ cmd ++ " failed."
record :: PackageSpec -> Result -> IO ()
record spec res = do
C.writeFile (directory spec </> "test-log.txt") (C.pack $ outputText res)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment