Merge pull request #9671 from mpickering/wip/cabal-install-Cabal

Use in-tree Cabal library for `cabal-install` tests with custom setup.

cabal-testsuite/PackageTests/CustomDep/cabal.test.hs

 import Test.Cabal.Prelude
 main = cabalTest $ do
-    -- NB: This variant seems to use the bootstrapped Cabal?
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
     -- implicit setup-depends conflict with GHC >= 8.2; c.f. #415
     skipUnlessGhcVersion "< 8.2"
     -- This test depends heavily on what packages are in the global

cabal-testsuite/PackageTests/CustomPlain/setup.test.hs

 import Test.Cabal.Prelude
 main = setupTest $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
     setup' "configure" [] >>= assertOutputContains "ThisIsCustomYeah"
     setup' "build"     [] >>= assertOutputContains "ThisIsCustomYeah"

cabal-testsuite/PackageTests/CustomPreProcess/cabal.test.hs

 import Test.Cabal.Prelude
 -- Test internal custom preprocessor
 main = cabalTest $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
-
     -- old Cabal's ./Setup.hs output is difficult to normalise
     recordMode DoNotRecord $
         cabal "v2-build" []

cabal-testsuite/PackageTests/CustomPreProcess/setup.test.hs

 import Test.Cabal.Prelude
 -- Test internal custom preprocessor
 main = setupTest $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
     setup_build []
     runExe' "hello-world" []
         >>= assertOutputContains "hello from A"

cabal-testsuite/PackageTests/CustomTestCoverage/setup.test.hs

 import Test.Cabal.Prelude
 main = setupTest $ do
+  skipIfGhcVersion "== 7.8.4"
   recordMode DoNotRecord $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
     setup' "configure" ["--enable-tests", "--enable-coverage"] >>= assertOutputContains "ThisIsCustomYeah"
     setup' "build"     []
     setup' "test"      [] >>= assertOutputContains "Package coverage report written to"

cabal-testsuite/PackageTests/DuplicateModuleName/setup.test.hs

@@ -2,7 +2,7 @@ import Test.Cabal.Prelude
 -- Test that if two components have the same module name, they do not
 -- clobber each other.
 main = setupAndCabalTest $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc -- use of library test suite
+    skipIfAllCabalVersion "< 2.2"
     setup_build ["--enable-tests"]
     r1 <- fails $ setup' "test" ["foo"]
     assertOutputContains "test B" r1

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out

-# cabal v2-update
-Downloading the latest package list from test-local-repo
-# cabal v2-repl
-Resolving dependencies...
-Error: [Cabal-7107]
-Could not resolve dependencies:
-[__0] trying: pkg-a-0 (user goal)
-[__1] next goal: pkg-a:setup.Cabal (dependency of pkg-a)
-[__1] rejecting: pkg-a:setup.Cabal-<VERSION>/installed-<HASH>, pkg-a:setup.Cabal-3.8.0.0 (constraint from --enable-multi-repl requires >=3.11)
-[__1] fail (backjumping, conflict set: pkg-a, pkg-a:setup.Cabal)
-After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: pkg-a:setup.Cabal (3), pkg-a (2)

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.test.hs

 import Test.Cabal.Prelude
 
-main = cabalTest $ withRepo "repo" $ do
+main = cabalTest $ recordMode DoNotRecord . withRepo "repo" $ do
+    -- For the multi-repl command
     skipUnlessGhcVersion ">= 9.4"
-    void $ fails $ cabalWithStdin "v2-repl" ["--keep-temp-files","--enable-multi-repl","pkg-a", "pkg-b"] ""
+    skipUnlessAnyCabalVersion "< 3.11"
+    res <- fails $ cabalWithStdin "v2-repl" ["--keep-temp-files","--enable-multi-repl","pkg-a", "pkg-b"] ""
+    assertOutputContains "constraint from --enable-multi-repl requires >=3.11" res

cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.out

