Skip to content
Browse files

Fix failing test

Also print more informative test failure messages.

Contributed by Stephen Blackheath.
  • Loading branch information...
1 parent 8036af8 commit 7a9d70f657166bf2d371566128216cdf8aef9f93 @tibbe tibbe committed Aug 29, 2012
View
13 Cabal/tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/Check.hs
@@ -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)
View
13 Cabal/tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive2/Check.hs
@@ -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)
View
18 Cabal/tests/PackageTests/BuildDeps/InternalLibrary0/Check.hs
@@ -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)
View
8 Cabal/tests/PackageTests/BuildDeps/InternalLibrary1/Check.hs
@@ -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)
View
14 Cabal/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs
@@ -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" []
View
14 Cabal/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs
@@ -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" []
View
14 Cabal/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs
@@ -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" []
View
8 Cabal/tests/PackageTests/BuildDeps/SameDepsAllRound/Check.hs
@@ -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)
View
18 Cabal/tests/PackageTests/BuildDeps/TargetSpecificDeps1/Check.hs
@@ -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)
View
8 Cabal/tests/PackageTests/BuildDeps/TargetSpecificDeps2/Check.hs
@@ -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)
View
16 Cabal/tests/PackageTests/BuildDeps/TargetSpecificDeps3/Check.hs
@@ -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)
View
40 Cabal/tests/PackageTests/PackageTester.hs
@@ -133,7 +133,7 @@ cabal spec cabalArgs = do
[ "--make"
-- HPC causes trouble -- see #1012
-- , "-fhpc"
- , "-package-db " ++ wd </> "../dist/package.conf.inplace"
+ , "-package-conf " ++ wd </> "../dist/package.conf.inplace"
, "Setup.hs"
]
requireSuccess r
@@ -144,55 +144,27 @@ 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
let fullCmd = intercalate " " $ cmd:args
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
View
4 Cabal/tests/README
@@ -8,7 +8,9 @@ You can build and run the test suite by running:
cabal configure --package-db=../dist/package.conf.inplace \
--constraint='Cabal == 1.9.1'
cabal build
- ./dist/build/suite/suite
+ cd ..
+ tests/dist/build/suite/suite
+ (because suite.hs starts by 'cd'ing into 'tests')
Replace the Cabal constraint with whatever the current development
version of Cabal.

0 comments on commit 7a9d70f

Please sign in to comment.
Something went wrong with that request. Please try again.