Tests for existing cabal exec implementation

.gitignore

@@ -5,6 +5,7 @@ cabal-dev/
 Cabal/dist/
 Cabal/tests/Setup
 cabal-install/dist/
+cabal-install/tests/PackageTests/*/dist/
 .hpc/
 *.hi
 *.o

cabal-install/cabal-install.cabal

@@ -212,6 +212,7 @@ test-suite package-tests
   hs-source-dirs: tests
   main-is: PackageTests.hs
   other-modules:
+    PackageTests.Exec.Check
     PackageTests.Freeze.Check
     PackageTests.PackageTester
   build-depends:

cabal-install/tests/PackageTests.hs

@@ -7,6 +7,7 @@ module Main
        where
 
 -- Modules from Cabal.
+import Distribution.Simple.Program.Builtin (ghcPkgProgram)
 import Distribution.Simple.Program.Db (defaultProgramDb, requireProgram)
 import Distribution.Simple.Program.Types
         ( Program(..), simpleProgram, programPath)
@@ -19,13 +20,15 @@ import System.Directory (getCurrentDirectory, setCurrentDirectory)
 import Test.Framework (Test, defaultMain, testGroup)
 
 -- Modules containing the tests.
+import qualified PackageTests.Exec.Check
 import qualified PackageTests.Freeze.Check
 
 -- List of tests to run. Each test will be called with the path to the
 -- cabal binary to use.
-tests :: [FilePath -> Test]
-tests =
-    [ testGroup "Freeze" . PackageTests.Freeze.Check.tests
+tests :: FilePath -> FilePath -> [Test]
+tests cabalPath ghcPkgPath =
+    [ testGroup "Freeze" $ PackageTests.Freeze.Check.tests cabalPath
+    , testGroup "Exec"   $ PackageTests.Exec.Check.tests cabalPath ghcPkgPath
     ]
 
 cabalProgram :: Program
@@ -36,12 +39,15 @@ cabalProgram = (simpleProgram "cabal") {
 main :: IO ()
 main = do
     (cabal, _) <- requireProgram normal cabalProgram defaultProgramDb
+    (ghcPkg, _) <- requireProgram normal ghcPkgProgram defaultProgramDb
     let cabalPath = programPath cabal
+        ghcPkgPath = programPath ghcPkg
     putStrLn $ "Using cabal: " ++ cabalPath
+    putStrLn $ "Using ghc-pkg: " ++ ghcPkgPath
     cwd <- getCurrentDirectory
     let runTests = do
         setCurrentDirectory "tests"
-        defaultMain (map ($ cabalPath) tests)
+        defaultMain $ tests cabalPath ghcPkgPath
     -- Change back to the old working directory so that the tests can be
     -- repeatedly run in `cabal repl` via `:main`.
     runTests `E.finally` setCurrentDirectory cwd

cabal-install/tests/PackageTests/Exec/Check.hs

+module PackageTests.Exec.Check
+       ( tests
+       ) where
+
+
+import PackageTests.PackageTester
+
+import Test.Framework                 as TF (Test)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit                     (assertBool)
+
+import Control.Applicative ((<$>))
+import Data.List (intercalate, isInfixOf)
+import System.FilePath ((</>))
+
+dir :: FilePath
+dir = "PackageTests" </> "Exec"
+
+tests :: FilePath -> FilePath -> [TF.Test]
+tests cabalPath ghcPkgPath =
+    [ testCase "exits with failure if given no argument" $ do
+          result <- cabal_exec dir [] cabalPath
+          assertExecFailed result
+
+    , testCase "prints error message if given no argument" $ do
+          result <- cabal_exec dir [] cabalPath
+          assertExecFailed result
+          let output = outputText result
+              expected = "specify an executable to run"
+              errMsg = "should have requested an executable be specified\n" ++
+                       output
+          assertBool errMsg $
+              expected `isInfixOf` (intercalate " " . lines $ output)
+
+    , testCase "runs the given command" $ do
+          result <- cabal_exec dir ["echo", "this", "string"] cabalPath
+          assertExecSucceeded result
+          let output = outputText result
+              expected = "this string"
+              errMsg = "should have ran the given command\n" ++ output
+          assertBool errMsg $
+              expected `isInfixOf` (intercalate " " . lines $ output)
+
+    , testCase "can run executables installed in the sandbox" $ do
+          -- Test that an executable installed into the sandbox can be found.
+          -- We do this by removing any existing sandbox. Checking that the
+          -- executable cannot be found. Creating a new sandbox. Installing
+          -- the executable and checking it can be run.
+
+          _ <- assertCleanSucceeded   <$> cabal_clean dir [] cabalPath
+          _ <- assertSandboxSucceeded <$> cabal_sandbox dir ["delete"] cabalPath
+          assertMyExecutableDoesNotExist cabalPath
+          _ <- assertSandboxSucceeded <$> cabal_sandbox dir ["init"] cabalPath
+          _ <- assertInstallSucceeded <$> cabal_install dir [] cabalPath
+
+          result <- cabal_exec dir ["my-executable"] cabalPath
+          assertExecSucceeded result
+          let output = outputText result
+              expected = "This is my-executable"
+              errMsg = "should have found a my-executable\n" ++ output
+          assertBool errMsg $
+              expected `isInfixOf` (intercalate " " . lines $ output)
+
+    , testCase "adds the sandbox bin directory to the PATH" $ do
+          _ <- assertCleanSucceeded   <$> cabal_clean dir [] cabalPath
+          _ <- assertSandboxSucceeded <$> cabal_sandbox dir ["delete"] cabalPath
+          assertMyExecutableDoesNotExist cabalPath
+          _ <- assertSandboxSucceeded <$> cabal_sandbox dir ["init"] cabalPath
+          _ <- assertInstallSucceeded <$> cabal_install dir [] cabalPath
+
+          result <- cabal_exec dir ["bash", "--", "-c", "my-executable"] cabalPath
+          assertExecSucceeded result
+          let output = outputText result
+              expected = "This is my-executable"
+              errMsg = "should have found a my-executable\n" ++ output
+          assertBool errMsg $
+              expected `isInfixOf` (intercalate " " . lines $ output)
+
+    , testCase "configures GHC to use the sandbox" $ do
+          let libNameAndVersion = "my-0.1"
+
+          _ <- assertCleanSucceeded   <$> cabal_clean dir [] cabalPath
+          _ <- assertSandboxSucceeded <$> cabal_sandbox dir ["delete"] cabalPath
+          _ <- assertSandboxSucceeded <$> cabal_sandbox dir ["init"] cabalPath
+          _ <- assertInstallSucceeded <$> cabal_install dir [] cabalPath
+
+          assertMyLibIsNotAvailableOutsideofSandbox ghcPkgPath libNameAndVersion
+
+          result <- cabal_exec dir ["ghc-pkg", "list"] cabalPath
+          assertExecSucceeded result
+          let output = outputText result
+              errMsg = "my library should have been found"
+          assertBool errMsg $
+              libNameAndVersion `isInfixOf` (intercalate " " . lines $ output)
+          
+
+    -- , testCase "can find executables built from the package" $ do
+    -- , testCase "configures cabal to use the sandbox" $ do
+    ]
+
+
+
+assertMyExecutableDoesNotExist :: FilePath -> IO ()
+assertMyExecutableDoesNotExist cabalPath = do
+    result <- cabal_exec dir ["my-executable"] cabalPath
+    assertExecFailed result
+    let output = outputText result
+        expected = "cabal: my-executable: does not exist"
+        errMsg = "should not have found a my-executable\n" ++ output
+    assertBool errMsg $
+        expected `isInfixOf` (intercalate " " . lines $ output)
+
+
+
+assertMyLibIsNotAvailableOutsideofSandbox :: FilePath -> String -> IO ()
+assertMyLibIsNotAvailableOutsideofSandbox ghcPkgPath libNameAndVersion = do
+    (_, _, output) <- run (Just $ dir) ghcPkgPath ["list"]
+    assertBool "my library should not have been found" $ not $
+        libNameAndVersion `isInfixOf` (intercalate " " . lines $ output)

cabal-install/tests/PackageTests/Exec/Foo.hs

+module Foo where
+
+foo :: String
+foo = "foo"

cabal-install/tests/PackageTests/Exec/My.hs

+module Main where
+
+main :: IO ()
+main = do
+    putStrLn "This is my-executable"

cabal-install/tests/PackageTests/Exec/my.cabal

+name:           my
+version:        0.1
+license:        BSD3
+cabal-version:  >= 1.2
+build-type:     Simple
+
+library
+    exposed-modules:    Foo
+    build-depends:      base
+
+
+executable my-executable
+    main-is:            My.hs
+    build-depends:      base

cabal-install/tests/PackageTests/PackageTester.hs

@@ -20,14 +20,24 @@ module PackageTests.PackageTester
     ( Result(..)
 
     -- * Running cabal commands
+    , cabal_clean
+    , cabal_exec
     , cabal_freeze
+    , cabal_install
+    , cabal_sandbox
+    , run
 
     -- * Test helpers
+    , assertCleanSucceeded
+    , assertExecFailed
+    , assertExecSucceeded
     , assertFreezeSucceeded
+    , assertInstallSucceeded
+    , assertSandboxSucceeded
     ) where
 
 import qualified Control.Exception.Extensible as E
-import Control.Monad (unless)
+import Control.Monad (when, unless)
 import Data.Maybe (fromMaybe)
 import System.Directory (canonicalizePath, doesFileExist)
 import System.Environment (getEnv)
@@ -47,10 +57,13 @@ import Distribution.Verbosity (Verbosity, flagToVerbosity, normal)
 data Success = Failure
              -- | ConfigureSuccess
              -- | BuildSuccess
-             -- | InstallSuccess
              -- | TestSuccess
              -- | BenchSuccess
+             | CleanSuccess
+             | ExecSuccess
              | FreezeSuccess
+             | InstallSuccess
+             | SandboxSuccess
              deriving (Eq, Show)
 
 data Result = Result
@@ -75,12 +88,36 @@ recordRun (cmd, exitCode, exeOutput) thisSucc res =
             cmd ++ "\n" ++ exeOutput
         }
 
+-- | Run the clean command and return its result.
+cabal_clean :: FilePath -> [String] -> FilePath -> IO Result
+cabal_clean dir args cabalPath = do
+    res <- cabal dir (["clean"] ++ args) cabalPath
+    return $ recordRun res CleanSuccess nullResult
+
+-- | Run the exec command and return its result.
+cabal_exec :: FilePath -> [String] -> FilePath -> IO Result
+cabal_exec dir args cabalPath = do
+    res <- cabal dir (["exec"] ++ args) cabalPath
+    return $ recordRun res ExecSuccess nullResult
+
 -- | Run the freeze command and return its result.
 cabal_freeze :: FilePath -> [String] -> FilePath -> IO Result
 cabal_freeze dir args cabalPath = do
     res <- cabal dir (["freeze"] ++ args) cabalPath
     return $ recordRun res FreezeSuccess nullResult
 
+-- | Run the install command and return its result.
+cabal_install :: FilePath -> [String] -> FilePath -> IO Result
+cabal_install dir args cabalPath = do
+    res <- cabal dir (["install"] ++ args) cabalPath
+    return $ recordRun res InstallSuccess nullResult
+
+-- | Run the sandbox command and return its result.
+cabal_sandbox :: FilePath -> [String] -> FilePath -> IO Result
+cabal_sandbox dir args cabalPath = do
+    res <- cabal dir (["sandbox"] ++ args) cabalPath
+    return $ recordRun res SandboxSuccess nullResult
+
 -- | Returns the command that was issued, the return code, and the output text.
 cabal :: FilePath -> [String] -> FilePath -> IO (String, ExitCode, String)
 cabal dir cabalArgs cabalPath = do
@@ -118,12 +155,42 @@ run cwd path args = do
 ------------------------------------------------------------------------
 -- * Test helpers
 
+assertCleanSucceeded :: Result -> Assertion
+assertCleanSucceeded result = unless (successful result) $
+    assertFailure $
+    "expected: \'cabal clean\' should succeed\n" ++
+    "  output: " ++ outputText result
+
+assertExecSucceeded :: Result -> Assertion
+assertExecSucceeded result = unless (successful result) $
+    assertFailure $
+    "expected: \'cabal exec\' should succeed\n" ++
+    "  output: " ++ outputText result
+
+assertExecFailed :: Result -> Assertion
+assertExecFailed result = when (successful result) $
+    assertFailure $
+    "expected: \'cabal exec\' should fail\n" ++
+    "  output: " ++ outputText result
+
 assertFreezeSucceeded :: Result -> Assertion
 assertFreezeSucceeded result = unless (successful result) $
     assertFailure $
     "expected: \'cabal freeze\' should succeed\n" ++
     "  output: " ++ outputText result
 
+assertInstallSucceeded :: Result -> Assertion
+assertInstallSucceeded result = unless (successful result) $
+    assertFailure $
+    "expected: \'cabal install\' should succeed\n" ++
+    "  output: " ++ outputText result
+
+assertSandboxSucceeded :: Result -> Assertion
+assertSandboxSucceeded result = unless (successful result) $
+    assertFailure $
+    "expected: \'cabal sandbox\' should succeed\n" ++
+    "  output: " ++ outputText result
+
 ------------------------------------------------------------------------
 -- Verbosity