-# cabal v2-repl
-Resolving dependencies...
-Error: [Cabal-7107]
-Could not resolve dependencies:
-[__0] trying: pkg-b-0 (user goal)
-[__1] next goal: pkg-b:setup.Cabal (dependency of pkg-b)
-[__1] rejecting: pkg-b:setup.Cabal-<VERSION>/installed-<HASH> (constraint from --enable-multi-repl requires >=3.11)
-[__1] fail (backjumping, conflict set: pkg-b, pkg-b:setup.Cabal)
-After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: pkg-b (2), pkg-b:setup.Cabal (2)

cabal-testsuite/PackageTests/MultiRepl/EnabledBadClosure/cabal.test.hs

 import Test.Cabal.Prelude
 
 main = do
-  cabalTest $ do
-    -- MP: TODO: This should query Cabal library version
-    skipIfGhcVersion ">= 9.10"
+  cabalTest $ recordMode DoNotRecord $ do
+    skipUnlessAnyCabalVersion "< 3.11"
     -- Note: only the last package is interactive.
     -- this test should load pkg-b too.
     res <- fails $ cabalWithStdin "v2-repl" ["--enable-multi-repl","pkg-c", "pkg-a"] "Quu.quu"

cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-packagedbs.test.hs

 import Test.Cabal.Prelude
 main = cabalTest $ do
-    withPackageDb $ do
+    noCabalPackageDb . withPackageDb $ do
         withDirectory "p-no-package-dbs" $ do
             res <- fails $ cabal' "v2-build" []
             assertOutputContains "No package databases have been specified." res

cabal-testsuite/PackageTests/Regression/T4270/setup.test.hs

@@ -3,9 +3,9 @@ import Test.Cabal.Prelude
 -- when linked dynamically
 -- See https://github.com/haskell/cabal/issues/4270
 main = setupAndCabalTest $ do
+  skipIfAllCabalVersion "< 2.2"
   skipUnless "no shared libs"   =<< hasSharedLibraries
   skipUnless "no shared Cabal"  =<< hasCabalShared
-  skipUnless "no Cabal for GHC" =<< hasCabalForGhc
   ghc <- isGhcVersion "== 8.0.2"
   osx <- isOSX
   expectBrokenIf (osx && ghc) 8028 $ do

cabal-testsuite/PackageTests/TestNameCollision/setup.test.hs

@@ -3,7 +3,7 @@ import Test.Cabal.Prelude
 -- which is in the database, we can still use the test case (they
 -- should NOT shadow).
 main = setupAndCabalTest $ do
-    skipUnless "cabal for ghc" =<< hasCabalForGhc -- use of library test suite
+    skipIfAllCabalVersion "< 2.2"
     withPackageDb $ do
         withDirectory "parent" $ setup_install []
         withDirectory "child" $ do

cabal-testsuite/PackageTests/TestSuiteTests/LibV09/setup-deadlock.test.hs

 import Test.Cabal.Prelude
 main = setupAndCabalTest $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
+    skipIfAllCabalVersion "< 2.2"
     setup_build ["--enable-tests"]
     fails $ setup "test" []

cabal-testsuite/PackageTests/TestSuiteTests/LibV09/setup.test.hs

 import Test.Cabal.Prelude
 -- Test if detailed-0.9 builds correctly
 main = setupAndCabalTest $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
+    skipIfAllCabalVersion "< 1.20"
     setup_build ["--enable-tests"]

cabal-testsuite/README.md

@@ -28,6 +28,31 @@ There are a few useful flags:
 * `--keep-tmp-files` can be used to keep the temporary directories that tests
   are run in.
 
