Commit e0b6bbed authored by tibbe's avatar tibbe
Browse files

Merge branch 'cabal-1.16'

parents 216d6c79 7a9d70f6
......@@ -4,12 +4,19 @@ import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import Data.List
import Control.Exception
import Prelude hiding (catch)
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
do
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
let sb = "Could not find module `Prelude'"
assertBool ("cabal output should be "++show sb) $
sb `isInfixOf` outputText result
`catch` \exc -> do
putStrLn $ "Cabal result was "++show result
throwIO (exc :: SomeException)
......@@ -4,12 +4,19 @@ import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import Data.List
import Control.Exception
import Prelude hiding (catch)
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
do
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
let sb = "Could not find module `Prelude'"
assertBool ("cabal output should be "++show sb) $
sb `isInfixOf` outputText result
`catch` \exc -> do
putStrLn $ "Cabal result was "++show result
throwIO (exc :: SomeException)
......@@ -6,15 +6,21 @@ import Control.Monad
import System.FilePath
import Data.Version
import Data.List (isInfixOf, intercalate)
import Control.Exception
import Prelude hiding (catch)
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 'library which is defined within the same package.'" True $
"library which is defined within the same package." `isInfixOf` (intercalate " " $ lines $ outputText result)
do
assertEqual "cabal build should fail" False (successful result)
when (cabalVersion >= Version [1, 7] []) $ do
let sb = "library which is defined within the same package."
-- In 1.7 it should tell you how to enable the desired behaviour.
assertEqual ("cabal output should say "++show sb) True $
sb `isInfixOf` (intercalate " " $ lines $ outputText result)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show result
throwIO (exc :: SomeException)
......@@ -3,10 +3,16 @@ module PackageTests.BuildDeps.InternalLibrary1.Check where
import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import Control.Exception
import Prelude hiding (catch)
suite :: Test
suite = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "InternalLibrary1") []
result <- cabal_build spec
assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
do
assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show result
throwIO (exc :: SomeException)
......@@ -4,6 +4,8 @@ import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import qualified Data.ByteString.Char8 as C
import Control.Exception
import Prelude hiding (catch)
suite :: Test
......@@ -13,9 +15,17 @@ suite = TestCase $ do
unregister "InternalLibrary2"
iResult <- cabal_install specTI
assertEqual "cabal install should succeed - see to-install/test-log.txt" True (successful iResult)
do
assertEqual "cabal install should succeed" True (successful iResult)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show iResult
throwIO (exc :: SomeException)
bResult <- cabal_build spec
assertEqual "cabal build should succeed - see test-log.txt" True (successful bResult)
do
assertEqual "cabal build should succeed" True (successful bResult)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show bResult
throwIO (exc :: SomeException)
unregister "InternalLibrary2"
(_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
......
......@@ -4,6 +4,8 @@ import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import qualified Data.ByteString.Char8 as C
import Control.Exception
import Prelude hiding (catch)
suite :: Test
......@@ -13,9 +15,17 @@ suite = TestCase $ do
unregister "InternalLibrary3"
iResult <- cabal_install specTI
assertEqual "cabal install should succeed - see to-install/test-log.txt" True (successful iResult)
do
assertEqual "cabal install should succeed - see to-install/test-log.txt" True (successful iResult)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show iResult
throwIO (exc :: SomeException)
bResult <- cabal_build spec
assertEqual "cabal build should succeed - see test-log.txt" True (successful bResult)
do
assertEqual "cabal build should succeed - see test-log.txt" True (successful bResult)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show bResult
throwIO (exc :: SomeException)
unregister "InternalLibrary3"
(_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
......
......@@ -4,6 +4,8 @@ import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import qualified Data.ByteString.Char8 as C
import Control.Exception
import Prelude hiding (catch)
suite :: Test
......@@ -13,9 +15,17 @@ suite = TestCase $ do
unregister "InternalLibrary4"
iResult <- cabal_install specTI
assertEqual "cabal install should succeed - see to-install/test-log.txt" True (successful iResult)
do
assertEqual "cabal install should succeed - see to-install/test-log.txt" True (successful iResult)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show iResult
throwIO (exc :: SomeException)
bResult <- cabal_build spec
assertEqual "cabal build should succeed - see test-log.txt" True (successful bResult)
do
assertEqual "cabal build should succeed - see test-log.txt" True (successful bResult)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show bResult
throwIO (exc :: SomeException)
unregister "InternalLibrary4"
(_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
......
......@@ -3,10 +3,16 @@ module PackageTests.BuildDeps.SameDepsAllRound.Check where
import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import Control.Exception
import Prelude hiding (catch)
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)
do
assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show result
throwIO (exc :: SomeException)
......@@ -4,15 +4,21 @@ import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import Data.List
import Control.Exception
import Prelude hiding (catch)
suite :: Test
suite = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "TargetSpecificDeps1") []
result <- cabal_build spec
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
assertBool "error should be in MyLibrary.hs" $
"MyLibrary.hs:" `isInfixOf` outputText result
assertBool "error should be \"Could not find module `System.Time\"" $
"Could not find module `System.Time'" `isInfixOf`
(intercalate " " $ lines $ outputText result)
do
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
assertBool "error should be in MyLibrary.hs" $
"MyLibrary.hs:" `isInfixOf` outputText result
assertBool "error should be \"Could not find module `System.Time\"" $
"Could not find module `System.Time'" `isInfixOf`
(intercalate " " $ lines $ outputText result)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show result
throwIO (exc :: SomeException)
......@@ -4,10 +4,16 @@ import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import Data.List
import Control.Exception
import Prelude hiding (catch)
suite :: Test
suite = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "TargetSpecificDeps2") []
result <- cabal_build spec
assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
do
assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show result
throwIO (exc :: SomeException)
......@@ -4,14 +4,20 @@ import Test.HUnit
import PackageTests.PackageTester
import System.FilePath
import Data.List
import Control.Exception
import Prelude hiding (catch)
suite :: Test
suite = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "TargetSpecificDeps3") []
result <- cabal_build spec
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
assertBool "error should be in lemon.hs" $
"lemon.hs:" `isInfixOf` outputText result
assertBool "error should be \"Could not find module `System.Time\"" $
"Could not find module `System.Time'" `isInfixOf` (intercalate " " $ lines $ outputText result)
do
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
assertBool "error should be in lemon.hs" $
"lemon.hs:" `isInfixOf` outputText result
assertBool "error should be \"Could not find module `System.Time\"" $
"Could not find module `System.Time'" `isInfixOf` (intercalate " " $ lines $ outputText result)
`catch` \exc -> do
putStrLn $ "Cabal result was "++show result
throwIO (exc :: SomeException)
......@@ -144,32 +144,13 @@ 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
-}
pid <- runProcess cmd args cwd Nothing Nothing (Just outh0) (Just outh0)
-- fork off a thread to start consuming the output
outChan <- newChan
forkIO $ suckH outChan outh
forkIO $ suckH outChan errh
output <- suckChan outChan
output <- suckH [] outh
hClose outh
hClose errh
-- wait on the process
ex <- waitForProcess pid
......@@ -177,22 +158,13 @@ run cwd cmd args = do
return ("\"" ++ fullCmd ++ "\" in " ++ fromMaybe "" cwd,
ex, output)
where
suckH chan h = do
suckH output h = do
eof <- hIsEOF h
if eof
then writeChan chan Nothing
then return (reverse output)
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
suckH (c:output) h
requireSuccess :: (String, ExitCode, String) -> IO ()
requireSuccess (cmd, exitCode, output) = do
......
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