Allow using different Cabal library versions for cabal-install tests with custom setup.

mpickering · mpickering · commit 93bd6bff4ea3 · 2024-02-01T17:42:06.000Z
The idea here is to pass a `--package-db` flag to `cabal-install` which contains just `Cabal` and `Cabal-syntax` of the specific version. This allows `cabal-install` tests to use the in-tree `Cabal` version, something which you can easily run into and get very confused about when writing tests. There are a few options which can be passed to `cabal-tests` executable to control which Cabal library you will test against. 1. --boot-cabal-lib specifies to use the Cabal library bundled with the test compiler, this is the default and existing behaviour of the testsuite. 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 with. 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 end result is that changes in the Cabal library can be tested with cabal-install tests in the testsuite. There have been a number of confusing issues with people writing tests for changes in the Cabal library which never ran because of cabal-install tests always used the boot Cabal library (see #9425 for one). Fixes #9681
diff --git a/cabal-testsuite/PackageTests/CustomDep/cabal.test.hs b/cabal-testsuite/PackageTests/CustomDep/cabal.test.hs
@@ -1,7 +1,5 @@
 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
diff --git a/cabal-testsuite/PackageTests/CustomPlain/setup.test.hs b/cabal-testsuite/PackageTests/CustomPlain/setup.test.hs
@@ -1,5 +1,4 @@
 import Test.Cabal.Prelude
 main = setupTest $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
     setup' "configure" [] >>= assertOutputContains "ThisIsCustomYeah"
     setup' "build"     [] >>= assertOutputContains "ThisIsCustomYeah"
diff --git a/cabal-testsuite/PackageTests/CustomPreProcess/cabal.test.hs b/cabal-testsuite/PackageTests/CustomPreProcess/cabal.test.hs
@@ -1,8 +1,6 @@
 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" []
diff --git a/cabal-testsuite/PackageTests/CustomPreProcess/setup.test.hs b/cabal-testsuite/PackageTests/CustomPreProcess/setup.test.hs
@@ -1,7 +1,6 @@
 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"
diff --git a/cabal-testsuite/PackageTests/CustomTestCoverage/setup.test.hs b/cabal-testsuite/PackageTests/CustomTestCoverage/setup.test.hs
@@ -1,7 +1,6 @@
 import Test.Cabal.Prelude
 main = setupTest $ do
   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"
diff --git a/cabal-testsuite/PackageTests/DuplicateModuleName/setup.test.hs b/cabal-testsuite/PackageTests/DuplicateModuleName/setup.test.hs
@@ -2,7 +2,6 @@ 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
     setup_build ["--enable-tests"]
     r1 <- fails $ setup' "test" ["foo"]
     assertOutputContains "test B" r1
diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out
@@ -1,11 +0,0 @@
-# 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)
diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.test.hs b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.test.hs
@@ -1,5 +1,7 @@
 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"] ""
+    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
diff --git a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-packagedbs.test.hs b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-packagedbs.test.hs
@@ -1,6 +1,6 @@
 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
diff --git a/cabal-testsuite/PackageTests/Regression/T4270/setup.test.hs b/cabal-testsuite/PackageTests/Regression/T4270/setup.test.hs
@@ -5,7 +5,6 @@ import Test.Cabal.Prelude
 main = setupAndCabalTest $ do
   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
diff --git a/cabal-testsuite/PackageTests/TestNameCollision/setup.test.hs b/cabal-testsuite/PackageTests/TestNameCollision/setup.test.hs
@@ -3,7 +3,6 @@ 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
     withPackageDb $ do
         withDirectory "parent" $ setup_install []
         withDirectory "child" $ do
diff --git a/cabal-testsuite/PackageTests/TestSuiteTests/LibV09/setup-deadlock.test.hs b/cabal-testsuite/PackageTests/TestSuiteTests/LibV09/setup-deadlock.test.hs
@@ -1,5 +1,4 @@
 import Test.Cabal.Prelude
 main = setupAndCabalTest $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
     setup_build ["--enable-tests"]
     fails $ setup "test" []
diff --git a/cabal-testsuite/PackageTests/TestSuiteTests/LibV09/setup.test.hs b/cabal-testsuite/PackageTests/TestSuiteTests/LibV09/setup.test.hs
@@ -1,5 +1,4 @@
 import Test.Cabal.Prelude
 -- Test if detailed-0.9 builds correctly
 main = setupAndCabalTest $ do
-    skipUnless "no Cabal for GHC" =<< hasCabalForGhc
     setup_build ["--enable-tests"]
diff --git a/cabal-testsuite/README.md b/cabal-testsuite/README.md
@@ -165,8 +165,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
diff --git a/cabal-testsuite/cabal-testsuite.cabal b/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
diff --git a/cabal-testsuite/main/cabal-tests.hs b/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
diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs
@@ -144,6 +144,7 @@ renderCommonArgs args =
 
 data TestArgs = TestArgs {
         testArgDistDir    :: FilePath,
+        testArgPackageDb  :: Maybe FilePath,
         testArgScriptPath :: FilePath,
         testCommonArgs    :: CommonArgs
     }
@@ -154,6 +155,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
 
@@ -303,6 +308,7 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do
                     testMtimeChangeDelay = Nothing,
                     testScriptEnv = senv,
                     testSetupPath = dist_dir </> "build" </> "setup" </> "setup",
+                    testPackageDbPath = testArgPackageDb args,
                     testSkipSetupTests =  argSkipSetupTests (testCommonArgs args),
                     testHaveCabalShared = runnerWithSharedLib senv,
                     testEnvironment =
@@ -484,6 +490,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?
diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs
@@ -35,7 +35,7 @@ import Distribution.Simple.Configure
     ( getPersistBuildConfig )
 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
@@ -321,6 +321,7 @@ cabalGArgs global_args cmd args input = do
           = [ "--builddir", testDistDir env
             , "--project-file", testCabalProjectFile env
             , "-j1" ]
+            ++ ["--package-db=" ++ db | Just db <- [testPackageDbPath env]]
 
           | otherwise
           = [ "--builddir", testDistDir env ] ++
@@ -402,6 +403,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)
 