+## Which Cabal library version do cabal-install tests use?
+
+By default the `cabal-install` tests will use the `Cabal` library which comes with
+the boot compiler when it needs to build a custom `Setup.hs`.
+
+This can be very confusing if you are modifying the Cabal library, writing a test
+which relies on a custom setup script and you are wondering why the test is not
+responding at all to your changes.
+
+There are some flags which allow you to instruct `cabal-install` to use a different
+`Cabal` library version.
+
+1. `--boot-cabal-lib` specifies to use the Cabal library bundled with the
+   test compiler, this is the default.
+2. `--intree-cabal-lib=<root_dir>` specifies to use Cabal and Cabal-syntax
+   from a specific directory, and `--test-tmp` indicates where to put
+   the package database they are built into.
+3. `--specific-cabal-lib=<VERSION>` specifies to use a specific Cabal
+   version from hackage (ie 3.10.2.0) and installs the package database
+   into `--test-tmp=<DIR>`
+
+The CI scripts use the `--intree-cabal-lib` option for the most part but in
+the future there should be a variety of jobs which test `cabal-install` built
+against newer `Cabal` versions but forced to interact with older `Cabal` versions.
+
 ### How to run the doctests
 
 You need to install the `doctest` tool. Make sure it's compiled with your current
@@ -173,8 +198,7 @@ and stderr.
 **How do I skip running a test in some environments?**  Use the
 `skipIf` and `skipUnless` combinators.  Useful parameters to test
 these with include `hasSharedLibraries`, `hasProfiledLibraries`,
-`hasCabalShared`, `isGhcVersion`, `isWindows`, `isLinux`, `isOSX`
-and `hasCabalForGhc`.
+`hasCabalShared`, `isGhcVersion`, `isWindows`, `isLinux`, `isOSX`.
 
 **I programmatically modified a file in my test suite, but Cabal/GHC
 doesn't seem to be picking it up.**  You need to sleep sufficiently

cabal-testsuite/cabal-testsuite.cabal

@@ -104,6 +104,7 @@ executable cabal-tests
     , transformers
     -- dependencies specific to exe:cabal-tests
     , clock                 ^>= 0.7.2 || ^>=0.8
+    , directory
 
   build-tool-depends: cabal-testsuite:setup
   default-extensions: TypeOperators

cabal-testsuite/main/cabal-tests.hs

@@ -11,6 +11,7 @@ import Test.Cabal.TestCode
 
 import Distribution.Verbosity        (normal, verbose, Verbosity)
 import Distribution.Simple.Utils     (getDirectoryContentsRecursive)
+import Distribution.Simple.Program
 
 import Options.Applicative
 import Control.Concurrent.MVar
@@ -26,6 +27,9 @@ import System.IO
 import System.FilePath
 import System.Exit
 import System.Process (callProcess, showCommandForUser)
+import System.Directory
+import Distribution.Pretty
+import Data.Maybe
 
 #if !MIN_VERSION_base(4,12,0)
 import Data.Monoid ((<>))
@@ -71,9 +75,22 @@ data MainArgs = MainArgs {
         mainArgVerbose :: Bool,
         mainArgQuiet   :: Bool,
         mainArgDistDir :: Maybe FilePath,
+        mainArgCabalSpec :: Maybe CabalLibSpec,
         mainCommonArgs :: CommonArgs
     }
 
+data CabalLibSpec = BootCabalLib | InTreeCabalLib FilePath FilePath | SpecificCabalLib String FilePath
+
+cabalLibSpecParser :: Parser CabalLibSpec
+cabalLibSpecParser = bootParser <|> intreeParser <|> specificParser
+  where
+    bootParser = flag' BootCabalLib (long "boot-cabal-lib")
+    intreeParser = InTreeCabalLib <$> strOption (long "intree-cabal-lib" <> metavar "ROOT")
+                                  <*> option str ( help "Test TMP" <> long "test-tmp" )
+    specificParser = SpecificCabalLib <$> strOption (long "specific-cabal-lib" <> metavar "VERSION")
+                                      <*> option str ( help "Test TMP" <> long "test-tmp" )
+
+
 -- | optparse-applicative parser for 'MainArgs'
 mainArgParser :: Parser MainArgs
 mainArgParser = MainArgs
@@ -102,8 +119,52 @@ mainArgParser = MainArgs
         ( help "Dist directory we were built with"
        <> long "builddir"
        <> metavar "DIR"))
+    <*> optional cabalLibSpecParser
     <*> commonArgParser
 
