[commit: packages/Cabal] ghc-head: Fix test suite failures on Windows. (7abf0e9)

git at git.haskell.org git at git.haskell.org
Wed Sep 4 23:58:12 CEST 2013


Repository : ssh://git@git.haskell.org/Cabal

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/Cabal.git;a=commit;h=7abf0e9bc75d836388591814b957bc343b68cfdc

>---------------------------------------------------------------

commit 7abf0e9bc75d836388591814b957bc343b68cfdc
Author: Mikhail Glushenkov <the.dead.shall.rise at gmail.com>
Date:   Fri Aug 30 18:43:54 2013 +0200

    Fix test suite failures on Windows.


>---------------------------------------------------------------

7abf0e9bc75d836388591814b957bc343b68cfdc
 .../BuildDeps/InternalLibrary2/Check.hs            |    2 +-
 .../BuildDeps/InternalLibrary3/Check.hs            |    2 +-
 .../BuildDeps/InternalLibrary4/Check.hs            |    2 +-
 Cabal/tests/PackageTests/PackageTester.hs          |   21 +++++++++++++-------
 4 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/Cabal/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs b/Cabal/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs
index a617f43..cf7ca3c 100644
--- a/Cabal/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs
+++ b/Cabal/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs
@@ -18,7 +18,7 @@ suite ghcPath ghcPkgPath = TestCase $ do
     assertBuildSucceeded bResult
     unregister "InternalLibrary2" ghcPkgPath
 
-    (_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
+    (_, _, output) <- run (Just $ directory spec) (directory spec </> "dist" </> "build" </> "lemon" </> "lemon") []
     C.appendFile (directory spec </> "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output)
     assertEqual "executable should have linked with the internal library" "myLibFunc internal" (concat $ lines output)
 
diff --git a/Cabal/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs b/Cabal/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs
index 02faa57..8d12af0 100644
--- a/Cabal/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs
+++ b/Cabal/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs
@@ -18,7 +18,7 @@ suite ghcPath ghcPkgPath = TestCase $ do
     assertBuildSucceeded bResult
     unregister "InternalLibrary3"ghcPkgPath
 
-    (_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
+    (_, _, output) <- run (Just $ directory spec) (directory spec </> "dist" </> "build" </> "lemon" </> "lemon") []
     C.appendFile (directory spec </> "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output)
     assertEqual "executable should have linked with the internal library" "myLibFunc internal" (concat $ lines output)
 
diff --git a/Cabal/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs b/Cabal/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs
index 7d30890..af40320 100644
--- a/Cabal/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs
+++ b/Cabal/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs
@@ -18,7 +18,7 @@ suite ghcPath ghcPkgPath = TestCase $ do
     assertBuildSucceeded bResult
     unregister "InternalLibrary4" ghcPkgPath
 
-    (_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
+    (_, _, output) <- run (Just $ directory spec) (directory spec </> "dist" </> "build" </> "lemon" </> "lemon") []
     C.appendFile (directory spec </> "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output)
     assertEqual "executable should have linked with the installed library" "myLibFunc installed" (concat $ lines output)
 
diff --git a/Cabal/tests/PackageTests/PackageTester.hs b/Cabal/tests/PackageTests/PackageTester.hs
index f318a41..15e1cc3 100644
--- a/Cabal/tests/PackageTests/PackageTester.hs
+++ b/Cabal/tests/PackageTests/PackageTester.hs
@@ -40,6 +40,7 @@ import System.IO.Error (isDoesNotExistError)
 import System.Process (runProcess, waitForProcess)
 import Test.HUnit (Assertion, assertFailure)
 
+import Distribution.Simple.BuildPaths (exeExtension)
 import Distribution.Compat.CreatePipe (createPipe)
 import Distribution.ReadE (readEOrFail)
 import Distribution.Verbosity (Verbosity, deafening, flagToVerbosity, normal,
@@ -175,9 +176,11 @@ cabal spec cabalArgs ghcPath = do
 run :: Maybe FilePath -> String -> [String] -> IO (String, ExitCode, String)
 run cwd path args = do
     verbosity <- getVerbosity
-    printRawCommandAndArgs verbosity path args
+    path' <- do pathExists <- doesFileExist path
+                return (if pathExists then path else path <.> exeExtension)
+    printRawCommandAndArgs verbosity path' args
     (readh, writeh) <- createPipe
-    pid <- runProcess path args cwd Nothing Nothing (Just writeh) (Just writeh)
+    pid <- runProcess path' args cwd Nothing Nothing (Just writeh) (Just writeh)
 
     -- fork off a thread to start consuming the output
     out <- suckH [] readh
@@ -185,7 +188,7 @@ run cwd path args = do
 
     -- wait for the program to terminate
     exitcode <- waitForProcess pid
-    let fullCmd = unwords (path : args)
+    let fullCmd = unwords (path' : args)
     return ("\"" ++ fullCmd ++ "\" in " ++ fromMaybe "" cwd, exitcode, out)
   where
     suckH output h = do
@@ -242,20 +245,24 @@ assertInstallSucceeded result = unless (successful result) $
 
 assertOutputContains :: String -> Result -> Assertion
 assertOutputContains needle result =
-    unless (needle `isInfixOf` (unwords $ lines output)) $
+    unless (needle `isInfixOf` (concatOutput output)) $
     assertFailure $
-    " expected: " ++ needle ++
-    "in output: " ++ output
+    " expected: " ++ needle ++ "\n" ++
+    " in output: " ++ output ++ ""
   where output = outputText result
 
 assertOutputDoesNotContain :: String -> Result -> Assertion
 assertOutputDoesNotContain needle result =
-    when (needle `isInfixOf` (unwords $ lines output)) $
+    when (needle `isInfixOf` (concatOutput output)) $
     assertFailure $
     "unexpected: " ++ needle ++
     " in output: " ++ output
   where output = outputText result
 
+-- | Replace line breaks with spaces, correctly handling "\r\n".
+concatOutput :: String -> String
+concatOutput = unwords . lines . filter ((/=) '\r')
+
 ------------------------------------------------------------------------
 -- Verbosity
 





More information about the ghc-commits mailing list