@@ -888,6 +895,26 @@ hasCabalShared = do
   env <- getTestEnv
   return (testHaveCabalShared env)
 
+
+-- Used by cabal-install tests to determine which Cabal library versions are
+-- available. Given a version range, are there any installed packages Cabal library
+-- versions which satisfy this range.
+isCabalVersion :: WithCallStack (String -> TestM Bool)
+isCabalVersion 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 $ any (`withinRange` vr) (map pkgVersion pkg_versions)
+
+skipUnlessCabalVersion :: String -> TestM ()
+skipUnlessCabalVersion range = skipUnless ("needs Cabal " ++ range) =<< isCabalVersion range
+
+skipIfCabalVersion :: String -> TestM ()
+skipIfCabalVersion range = skipIf ("incompatible with Cabal " ++ range) =<< isCabalVersion range
+
 isGhcVersion :: WithCallStack (String -> TestM Bool)
 isGhcVersion range = do
     ghc_program <- requireProgramM ghcProgram
@@ -942,24 +969,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,
@@ -1021,6 +1030,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
 
diff --git a/validate.sh b/validate.sh
@@ -468,7 +468,7 @@ CMD="$($CABALLISTBIN cabal-install:test:integration-tests2) -j1 --hide-successes
 step_cli_suite() {
 print_header "cabal-install: cabal-testsuite"
 
-CMD="$($CABALLISTBIN cabal-testsuite:exe:cabal-tests) --builddir=$CABAL_TESTSUITE_BDIR --with-cabal=$($CABALLISTBIN cabal-install:exe:cabal) $TESTSUITEJOBS  --with-ghc=$HC --hide-successes"
+CMD="$($CABALLISTBIN cabal-testsuite:exe:cabal-tests) --builddir=$CABAL_TESTSUITE_BDIR --with-cabal=$($CABALLISTBIN cabal-install:exe:cabal) $TESTSUITEJOBS  --with-ghc=$HC --hide-successes --intree-cabal-lib=$PWD --test-tmp=$PWD/testdb"
 (cd cabal-testsuite && timed $CMD) || exit 1
 }
 