+-- Unpack and build a specific released version of Cabal and Cabal-syntax libraries
+buildCabalLibsProject :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO FilePath
+buildCabalLibsProject projString verb mbGhc dir = do
+  let prog_db = userSpecifyPaths [("ghc", path) | Just path <- [mbGhc] ]  defaultProgramDb
+  (cabal, _) <- requireProgram verb (simpleProgram "cabal") prog_db
+  (ghc, _) <- requireProgram verb ghcProgram prog_db
+
+  let pv = fromMaybe (error "no ghc version") (programVersion ghc)
+  let final_package_db = dir </> "dist-newstyle" </> "packagedb" </> "ghc-" ++ prettyShow pv
+  createDirectoryIfMissing True dir
+  writeFile (dir </> "cabal.project-test") projString
+
+  runProgramInvocation verb
+    ((programInvocation cabal
+      ["--store-dir", dir </> "store"
+      , "--project-file=" ++ dir </> "cabal.project-test"
+      , "build"
+      , "-w", programPath ghc
+      , "Cabal", "Cabal-syntax"] ) { progInvokeCwd = Just dir })
+  return final_package_db
+
+
+buildCabalLibsSpecific :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO FilePath
+buildCabalLibsSpecific ver verb mbGhc builddir_rel = do
+  let prog_db = userSpecifyPaths [("ghc", path) | Just path <- [mbGhc] ]  defaultProgramDb
+  (cabal, _) <- requireProgram verb (simpleProgram "cabal") prog_db
+  dir <- canonicalizePath (builddir_rel </> "specific" </> ver)
+  cgot <- doesDirectoryExist (dir </> "Cabal-" ++ ver)
+  unless cgot $
+    runProgramInvocation verb ((programInvocation cabal ["get", "Cabal-" ++ ver]) { progInvokeCwd = Just dir })
+  csgot <- doesDirectoryExist (dir </> "Cabal-syntax-" ++ ver)
+  unless csgot $
+    runProgramInvocation verb ((programInvocation cabal ["get", "Cabal-syntax-" ++ ver]) { progInvokeCwd = Just dir })
+
+  buildCabalLibsProject ("packages: Cabal-" ++ ver ++ " Cabal-syntax-" ++ ver) verb mbGhc dir
+
+
+buildCabalLibsIntree :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO FilePath
+buildCabalLibsIntree root verb mbGhc builddir_rel = do
+  dir <- canonicalizePath (builddir_rel </> "intree")
+  buildCabalLibsProject ("packages: " ++ root </> "Cabal" ++ " " ++ root </> "Cabal-syntax") verb mbGhc dir
+
+
 main :: IO ()
 main = do
     -- By default, stderr is not buffered.  This isn't really necessary
@@ -115,6 +176,27 @@ main = do
     args <- execParser $ info (mainArgParser <**> helper) mempty
     let verbosity = if mainArgVerbose args then verbose else normal
 
+    mpkg_db <-
+      -- Not path to cabal-install so we're not going to run cabal-install tests so we
+      -- can skip setting up a Cabal library to use with cabal-install.
+      case argCabalInstallPath (mainCommonArgs args) of
+        Nothing -> do
+          when (isJust $ mainArgCabalSpec args)
+               (putStrLn "Ignoring Cabal library specification as cabal-install tests are not running")
+          return Nothing
+        -- Path to cabal-install is passed, so need to install the requested relevant version of Cabal
+        -- library.
+        Just {} ->
+          case mainArgCabalSpec args of
+            Nothing -> do
+              putStrLn "No Cabal library specified, using boot Cabal library with cabal-install tests"
+              return Nothing
+            Just BootCabalLib -> return Nothing
+            Just (InTreeCabalLib root build_dir) ->
+              Just <$> buildCabalLibsIntree root verbosity (argGhcPath (mainCommonArgs args)) build_dir
+            Just (SpecificCabalLib ver build_dir) ->
+              Just <$> buildCabalLibsSpecific ver verbosity (argGhcPath (mainCommonArgs args)) build_dir
+
     -- To run our test scripts, we need to be able to run Haskell code
     -- linked against the Cabal library under test.  The most efficient
     -- way to get this information is by querying the *host* build
