|
| 1 | +import Test.Cabal.Prelude |
| 2 | + |
| 3 | +-- Build and install a package dynamically only, then build and install a |
| 4 | +-- package statically that depends on that dynamic package. Old cabals are |
| 5 | +-- tempted to consider both the source package and the installed package |
| 6 | +-- (IPI) option with dynamic-only flags as valid, so they normally construct a |
| 7 | +-- build plan with this IPI option that results in a build error like the |
| 8 | +-- following: |
| 9 | +-- > [1 of 1] Compiling Main ( Main.hs, ../setup.dist/work/depender/dist/build/depender/depender-tmp/Main.o ) |
| 10 | +-- > |
| 11 | +-- > Main.hs:3:1: error: |
| 12 | +-- > Could not find module `Dynamic' |
| 13 | +-- > There are files missing in the `dynamic-1.0' package, |
| 14 | +-- > try running 'ghc-pkg check'. |
| 15 | +-- > Use -v (or `:set -v` in ghci) to see a list of the files searched for. |
| 16 | +-- > | |
| 17 | +-- > | import qualified Dynamic (number) |
| 18 | +-- > | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
| 19 | +-- |
| 20 | +-- However, with ‘--require-artifacts’ rather than ‘--no-require-artifacts’, |
| 21 | +-- cabal will detect this error in advance and reject this particular IPI, |
| 22 | +-- leaving only building the source package as the only valid package option |
| 23 | +-- (I) we can choose as an assignment for the QPN (and any other valid IPIs if |
| 24 | +-- there were multiple pre-installed packages to choose from, including those |
| 25 | +-- with configure flags that work for us). |
| 26 | + |
| 27 | +import Data.Maybe (fromMaybe) -- for ghcPkg1' |
| 28 | +import Data.Version |
| 29 | +import System.Directory |
| 30 | +import System.FilePath |
| 31 | + |
| 32 | +main = do |
| 33 | + cabalTest $ do |
| 34 | + withPackageDb $ do |
| 35 | + -- If ghc-pkg is too old, cabal-install still works but has the |
| 36 | + -- same bug which we fixed, and our test would fail. Skip. |
| 37 | + skipIfOldGhcPkg |
| 38 | + |
| 39 | + -- Build a package with only dynamic build artifacts. |
| 40 | + sdistRepoDir <- (</> "dynamic-sdist-repo") . testWorkDir <$> getTestEnv |
| 41 | + installDynamic sdistRepoDir |
| 42 | + |
| 43 | + -- TODO: Before building a package that depends on this, just |
| 44 | + -- double check that we actually have an IPI in the same packageDB |
| 45 | + -- that will be used so that cabal-install will see it and be tempted. |
| 46 | + |
| 47 | + -- Build a package that requires static build artifacts. Old |
| 48 | + -- cabal-installs don't bother to check static and dynamic |
| 49 | + -- configuration, so it'll probably produce a build plan that'll |
| 50 | + -- fail as we described above. With the build artifact checker, |
| 51 | + -- our pre-installed IPI option we made earlier is detected to not |
| 52 | + -- be a valid option in advance, so rather than producing a build |
| 53 | + -- plan we know will fail, instead reject this particular option, |
| 54 | + -- so that the moduler resolver cabal-install uses only picks the |
| 55 | + -- only valid option left, which is to build from source. (For our |
| 56 | + -- test to work, we need the depender build to be aware of both the |
| 57 | + -- pre-installed option and also the source package so that it can |
| 58 | + -- rebuild from source with the correct flags, so that the |
| 59 | + -- bug/enhancement scenario can be reproduced.) |
| 60 | + installDepender sdistRepoDir |
| 61 | + |
| 62 | +-- Run ‘ghc-pkg field base pkg-vanilla-lib’ to test whether the ghc-pkg |
| 63 | +-- we are using is new enough to support the 5 new IPI fields in the ‘.conf’ |
| 64 | +-- files. If ghc-pkg is too old, then its Cabal-syntax dependency |
| 65 | +-- (cabal-install also uses Cabal-syntax for the IPI fields) will emit an |
| 66 | +-- ‘Unknown field’ warning if cabal-install tries to update or register an IPI |
| 67 | +-- with new fields, but it should otherwise work besides having full |
| 68 | +-- functionality of the artifact checker. |
| 69 | +skipIfOldGhcPkg :: TestM () |
| 70 | +skipIfOldGhcPkg = do |
| 71 | + control <- resultExitCode <$> ghcPkg1' "field" ["*", "id"] |
| 72 | + hasArts <- resultExitCode <$> ghcPkg1' "field" ["*", "pkg-vanilla-lib"] |
| 73 | + |
| 74 | + -- cabal-install will still work without these 5 build artifact fields, |
| 75 | + -- except the artifact checker wouldn't detect missing artifacts |
| 76 | + -- without knowing what artifacts installed packages provide. |
| 77 | + skipIf "ghc-pkg too old for 5 arts fields" $ hasArts /= control |
| 78 | + |
| 79 | +-- ghcPkg' that can return non-zero. |
| 80 | +-- |
| 81 | +-- It's basically a copy except without ‘requireSuccess’. |
| 82 | +ghcPkg1' :: String -> [String] -> TestM Result |
| 83 | +ghcPkg1' cmd args = do |
| 84 | + env <- getTestEnv |
| 85 | + unless (testHavePackageDb env) $ |
| 86 | + error "Must initialize package database using withPackageDb" |
| 87 | + -- NB: testDBStack already has the local database |
| 88 | + ghcConfProg <- requireProgramM ghcProgram |
| 89 | + let db_stack = testPackageDBStack env |
| 90 | + extraArgs = ghcPkgPackageDBParams |
| 91 | + (fromMaybe |
| 92 | + (error "ghc-pkg: cannot detect version") |
| 93 | + (programVersion ghcConfProg)) |
| 94 | + db_stack |
| 95 | + recordHeader ["ghc-pkg", cmd] |
| 96 | + runProgram1M ghcPkgProgram (cmd : extraArgs ++ args) Nothing |
| 97 | + where |
| 98 | + runProgram1M :: Program -> [String] -> Maybe String -> TestM Result |
| 99 | + runProgram1M prog args input = do |
| 100 | + configured_prog <- requireProgramM prog |
| 101 | + -- TODO: Consider also using other information from |
| 102 | + -- ConfiguredProgram, e.g., env and args |
| 103 | + run1M (programPath configured_prog) args input |
| 104 | + |
| 105 | + run1M :: FilePath -> [String] -> Maybe String -> TestM Result |
| 106 | + run1M path args input = do |
| 107 | + env <- getTestEnv |
| 108 | + r <- liftIO $ run (testVerbosity env) |
| 109 | + (Just (testCurrentDir env)) |
| 110 | + (testEnvironment env) |
| 111 | + path |
| 112 | + args |
| 113 | + input |
| 114 | + recordLog r |
| 115 | + return r |
| 116 | + |
| 117 | +-- Flags. |
| 118 | +-- (Swap the line comments to trigger the bug the artifect checker validation |
| 119 | +-- step fixes - the ‘missing files’ error.) |
| 120 | +--commonArgs = ["--disable-backup", "--no-require-artifacts"] |
| 121 | +commonArgs = ["--disable-backup"] |
| 122 | +dynamicArgs = |
| 123 | + [ |
| 124 | + "--enable-shared", |
| 125 | + "--enable-executable-dynamic", |
| 126 | + "--disable-library-vanilla", |
| 127 | + "--disable-static", |
| 128 | + "--disable-executable-static" |
| 129 | + ] |
| 130 | +staticArgs = |
| 131 | + [ |
| 132 | + "--enable-static" |
| 133 | + ] |
| 134 | + |
| 135 | +-- Build a package with only dynamic build artifacts. |
| 136 | +installDynamic :: FilePath -> TestM () |
| 137 | +installDynamic sdistRepoDir = do |
| 138 | + withDirectory "dynamic" $ do |
| 139 | + withSourceCopyDir ("dyn") $ do |
| 140 | + cwd <- fmap testSourceCopyDir getTestEnv |
| 141 | + -- (Now do ‘cd ..’, since withSourceCopyDir made our previous |
| 142 | + -- previous such withDirectories now accumulate to be |
| 143 | + -- relative to cabal.dist/dyn, not testSourceDir |
| 144 | + -- (see 'testCurrentDir').) |
| 145 | + withDirectory ".." $ do |
| 146 | + -- Our project still resides in ‘dynamic/’. |
| 147 | + withDirectory "dynamic" $ do |
| 148 | + cabal "v2-configure" $ [] ++ commonArgs ++ dynamicArgs |
| 149 | + cabal "v2-build" $ [] |
| 150 | + recordMode DoNotRecord $ do |
| 151 | + cabal "v2-install" $ ["--lib"] ++ commonArgs ++ dynamicArgs |
| 152 | + tmpBuildDir <- (</> "dynamic-sdist-build") . testWorkDir <$> getTestEnv |
| 153 | + cabal "v2-sdist" $ ["-o", sdistRepoDir, "--builddir", tmpBuildDir] |
| 154 | + |
| 155 | +-- Build a package that requires static build artifacts. (The same packageDB |
| 156 | +-- is shared.) |
| 157 | +installDepender :: FilePath -> TestM () |
| 158 | +installDepender sdistRepoDir = do |
| 159 | + withDirectory "depender" $ do |
| 160 | + withSourceCopyDir ("depr") $ do |
| 161 | + cwd <- fmap testSourceCopyDir getTestEnv |
| 162 | + -- (As before.) |
| 163 | + withDirectory ".." $ do |
| 164 | + withDirectory "depender" $ do |
| 165 | + -- depender knows of the source package and the installed package. |
| 166 | + -- The installed package should only have dynamic files (.dyn_hi, |
| 167 | + -- .so), but not any static files (.a, .hi). New ghc-pkg IPI file |
| 168 | + -- fields track these, so with a new GHC, a new cabal-install |
| 169 | + -- should reject the installed package while building the tree |
| 170 | + -- (reason: missing build artifacts) and instead choose the sdist |
| 171 | + -- (source package) so that it can figure out its own configuration |
| 172 | + -- flags. |
| 173 | + -- |
| 174 | + -- (For instance, if you comment out the sdist references so that we |
| 175 | + -- only see the installed package, you should see an error message |
| 176 | + -- like this (e.g. remove those two ‘-- ’ strings to write out only |
| 177 | + -- a ‘packages: ./../dep…’ line):) |
| 178 | + -- > Error: cabal: Could not resolve dependencies: |
| 179 | + -- > [__0] trying: depender-1.0 (user goal) |
| 180 | + -- > [__1] next goal: dynamic (dependency of depender) |
| 181 | + -- > [__1] rejecting: dynamic-1.0/installed-19c7c1e50b8f1e56115c4f668dfdadd7114fc2c7dad267c2df43028892cc0ff5 (missing build artifacts: static artifacts) |
| 182 | + -- > [__1] fail (backjumping, conflict set: depender, dynamic) |
| 183 | + -- > After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: depender (3), dynamic (2) |
| 184 | + |
| 185 | + -- Setup the project file. |
| 186 | + -- > sed -nEe 's/\{SDIST\}/…path…to…sdist…dir…/g; p' < cabal.project.in > cabal.project |
| 187 | + writeSourceFile "cabal.project" . unlines $ |
| 188 | + [ |
| 189 | + "packages: ./../depender/*.cabal", |
| 190 | + -- "" {- |
| 191 | + "", |
| 192 | + "repository my-local-repository", |
| 193 | + " url: file+noindex://" ++ sdistRepoDir ++ "#shared-cache" |
| 194 | + -- -} |
| 195 | + ] |
| 196 | + |
| 197 | + -- Make sure our test scenario setup lets the depender see |
| 198 | + -- the pre-installed dynamic package IPI we built. |
| 199 | + guessedPackageDbPath <- do |
| 200 | + recordMode DoNotRecord $ do |
| 201 | + guessPackageDbPathDepender |
| 202 | + let sharedPackageDbFlags = ["--package-db=" ++ guessedPackageDbPath] |
| 203 | + |
| 204 | + -- Use 'staticArgs' here. |
| 205 | + cabal "v2-configure" $ [] ++ commonArgs ++ staticArgs ++ sharedPackageDbFlags |
| 206 | + recordMode DoNotRecord $ do |
| 207 | + cabal "v2-build" $ [] ++ sharedPackageDbFlags |
| 208 | + |
| 209 | + -- Optional: check the output. |
| 210 | + recordMode DoNotRecord $ do |
| 211 | + cabal "v2-install" $ [] ++ commonArgs ++ staticArgs |
| 212 | + withPlan $ do |
| 213 | + runPlanExe' "depender" "depender" [] |
| 214 | + >>= assertOutputContains "Dynamic's number is 3." |
| 215 | + |
| 216 | +guessPackageDbPathDepender :: TestM FilePath |
| 217 | +guessPackageDbPathDepender = do |
| 218 | + env <- getTestEnv |
| 219 | + hasGhc <- isAvailableProgram ghcProgram |
| 220 | + skipUnless "failed to guess package-db: couldn't find ghc" hasGhc |
| 221 | + tryProgramVersion <- programVersion <$> requireProgramM ghcProgram |
| 222 | + let convertVersion = makeVersion . versionNumbers |
| 223 | + programVersion <- maybe (skip "failed to guess package-db: unknown ghc version" >> return "") return $ showVersion . convertVersion <$> tryProgramVersion |
| 224 | + path <- liftIO . canonicalizePath $ testCabalDir env </> "store" </> "ghc-" ++ programVersion </> "package.db" |
| 225 | + exists <- liftIO $ doesPathExist path |
| 226 | + skipUnless ("failed to guess package-db: guessed dir path does not exist: " ++ path) exists |
| 227 | + return path |
0 commit comments