Migrate integration tests to shell based format

Cabal/Cabal.cabal

@@ -173,6 +173,7 @@ library
     Distribution.Compat.CreatePipe
     Distribution.Compat.Environment
     Distribution.Compat.Exception
+    Distribution.Compat.Internal.TempFile
     Distribution.Compat.ReadP
     Distribution.Compiler
     Distribution.InstalledPackageInfo
@@ -247,7 +248,6 @@ library
   other-modules:
     Distribution.Compat.Binary
     Distribution.Compat.CopyFile
-    Distribution.Compat.TempFile
     Distribution.GetOpt
     Distribution.Lex
     Distribution.Simple.GHC.Internal

Cabal/Distribution/Compat/CopyFile.hs

@@ -23,7 +23,7 @@ import System.IO.Error
          ( ioeSetLocation )
 import System.Directory
          ( doesFileExist, renameFile, removeFile )
-import Distribution.Compat.TempFile
+import Distribution.Compat.Internal.TempFile
          ( openBinaryTempFile )
 import System.FilePath
          ( takeDirectory )

Cabal/Distribution/Compat/TempFile.hs → Cabal/Distribution/Compat/Internal/TempFile.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# OPTIONS_HADDOCK hide #-}
-module Distribution.Compat.TempFile (
+module Distribution.Compat.Internal.TempFile (
   openTempFile,
   openBinaryTempFile,
   openNewBinaryFile,

Cabal/Distribution/Simple/Test/LibV09.hs

@@ -8,7 +8,7 @@ module Distribution.Simple.Test.LibV09
 
 import Distribution.Compat.CreatePipe ( createPipe )
 import Distribution.Compat.Environment ( getEnvironment )
-import Distribution.Compat.TempFile ( openTempFile )
+import Distribution.Compat.Internal.TempFile ( openTempFile )
 import Distribution.ModuleName ( ModuleName )
 import qualified Distribution.PackageDescription as PD
 import Distribution.Simple.Build.PathsModule ( pkgPathEnvVar )

Cabal/Distribution/Simple/Utils.hs

@@ -203,7 +203,7 @@ import System.Process
 import Distribution.Compat.CopyFile
          ( copyFile, copyOrdinaryFile, copyExecutableFile
          , setFileOrdinary, setFileExecutable, setDirOrdinary )
-import Distribution.Compat.TempFile
+import Distribution.Compat.Internal.TempFile
          ( openTempFile, createTempDirectory )
 import Distribution.Compat.Exception
          ( tryIO, catchIO, catchExit )

cabal-install/cabal-install.cabal

@@ -229,29 +229,20 @@ Test-Suite unit-tests
     ghc-options: -threaded
   default-language: Haskell2010
 
--- Large, system tests that build packages.
-test-suite package-tests
+test-suite integration-tests
   type: exitcode-stdio-1.0
   hs-source-dirs: tests
-  main-is: PackageTests.hs
-  other-modules:
-    PackageTests.Exec.Check
-    PackageTests.Freeze.Check
-    PackageTests.MultipleSource.Check
-    PackageTests.PackageTester
+  main-is: IntegrationTests.hs
   build-depends:
     Cabal,
-    QuickCheck >= 2.1.0.1 && < 2.9,
+    async,
     base,
     bytestring,
     directory,
-    extensible-exceptions,
     filepath,
     process,
-    regex-posix,
     tasty,
-    tasty-hunit,
-    tasty-quickcheck
+    tasty-hunit
 
   if os(windows)
     build-depends: Win32 >= 2 && < 3

cabal-install/tests/IntegrationTests.hs

@@ -0,0 +1,274 @@
+-- | Groups black-box tests of cabal-install and configures them to test
+-- the correct binary.
+--
+-- This file should do nothing but import tests from other modules and run
+-- them with the path to the correct cabal-install binary.
+module Main
+       where
+
+-- Modules from Cabal.
+import Distribution.Compat.CreatePipe (createPipe)
+import Distribution.Compat.Environment (setEnv)
+import Distribution.Compat.Internal.TempFile (createTempDirectory)
+import Distribution.Simple.Configure (findDistPrefOrDefault)
+import Distribution.Simple.Program.Builtin (ghcPkgProgram)
+import Distribution.Simple.Program.Db
+        (defaultProgramDb, requireProgram, setProgramSearchPath)
+import Distribution.Simple.Program.Find
+        (ProgramSearchPathEntry(ProgramSearchPathDir), defaultProgramSearchPath)
+import Distribution.Simple.Program.Types
+        ( Program(..), simpleProgram, programPath)
+import Distribution.Simple.Setup ( Flag(..) )
+import Distribution.Simple.Utils ( findProgramVersion, copyDirectoryRecursive )
+import Distribution.Verbosity (normal)
+
+-- Third party modules.
+import Control.Concurrent.Async (withAsync, wait)
+import Control.Exception (bracket)
+import System.Directory
+        ( canonicalizePath
+        , getDirectoryContents
+        , getTemporaryDirectory
+        , doesDirectoryExist
+        , removeDirectoryRecursive
+        , doesFileExist )
+import System.FilePath ((</>), replaceExtension)
+import Test.Tasty (TestTree, defaultMain, testGroup)
+import Test.Tasty.HUnit (testCase, Assertion, assertFailure)
+import Control.Monad ( filterM, forM, when )
+import Data.List (isPrefixOf, isSuffixOf, sort)
+import Data.IORef (newIORef, writeIORef, readIORef)
+import System.Exit (ExitCode(..))
+import System.IO (withBinaryFile, IOMode(ReadMode))
+import System.Process (runProcess, waitForProcess)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as C8
+import           Data.ByteString (ByteString)
+
+-- | Test case.
+data TestCase = TestCase
+    { tcName :: String -- ^ Name of the shell script
+    , tcBaseDirectory :: FilePath
+    , tcCategory :: String
+    , tcShouldX :: String
+    , tcStdOutPath :: Maybe FilePath -- ^ File path of "golden standard output"
+    , tcStdErrPath :: Maybe FilePath -- ^ File path of "golden standard error"
+    }
+
+-- | Test result.
+data TestResult = TestResult
+    { trExitCode :: ExitCode
+    , trStdOut :: ByteString
+    , trStdErr :: ByteString
+    , trWorkingDirectory :: FilePath
+    }
+
+-- | Cabal executable
+cabalProgram :: Program
+cabalProgram = (simpleProgram "cabal") {
+    programFindVersion = findProgramVersion "--numeric-version" id
+  }
+
+-- | Convert test result to string.
+testResultToString :: TestResult -> String
+testResultToString testResult =
+    exitStatus ++ "\n" ++ workingDirectory ++ "\n\n" ++ stdOut ++ "\n\n" ++ stdErr
+  where
+    exitStatus = "Exit status: " ++ show (trExitCode testResult)
+    workingDirectory = "Working directory: " ++ (trWorkingDirectory testResult)
+    stdOut = "<stdout> was:\n" ++ C8.unpack (trStdOut testResult)
+    stdErr = "<stderr> was:\n" ++ C8.unpack (trStdErr testResult)
+
+-- | Returns the command that was issued, the return code, and the output text
+run :: FilePath -> String -> [String] -> IO TestResult
+run cwd path args = do
+  -- path is relative to the current directory; canonicalizePath makes it
+  -- absolute, so that runProcess will find it even when changing directory.
+  path' <- canonicalizePath path
+
+  (pid, hReadStdOut, hReadStdErr) <- do
+    -- Create pipes for StdOut and StdErr
+    (hReadStdOut, hWriteStdOut) <- createPipe
+    (hReadStdErr, hWriteStdErr) <- createPipe
+    -- Run the process
+    pid <- runProcess path' args (Just cwd) Nothing Nothing (Just hWriteStdOut) (Just hWriteStdErr)
+    -- Return the pid and read ends of the pipes
+    return (pid, hReadStdOut, hReadStdErr)
+  -- Read subprocess output using asynchronous threads; we need to
+  -- do this aynchronously to avoid deadlocks due to buffers filling
+  -- up.
+  withAsync (B.hGetContents hReadStdOut) $ \stdOutAsync -> do
+    withAsync (B.hGetContents hReadStdErr) $ \stdErrAsync -> do
+      -- Wait for the subprocess to terminate
+      exitcode <- waitForProcess pid
+      -- We can now be sure that no further output is going to arrive,
+      -- so we wait for the results of the asynchronous reads.
+      stdOut <- wait stdOutAsync
+      stdErr <- wait stdErrAsync
+      -- Done
+      return $ TestResult exitcode stdOut stdErr cwd
+
+-- | Get a list of all names in a directory, excluding all hidden or
+-- system files/directories such as '.', '..'  or any files/directories
+-- starting with a '.'.
+listDirectory :: FilePath -> IO [String]
+listDirectory directory = do
+  fmap (filter notHidden) $ getDirectoryContents directory
+  where
+    notHidden = not . isHidden
+    isHidden name = "." `isPrefixOf` name
+
+-- | List a directory as per 'listDirectory', but return an empty list
+-- in case the directory does not exist.
+listDirectoryLax :: FilePath -> IO [String]
+listDirectoryLax directory = do
+  d <- doesDirectoryExist directory
+  if d then
+    listDirectory directory
+  else
+    return [ ]
+
+pathIfExists :: FilePath -> IO (Maybe FilePath)
+pathIfExists p = do
+  e <- doesFileExist p
+  if e then
+    return $ Just p
+    else
+      return Nothing
+
+fileMatchesString :: FilePath -> ByteString -> IO Bool
+fileMatchesString p s = do
+  withBinaryFile p ReadMode $ \h -> do
+    s' <- B.hGetContents h -- Strict
+    return $ normalizeLinebreaks s' == normalizeLinebreaks s
+  where
+    -- This is a bit of a hack, but since we're comparing
+    -- *text* output, we should be OK.
+    normalizeLinebreaks = B.filter (not . ((==) 13))
+
+mustMatch :: TestResult -> String -> ByteString -> Maybe FilePath -> Assertion
+mustMatch _          _          _ Nothing  =  return ()
+mustMatch testResult handleName s (Just p) = do
+  m <- fileMatchesString p s
+  if not m then
+      assertFailure $ "<" ++ handleName ++ "> did not match file '" ++ p ++ "'.\n" ++ testResultToString testResult
+    else
+      return ()
+
+discoverTestCategories :: FilePath -> IO [String]
+discoverTestCategories directory = do
+  names <- listDirectory directory
+  fmap sort $ filterM (\name -> doesDirectoryExist $ directory </> name) names
+
+discoverTestCases :: FilePath -> String -> String -> IO [TestCase]
+discoverTestCases baseDirectory category shouldX = do
+  -- Find the names of the shell scripts
+  names <- fmap (filter isTestCase) $ listDirectoryLax directory
+  -- Fill in TestCase for each script
+  forM (sort names) $ \name -> do
+    stdOutPath <- pathIfExists $ directory </> name `replaceExtension` ".out"
+    stdErrPath <- pathIfExists $ directory </> name `replaceExtension` ".err"
+    return $ TestCase { tcName = name
+                      , tcBaseDirectory = baseDirectory
+                      , tcCategory = category
+                      , tcShouldX = shouldX
+                      , tcStdOutPath = stdOutPath
+                      , tcStdErrPath = stdErrPath
+                      }
+  where
+    directory = baseDirectory </> category </> shouldX
+    isTestCase name = ".sh" `isSuffixOf` name
+
+createTestCases :: [TestCase] -> (TestCase -> Assertion) -> IO [TestTree]
+createTestCases testCases mk =
+  return $ (flip map) testCases $ \tc -> testCase (tcName tc ++ suffix tc) $ mk tc
+  where
+    suffix tc = case (tcStdOutPath tc, tcStdErrPath tc) of
+      (Nothing, Nothing) -> " (ignoring stdout+stderr)"
+      (Just _ , Nothing) -> " (ignoring stderr)"
+      (Nothing, Just _ ) -> " (ignoring stdout)"
+      (Just _ , Just _ ) -> ""
+
+runTestCase :: (TestResult -> Assertion) -> TestCase -> IO ()
+runTestCase assertResult tc = do
+  doRemove <- newIORef False
+  bracket createWorkDirectory (removeWorkDirectory doRemove) $ \workDirectory -> do
+    -- Run
+    let scriptDirectory = workDirectory </> tcShouldX tc
+    testResult <- run scriptDirectory "/bin/sh" [ "-e", tcName tc]
+    -- Assert that we got what we expected
+    assertResult testResult
+    mustMatch testResult "stdout" (trStdOut testResult) (tcStdOutPath tc)
+    mustMatch testResult "stderr" (trStdErr testResult) (tcStdErrPath tc)
+    -- Only remove working directory if test succeeded
+    writeIORef doRemove True
+  where
+    createWorkDirectory = do
+      -- Create the temporary directory
+      tempDirectory <- getTemporaryDirectory
+      workDirectory <- createTempDirectory tempDirectory "cabal-install-test"
+      -- Copy all the files from the category into the working directory.
+      copyDirectoryRecursive normal
+        (tcBaseDirectory tc </> tcCategory tc)
+        workDirectory
+      -- Done
+      return workDirectory
+    removeWorkDirectory doRemove workDirectory = do
+        remove <- readIORef doRemove
+        when remove $ removeDirectoryRecursive workDirectory
+
+makeShouldXTests :: FilePath -> String -> String -> (TestResult -> Assertion) -> IO [TestTree]
+makeShouldXTests baseDirectory category shouldX assertResult = do
+  testCases <- discoverTestCases baseDirectory category shouldX
+  createTestCases testCases $ \tc ->
+      runTestCase assertResult tc
+
+makeShouldRunTests :: FilePath -> String -> IO [TestTree]
+makeShouldRunTests baseDirectory category = do
+  makeShouldXTests baseDirectory category "should_run" $ \testResult -> do
+    case trExitCode testResult of
+      ExitSuccess ->
+        return () -- We're good
+      ExitFailure _ ->
+        assertFailure $ "Unexpected exit status.\n\n" ++ testResultToString testResult
+
+makeShouldFailTests :: FilePath -> String -> IO [TestTree]
+makeShouldFailTests baseDirectory category = do
+  makeShouldXTests baseDirectory category "should_fail" $ \testResult -> do
+    case trExitCode testResult of
+      ExitSuccess ->
+        assertFailure $ "Unexpected exit status.\n\n" ++ testResultToString testResult
+      ExitFailure _ ->
+        return () -- We're good
+
+discoverCategoryTests :: FilePath -> String -> IO [TestTree]
+discoverCategoryTests baseDirectory category = do
+  srTests <- makeShouldRunTests baseDirectory category
+  sfTests <- makeShouldFailTests baseDirectory category
+  return [ testGroup "should_run" srTests
+         , testGroup "should_fail" sfTests
+         ]
+
+main :: IO ()
+main = do
+  -- Find executables and build directories, etc.
+  distPref <- findDistPrefOrDefault NoFlag
+  buildDir <- canonicalizePath (distPref </> "build/cabal")
+  let programSearchPath = ProgramSearchPathDir buildDir : defaultProgramSearchPath
+  (cabal, _) <- requireProgram normal cabalProgram (setProgramSearchPath programSearchPath defaultProgramDb)
+  (ghcPkg, _) <- requireProgram normal ghcPkgProgram defaultProgramDb
+  baseDirectory <- canonicalizePath $ "tests" </> "IntegrationTests"
+  -- Set up environment variables for test scripts
+  setEnv "GHC_PKG" $ programPath ghcPkg
+  setEnv "CABAL" $ programPath cabal
+  setEnv "CABAL_ARGS" $ "--config-file=config-file"
+  -- Discover all the test caregories
+  categories <- discoverTestCategories baseDirectory
+  -- Discover tests in each category
+  tests <- forM categories $ \category -> do
+    categoryTests <- discoverCategoryTests baseDirectory category
+    return (category, categoryTests)
+  -- Map into a test tree
+  let testTree = map (\(category, categoryTests) -> testGroup category categoryTests) tests
+  -- Run the tests
+  defaultMain $ testGroup "Integration Tests" $ testTree

cabal-install/tests/IntegrationTests/exec/common.sh

@@ -0,0 +1,9 @@
+# Helper to run Cabal
+cabal() {
+    $CABAL $CABAL_ARGS "$@"
+}
+
+die() {
+    echo "die: $@"
+    exit 1
+}

cabal-install/tests/IntegrationTests/exec/should_run/adds_sandbox_bin_directory_to_path.out

@@ -0,0 +1 @@
+This is my-executable

cabal-install/tests/IntegrationTests/exec/should_run/adds_sandbox_bin_directory_to_path.sh

@@ -0,0 +1,10 @@
+source ../common.sh
+
+cabal sandbox delete > /dev/null
+cabal exec my-executable && die "Unexpectedly found executable"
+
+cabal sandbox init > /dev/null
+cabal install > /dev/null
+
+# Execute indirectly via bash to ensure that we go through $PATH
+cabal exec sh -- -c my-executable || die "Did not find executable"

cabal-install/tests/IntegrationTests/exec/should_run/auto_configures_on_exec.out

@@ -0,0 +1,4 @@
+Config file path source is commandline option.
+Config file config-file not found.
+Writing default configuration to config-file
+find_me_in_output

cabal-install/tests/IntegrationTests/exec/should_run/auto_configures_on_exec.sh

@@ -0,0 +1,2 @@
+source ../common.sh
+cabal exec echo find_me_in_output

cabal-install/tests/IntegrationTests/exec/should_run/can_run_executables_installed_in_sandbox.out

@@ -0,0 +1 @@
+This is my-executable