@@ -140,7 +222,7 @@ main = do
                 -> IO result
         runTest runner path
             = runner Nothing [] path $
-                ["--builddir", dist_dir, path] ++ renderCommonArgs (mainCommonArgs args)
+                ["--builddir", dist_dir, path] ++ ["--extra-package-db=" ++ pkg_db | Just pkg_db <- [mpkg_db]] ++ renderCommonArgs (mainCommonArgs args)
 
     case mainArgTestPaths args of
         [path] -> do

cabal-testsuite/src/Test/Cabal/Monad.hs

@@ -157,6 +157,7 @@ renderCommonArgs args =
 
 data TestArgs = TestArgs {
         testArgDistDir    :: FilePath,
+        testArgPackageDb  :: Maybe FilePath,
         testArgScriptPath :: FilePath,
         testCommonArgs    :: CommonArgs
     }
@@ -167,6 +168,10 @@ testArgParser = TestArgs
         ( help "Build directory of cabal-testsuite"
        <> long "builddir"
        <> metavar "DIR")
+    <*> optional (option str
+        ( help "Package DB which contains Cabal and Cabal-syntax"
+       <> long "extra-package-db"
+       <> metavar "DIR"))
     <*> argument str ( metavar "FILE")
     <*> commonArgParser
 
@@ -321,6 +326,7 @@ runTestM mode m =
                     testMtimeChangeDelay = Nothing,
                     testScriptEnv = senv,
                     testSetupPath = dist_dir </> "build" </> "setup" </> "setup",
+                    testPackageDbPath = testArgPackageDb args,
                     testSkipSetupTests =  argSkipSetupTests (testCommonArgs args),
                     testHaveCabalShared = runnerWithSharedLib senv,
                     testEnvironment =
@@ -615,6 +621,9 @@ data TestEnv = TestEnv
     , testScriptEnv :: ScriptEnv
     -- | Setup script path
     , testSetupPath :: FilePath
+    -- | Setup package-db path which contains Cabal and Cabal-syntax for cabal-install to
+    -- use when compiling custom setups.
+    , testPackageDbPath :: Maybe FilePath
     -- | Skip Setup tests?
     , testSkipSetupTests :: Bool
     -- | Do we have shared libraries for the Cabal-under-tests?

cabal-testsuite/src/Test/Cabal/Prelude.hs

@@ -35,7 +35,7 @@ import Distribution.Simple.Utils
     ( withFileContents, tryFindPackageDesc )
 import Distribution.Version
 import Distribution.Package
-import Distribution.Parsec (eitherParsec)
+import Distribution.Parsec (eitherParsec, simpleParsec)
 import Distribution.Types.UnqualComponentName
 import Distribution.Types.LocalBuildInfo
 import Distribution.PackageDescription
@@ -318,6 +318,7 @@ cabalGArgs global_args cmd args input = do
           = [ "--builddir", testDistDir env
             , "-j1" ]
             ++ [ "--project-file=" ++ fp | Just fp <- [testCabalProjectFile env] ]
+            ++ ["--package-db=" ++ db | Just db <- [testPackageDbPath env]]
 
           | otherwise
           = [ "--builddir", testDistDir env ] ++
@@ -399,6 +400,12 @@ withPackageDb m = do
                $ do ghcPkg "init" [db_path]
                     m
 
+-- | Don't pass `--package-db` to cabal-install, so it won't find the specific version of
+-- `Cabal` which you have configured the testsuite to run with. You probably don't want to use
+-- this unless you are testing the `--package-db` flag itself.
+noCabalPackageDb :: TestM a -> TestM a
+noCabalPackageDb m = withReaderT (\nenv -> nenv { testPackageDbPath = Nothing }) m
+
 ghcPkg :: String -> [String] -> TestM ()
 ghcPkg cmd args = void (ghcPkg' cmd args)
 
@@ -840,6 +847,44 @@ hasCabalShared = do
   env <- getTestEnv
   return (testHaveCabalShared env)
 
+
+anyCabalVersion :: WithCallStack ( String -> TestM Bool )
+anyCabalVersion = isCabalVersion any
+
+allCabalVersion :: WithCallStack ( String -> TestM Bool )
+allCabalVersion = isCabalVersion all
+
+-- Used by cabal-install tests to determine which Cabal library versions are
+-- available. Given a version range, and a predicate on version ranges,
+-- are there any installed packages Cabal library
+-- versions which satisfy these.
+isCabalVersion :: WithCallStack (((Version -> Bool) -> [Version] -> Bool) -> String -> TestM Bool)
+isCabalVersion decide range = do
+  env <- getTestEnv
+  cabal_pkgs <- ghcPkg_raw' $ ["--global", "list", "Cabal", "--simple"] ++ ["--package-db=" ++ db | Just db <- [testPackageDbPath env]]
+  let pkg_versions :: [PackageIdentifier] = mapMaybe simpleParsec (words (resultOutput cabal_pkgs))
+  vr <- case eitherParsec range of
+          Left err -> fail err
+          Right vr -> return vr
+  return $ decide (`withinRange` vr)  (map pkgVersion pkg_versions)
+
+-- | Skip a test unless any available Cabal library version matches the predicate.
+skipUnlessAnyCabalVersion :: String -> TestM ()
+skipUnlessAnyCabalVersion range = skipUnless ("needs any Cabal " ++ range) =<< anyCabalVersion range
+
+
+-- | Skip a test if any available Cabal library version matches the predicate.
+skipIfAnyCabalVersion :: String -> TestM ()
+skipIfAnyCabalVersion range = skipIf ("incompatible with Cabal " ++ range) =<< anyCabalVersion range
+
+-- | Skip a test unless all Cabal library versions match the predicate.
+skipUnlessAllCabalVersion :: String -> TestM ()
+skipUnlessAllCabalVersion range = skipUnless ("needs all Cabal " ++ range) =<< allCabalVersion range
+
+-- | Skip a test if all the Cabal library version matches a predicate.
+skipIfAllCabalVersion :: String -> TestM ()
+skipIfAllCabalVersion range = skipIf ("incompatible with Cabal " ++ range) =<< allCabalVersion range
+
 isGhcVersion :: WithCallStack (String -> TestM Bool)
 isGhcVersion range = do
     ghc_program <- requireProgramM ghcProgram
@@ -894,24 +939,6 @@ getOpenFilesLimit = liftIO $ do
         _                                     -> return Nothing
 #endif
 
-hasCabalForGhc :: TestM Bool
-hasCabalForGhc = do
-    env <- getTestEnv
-    ghc_program <- requireProgramM ghcProgram
-    (runner_ghc_program, _) <- liftIO $ requireProgram
-        (testVerbosity env)
-        ghcProgram
-        (runnerProgramDb (testScriptEnv env))
-
-    -- TODO: I guess, to be more robust what we should check for
-    -- specifically is that the Cabal library we want to use
-    -- will be picked up by the package db stack of ghc-program
-
-    -- liftIO $ putStrLn $ "ghc_program:        " ++ show ghc_program
-    -- liftIO $ putStrLn $ "runner_ghc_program: " ++ show runner_ghc_program
-
-    return (programPath ghc_program == programPath runner_ghc_program)
-
 -- | If you want to use a Custom setup with new-build, it needs to
 -- be 1.20 or later.  Ordinarily, Cabal can go off and build a
 -- sufficiently recent Cabal if necessary, but in our test suite,
@@ -972,6 +999,12 @@ ghc' args = do
     recordHeader ["ghc"]
     runProgramM ghcProgram args Nothing
 
+ghcPkg_raw' :: [String] -> TestM Result
+ghcPkg_raw' args = do
+  recordHeader ["ghc-pkg"]
+  runProgramM ghcPkgProgram args Nothing
+
+
 python3 :: [String] -> TestM ()
 python3 args = void $ python3' args