1{-# LANGUAGE OverloadedStrings #-} 2-- | This is a set of unit tests for the dependency solver, 3-- which uses the solver DSL ("UnitTests.Distribution.Solver.Modular.DSL") 4-- to more conveniently create package databases to run the solver tests on. 5module UnitTests.Distribution.Solver.Modular.Solver (tests) 6 where 7 8-- base 9import Data.List (isInfixOf) 10 11import qualified Distribution.Version as V 12 13-- test-framework 14import Test.Tasty as TF 15 16-- Cabal 17import Language.Haskell.Extension ( Extension(..) 18 , KnownExtension(..), Language(..)) 19 20-- cabal-install 21import Distribution.Solver.Types.Flag 22import Distribution.Solver.Types.OptionalStanza 23import Distribution.Solver.Types.PackageConstraint 24import qualified Distribution.Solver.Types.PackagePath as P 25import UnitTests.Distribution.Solver.Modular.DSL 26import UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils 27 28tests :: [TF.TestTree] 29tests = [ 30 testGroup "Simple dependencies" [ 31 runTest $ mkTest db1 "alreadyInstalled" ["A"] (solverSuccess []) 32 , runTest $ mkTest db1 "installLatest" ["B"] (solverSuccess [("B", 2)]) 33 , runTest $ mkTest db1 "simpleDep1" ["C"] (solverSuccess [("B", 1), ("C", 1)]) 34 , runTest $ mkTest db1 "simpleDep2" ["D"] (solverSuccess [("B", 2), ("D", 1)]) 35 , runTest $ mkTest db1 "failTwoVersions" ["C", "D"] anySolverFailure 36 , runTest $ indep $ mkTest db1 "indepTwoVersions" ["C", "D"] (solverSuccess [("B", 1), ("B", 2), ("C", 1), ("D", 1)]) 37 , runTest $ indep $ mkTest db1 "aliasWhenPossible1" ["C", "E"] (solverSuccess [("B", 1), ("C", 1), ("E", 1)]) 38 , runTest $ indep $ mkTest db1 "aliasWhenPossible2" ["D", "E"] (solverSuccess [("B", 2), ("D", 1), ("E", 1)]) 39 , runTest $ indep $ mkTest db2 "aliasWhenPossible3" ["C", "D"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("C", 1), ("D", 1)]) 40 , runTest $ mkTest db1 "buildDepAgainstOld" ["F"] (solverSuccess [("B", 1), ("E", 1), ("F", 1)]) 41 , runTest $ mkTest db1 "buildDepAgainstNew" ["G"] (solverSuccess [("B", 2), ("E", 1), ("G", 1)]) 42 , runTest $ indep $ mkTest db1 "multipleInstances" ["F", "G"] anySolverFailure 43 , runTest $ mkTest db21 "unknownPackage1" ["A"] (solverSuccess [("A", 1), ("B", 1)]) 44 , runTest $ mkTest db22 "unknownPackage2" ["A"] (solverFailure (isInfixOf "unknown package: C")) 45 , runTest $ mkTest db23 "unknownPackage3" ["A"] (solverFailure (isInfixOf "unknown package: B")) 46 , runTest $ mkTest [] "unknown target" ["A"] (solverFailure (isInfixOf "unknown package: A")) 47 ] 48 , testGroup "Flagged dependencies" [ 49 runTest $ mkTest db3 "forceFlagOn" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) 50 , runTest $ mkTest db3 "forceFlagOff" ["D"] (solverSuccess [("A", 2), ("B", 1), ("D", 1)]) 51 , runTest $ indep $ mkTest db3 "linkFlags1" ["C", "D"] anySolverFailure 52 , runTest $ indep $ mkTest db4 "linkFlags2" ["C", "D"] anySolverFailure 53 , runTest $ indep $ mkTest db18 "linkFlags3" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("F", 1)]) 54 ] 55 , testGroup "Lifting dependencies out of conditionals" [ 56 runTest $ commonDependencyLogMessage "common dependency log message" 57 , runTest $ twoLevelDeepCommonDependencyLogMessage "two level deep common dependency log message" 58 , runTest $ testBackjumpingWithCommonDependency "backjumping with common dependency" 59 ] 60 , testGroup "Manual flags" [ 61 runTest $ mkTest dbManualFlags "Use default value for manual flag" ["pkg"] $ 62 solverSuccess [("pkg", 1), ("true-dep", 1)] 63 64 , let checkFullLog = 65 any $ isInfixOf "rejecting: pkg:-flag (manual flag can only be changed explicitly)" 66 in runTest $ setVerbose $ 67 constraints [ExVersionConstraint (ScopeAnyQualifier "true-dep") V.noVersion] $ 68 mkTest dbManualFlags "Don't toggle manual flag to avoid conflict" ["pkg"] $ 69 -- TODO: We should check the summarized log instead of the full log 70 -- for the manual flags error message, but it currently only 71 -- appears in the full log. 72 SolverResult checkFullLog (Left $ const True) 73 74 , let cs = [ExFlagConstraint (ScopeAnyQualifier "pkg") "flag" False] 75 in runTest $ constraints cs $ 76 mkTest dbManualFlags "Toggle manual flag with flag constraint" ["pkg"] $ 77 solverSuccess [("false-dep", 1), ("pkg", 1)] 78 ] 79 , testGroup "Qualified manual flag constraints" [ 80 let name = "Top-level flag constraint does not constrain setup dep's flag" 81 cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False] 82 in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $ 83 solverSuccess [ ("A", 1), ("B", 1), ("B", 2) 84 , ("b-1-false-dep", 1), ("b-2-true-dep", 1) ] 85 86 , let name = "Solver can toggle setup dep's flag to match top-level constraint" 87 cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False 88 , ExVersionConstraint (ScopeAnyQualifier "b-2-true-dep") V.noVersion ] 89 in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $ 90 solverSuccess [ ("A", 1), ("B", 1), ("B", 2) 91 , ("b-1-false-dep", 1), ("b-2-false-dep", 1) ] 92 93 , let name = "User can constrain flags separately with qualified constraints" 94 cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" True 95 , ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False ] 96 in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $ 97 solverSuccess [ ("A", 1), ("B", 1), ("B", 2) 98 , ("b-1-true-dep", 1), ("b-2-false-dep", 1) ] 99 100 -- Regression test for #4299 101 , let name = "Solver can link deps when only one has constrained manual flag" 102 cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False] 103 in runTest $ constraints cs $ mkTest dbLinkedSetupDepWithManualFlag name ["A"] $ 104 solverSuccess [ ("A", 1), ("B", 1), ("b-1-false-dep", 1) ] 105 106 , let name = "Solver cannot link deps that have conflicting manual flag constraints" 107 cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" True 108 , ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False ] 109 failureReason = "(constraint from unknown source requires opposite flag selection)" 110 checkFullLog lns = 111 all (\msg -> any (msg `isInfixOf`) lns) 112 [ "rejecting: B:-flag " ++ failureReason 113 , "rejecting: A:setup.B:+flag " ++ failureReason ] 114 in runTest $ constraints cs $ setVerbose $ 115 mkTest dbLinkedSetupDepWithManualFlag name ["A"] $ 116 SolverResult checkFullLog (Left $ const True) 117 ] 118 , testGroup "Stanzas" [ 119 runTest $ enableAllTests $ mkTest db5 "simpleTest1" ["C"] (solverSuccess [("A", 2), ("C", 1)]) 120 , runTest $ enableAllTests $ mkTest db5 "simpleTest2" ["D"] anySolverFailure 121 , runTest $ enableAllTests $ mkTest db5 "simpleTest3" ["E"] (solverSuccess [("A", 1), ("E", 1)]) 122 , runTest $ enableAllTests $ mkTest db5 "simpleTest4" ["F"] anySolverFailure -- TODO 123 , runTest $ enableAllTests $ mkTest db5 "simpleTest5" ["G"] (solverSuccess [("A", 2), ("G", 1)]) 124 , runTest $ enableAllTests $ mkTest db5 "simpleTest6" ["E", "G"] anySolverFailure 125 , runTest $ indep $ enableAllTests $ mkTest db5 "simpleTest7" ["E", "G"] (solverSuccess [("A", 1), ("A", 2), ("E", 1), ("G", 1)]) 126 , runTest $ enableAllTests $ mkTest db6 "depsWithTests1" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) 127 , runTest $ indep $ enableAllTests $ mkTest db6 "depsWithTests2" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)]) 128 , runTest $ testTestSuiteWithFlag "test suite with flag" 129 ] 130 , testGroup "Setup dependencies" [ 131 runTest $ mkTest db7 "setupDeps1" ["B"] (solverSuccess [("A", 2), ("B", 1)]) 132 , runTest $ mkTest db7 "setupDeps2" ["C"] (solverSuccess [("A", 2), ("C", 1)]) 133 , runTest $ mkTest db7 "setupDeps3" ["D"] (solverSuccess [("A", 1), ("D", 1)]) 134 , runTest $ mkTest db7 "setupDeps4" ["E"] (solverSuccess [("A", 1), ("A", 2), ("E", 1)]) 135 , runTest $ mkTest db7 "setupDeps5" ["F"] (solverSuccess [("A", 1), ("A", 2), ("F", 1)]) 136 , runTest $ mkTest db8 "setupDeps6" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)]) 137 , runTest $ mkTest db9 "setupDeps7" ["F", "G"] (solverSuccess [("A", 1), ("B", 1), ("B",2 ), ("C", 1), ("D", 1), ("E", 1), ("E", 2), ("F", 1), ("G", 1)]) 138 , runTest $ mkTest db10 "setupDeps8" ["C"] (solverSuccess [("C", 1)]) 139 , runTest $ indep $ mkTest dbSetupDeps "setupDeps9" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)]) 140 ] 141 , testGroup "Base shim" [ 142 runTest $ mkTest db11 "baseShim1" ["A"] (solverSuccess [("A", 1)]) 143 , runTest $ mkTest db12 "baseShim2" ["A"] (solverSuccess [("A", 1)]) 144 , runTest $ mkTest db12 "baseShim3" ["B"] (solverSuccess [("B", 1)]) 145 , runTest $ mkTest db12 "baseShim4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) 146 , runTest $ mkTest db12 "baseShim5" ["D"] anySolverFailure 147 , runTest $ mkTest db12 "baseShim6" ["E"] (solverSuccess [("E", 1), ("syb", 2)]) 148 ] 149 , testGroup "Base" [ 150 runTest $ mkTest dbBase "Refuse to install base without --allow-boot-library-installs" ["base"] $ 151 solverFailure (isInfixOf "only already installed instances can be used") 152 , runTest $ allowBootLibInstalls $ mkTest dbBase "Install base with --allow-boot-library-installs" ["base"] $ 153 solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)] 154 ] 155 , testGroup "reject-unconstrained" [ 156 runTest $ onlyConstrained $ mkTest db12 "missing syb" ["E"] $ 157 solverFailure (isInfixOf "not a user-provided goal") 158 , runTest $ onlyConstrained $ mkTest db12 "all goals" ["E", "syb"] $ 159 solverSuccess [("E", 1), ("syb", 2)] 160 , runTest $ onlyConstrained $ mkTest db17 "backtracking" ["A", "B"] $ 161 solverSuccess [("A", 2), ("B", 1)] 162 , runTest $ onlyConstrained $ mkTest db17 "failure message" ["A"] $ 163 solverFailure $ isInfixOf $ 164 "Could not resolve dependencies:\n" 165 ++ "[__0] trying: A-3.0.0 (user goal)\n" 166 ++ "[__1] next goal: C (dependency of A)\n" 167 ++ "[__1] fail (not a user-provided goal nor mentioned as a constraint, " 168 ++ "but reject-unconstrained-dependencies was set)\n" 169 ++ "[__1] fail (backjumping, conflict set: A, C)\n" 170 ++ "After searching the rest of the dependency tree exhaustively, " 171 ++ "these were the goals I've had most trouble fulfilling: A, C, B" 172 ] 173 , testGroup "Cycles" [ 174 runTest $ mkTest db14 "simpleCycle1" ["A"] anySolverFailure 175 , runTest $ mkTest db14 "simpleCycle2" ["A", "B"] anySolverFailure 176 , runTest $ mkTest db14 "cycleWithFlagChoice1" ["C"] (solverSuccess [("C", 1), ("E", 1)]) 177 , runTest $ mkTest db15 "cycleThroughSetupDep1" ["A"] anySolverFailure 178 , runTest $ mkTest db15 "cycleThroughSetupDep2" ["B"] anySolverFailure 179 , runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"] (solverSuccess [("C", 2), ("D", 1)]) 180 , runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"] (solverSuccess [("D", 1)]) 181 , runTest $ mkTest db15 "cycleThroughSetupDep5" ["E"] (solverSuccess [("C", 2), ("D", 1), ("E", 1)]) 182 , runTest $ issue4161 "detect cycle between package and its setup script" 183 , runTest $ testCyclicDependencyErrorMessages "cyclic dependency error messages" 184 ] 185 , testGroup "Extensions" [ 186 runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupported" ["A"] anySolverFailure 187 , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupportedIndirect" ["B"] anySolverFailure 188 , runTest $ mkTestExts [EnableExtension RankNTypes] dbExts1 "supported" ["A"] (solverSuccess [("A",1)]) 189 , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedIndirect" ["C"] (solverSuccess [("A",1),("B",1), ("C",1)]) 190 , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "disabledExtension" ["D"] anySolverFailure 191 , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "disabledExtension" ["D"] anySolverFailure 192 , runTest $ mkTestExts (UnknownExtension "custom" : map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedUnknown" ["E"] (solverSuccess [("A",1),("B",1),("C",1),("E",1)]) 193 ] 194 , testGroup "Languages" [ 195 runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupported" ["A"] anySolverFailure 196 , runTest $ mkTestLangs [Haskell98,Haskell2010] dbLangs1 "supported" ["A"] (solverSuccess [("A",1)]) 197 , runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupportedIndirect" ["B"] anySolverFailure 198 , runTest $ mkTestLangs [Haskell98, Haskell2010, UnknownLanguage "Haskell3000"] dbLangs1 "supportedUnknown" ["C"] (solverSuccess [("A",1),("B",1),("C",1)]) 199 ] 200 , testGroup "Qualified Package Constraints" [ 201 runTest $ mkTest dbConstraints "install latest versions without constraints" ["A", "B", "C"] $ 202 solverSuccess [("A", 7), ("B", 8), ("C", 9), ("D", 7), ("D", 8), ("D", 9)] 203 204 , let cs = [ ExVersionConstraint (ScopeAnyQualifier "D") $ mkVersionRange 1 4 ] 205 in runTest $ constraints cs $ 206 mkTest dbConstraints "force older versions with unqualified constraint" ["A", "B", "C"] $ 207 solverSuccess [("A", 1), ("B", 2), ("C", 3), ("D", 1), ("D", 2), ("D", 3)] 208 209 , let cs = [ ExVersionConstraint (ScopeQualified P.QualToplevel "D") $ mkVersionRange 1 4 210 , ExVersionConstraint (ScopeQualified (P.QualSetup "B") "D") $ mkVersionRange 4 7 211 ] 212 in runTest $ constraints cs $ 213 mkTest dbConstraints "force multiple versions with qualified constraints" ["A", "B", "C"] $ 214 solverSuccess [("A", 1), ("B", 5), ("C", 9), ("D", 1), ("D", 5), ("D", 9)] 215 216 , let cs = [ ExVersionConstraint (ScopeAnySetupQualifier "D") $ mkVersionRange 1 4 ] 217 in runTest $ constraints cs $ 218 mkTest dbConstraints "constrain package across setup scripts" ["A", "B", "C"] $ 219 solverSuccess [("A", 7), ("B", 2), ("C", 3), ("D", 2), ("D", 3), ("D", 7)] 220 ] 221 , testGroup "Package Preferences" [ 222 runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1] $ mkTest db13 "selectPreferredVersionSimple" ["A"] (solverSuccess [("A", 1)]) 223 , runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionSimple2" ["A"] (solverSuccess [("A", 2)]) 224 , runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2 225 , ExPkgPref "A" $ mkvrOrEarlier 1] $ mkTest db13 "selectPreferredVersionMultiple" ["A"] (solverSuccess [("A", 1)]) 226 , runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 1 227 , ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple2" ["A"] (solverSuccess [("A", 1)]) 228 , runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1 229 , ExPkgPref "A" $ mkvrThis 2] $ mkTest db13 "selectPreferredVersionMultiple3" ["A"] (solverSuccess [("A", 2)]) 230 , runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1 231 , ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple4" ["A"] (solverSuccess [("A", 1)]) 232 ] 233 , testGroup "Stanza Preferences" [ 234 runTest $ 235 mkTest dbStanzaPreferences1 "disable tests by default" ["pkg"] $ 236 solverSuccess [("pkg", 1)] 237 238 , runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $ 239 mkTest dbStanzaPreferences1 "enable tests with testing preference" ["pkg"] $ 240 solverSuccess [("pkg", 1), ("test-dep", 1)] 241 242 , runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $ 243 mkTest dbStanzaPreferences2 "disable testing when it's not possible" ["pkg"] $ 244 solverSuccess [("pkg", 1)] 245 246 , testStanzaPreference "test stanza preference" 247 ] 248 , testGroup "Buildable Field" [ 249 testBuildable "avoid building component with unknown dependency" (ExAny "unknown") 250 , testBuildable "avoid building component with unknown extension" (ExExt (UnknownExtension "unknown")) 251 , testBuildable "avoid building component with unknown language" (ExLang (UnknownLanguage "unknown")) 252 , runTest $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (solverSuccess [("flag1-false", 1), ("flag2-true", 1), ("pkg", 1)]) 253 , runTest $ mkTest dbBuildable2 "choose version that sets buildable to false" ["A"] (solverSuccess [("A", 1), ("B", 2)]) 254 ] 255 , testGroup "Pkg-config dependencies" [ 256 runTest $ mkTestPCDepends [] dbPC1 "noPkgs" ["A"] anySolverFailure 257 , runTest $ mkTestPCDepends [("pkgA", "0")] dbPC1 "tooOld" ["A"] anySolverFailure 258 , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "1.0.0")] dbPC1 "pruneNotFound" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) 259 , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "2.0.0")] dbPC1 "chooseNewest" ["C"] (solverSuccess [("A", 1), ("B", 2), ("C", 1)]) 260 ] 261 , testGroup "Independent goals" [ 262 runTest $ indep $ mkTest db16 "indepGoals1" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("E", 1)]) 263 , runTest $ testIndepGoals2 "indepGoals2" 264 , runTest $ testIndepGoals3 "indepGoals3" 265 , runTest $ testIndepGoals4 "indepGoals4" 266 , runTest $ testIndepGoals5 "indepGoals5 - fixed goal order" FixedGoalOrder 267 , runTest $ testIndepGoals5 "indepGoals5 - default goal order" DefaultGoalOrder 268 , runTest $ testIndepGoals6 "indepGoals6 - fixed goal order" FixedGoalOrder 269 , runTest $ testIndepGoals6 "indepGoals6 - default goal order" DefaultGoalOrder 270 ] 271 -- Tests designed for the backjumping blog post 272 , testGroup "Backjumping" [ 273 runTest $ mkTest dbBJ1a "bj1a" ["A"] (solverSuccess [("A", 1), ("B", 1)]) 274 , runTest $ mkTest dbBJ1b "bj1b" ["A"] (solverSuccess [("A", 1), ("B", 1)]) 275 , runTest $ mkTest dbBJ1c "bj1c" ["A"] (solverSuccess [("A", 1), ("B", 1)]) 276 , runTest $ mkTest dbBJ2 "bj2" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) 277 , runTest $ mkTest dbBJ3 "bj3" ["A"] (solverSuccess [("A", 1), ("Ba", 1), ("C", 1)]) 278 , runTest $ mkTest dbBJ4 "bj4" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) 279 , runTest $ mkTest dbBJ5 "bj5" ["A"] (solverSuccess [("A", 1), ("B", 1), ("D", 1)]) 280 , runTest $ mkTest dbBJ6 "bj6" ["A"] (solverSuccess [("A", 1), ("B", 1)]) 281 , runTest $ mkTest dbBJ7 "bj7" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) 282 , runTest $ indep $ mkTest dbBJ8 "bj8" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) 283 ] 284 , testGroup "main library dependencies" [ 285 let db = [Right $ exAvNoLibrary "A" 1 `withExe` exExe "exe" []] 286 in runTest $ mkTest db "install build target without a library" ["A"] $ 287 solverSuccess [("A", 1)] 288 289 , let db = [ Right $ exAv "A" 1 [ExAny "B"] 290 , Right $ exAvNoLibrary "B" 1 `withExe` exExe "exe" [] ] 291 in runTest $ mkTest db "reject build-depends dependency with no library" ["A"] $ 292 solverFailure (isInfixOf "rejecting: B-1.0.0 (does not contain library, which is required by A)") 293 294 , let exe = exExe "exe" [] 295 db = [ Right $ exAv "A" 1 [ExAny "B"] 296 , Right $ exAvNoLibrary "B" 2 `withExe` exe 297 , Right $ exAv "B" 1 [] `withExe` exe ] 298 in runTest $ mkTest db "choose version of build-depends dependency that has a library" ["A"] $ 299 solverSuccess [("A", 1), ("B", 1)] 300 ] 301 , testGroup "sub-library dependencies" [ 302 let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] 303 , Right $ exAv "B" 1 [] ] 304 in runTest $ 305 mkTest db "reject package that is missing required sub-library" ["A"] $ 306 solverFailure $ isInfixOf $ 307 "rejecting: B-1.0.0 (does not contain library 'sub-lib', which is required by A)" 308 309 , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] 310 , Right $ exAvNoLibrary "B" 1 `withSubLibrary` exSubLib "sub-lib" [] ] 311 in runTest $ 312 mkTest db "reject package with private but required sub-library" ["A"] $ 313 solverFailure $ isInfixOf $ 314 "rejecting: B-1.0.0 (library 'sub-lib' is private, but it is required by A)" 315 316 , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] 317 , Right $ exAvNoLibrary "B" 1 318 `withSubLibrary` exSubLib "sub-lib" [ExFlagged "make-lib-private" (dependencies []) publicDependencies] ] 319 in runTest $ constraints [ExFlagConstraint (ScopeAnyQualifier "B") "make-lib-private" True] $ 320 mkTest db "reject package with sub-library made private by flag constraint" ["A"] $ 321 solverFailure $ isInfixOf $ 322 "rejecting: B-1.0.0 (library 'sub-lib' is private, but it is required by A)" 323 324 , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] 325 , Right $ exAvNoLibrary "B" 1 326 `withSubLibrary` exSubLib "sub-lib" [ExFlagged "make-lib-private" (dependencies []) publicDependencies] ] 327 in runTest $ 328 mkTest db "treat sub-library as visible even though flag choice could make it private" ["A"] $ 329 solverSuccess [("A", 1), ("B", 1)] 330 331 , let db = [ Right $ exAv "A" 1 [ExAny "B"] 332 , Right $ exAv "B" 1 [] `withSubLibrary` exSubLib "sub-lib" [] 333 , Right $ exAv "C" 1 [ExSubLibAny "B" "sub-lib"] ] 334 goals :: [ExampleVar] 335 goals = [ 336 P QualNone "A" 337 , P QualNone "B" 338 , P QualNone "C" 339 ] 340 in runTest $ goalOrder goals $ 341 mkTest db "reject package that requires a private sub-library" ["A", "C"] $ 342 solverFailure $ isInfixOf $ 343 "rejecting: C-1.0.0 (requires library 'sub-lib' from B, but the component is private)" 344 345 , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib-v1"] 346 , Right $ exAv "B" 2 [] `withSubLibrary` ExSubLib "sub-lib-v2" publicDependencies 347 , Right $ exAv "B" 1 [] `withSubLibrary` ExSubLib "sub-lib-v1" publicDependencies ] 348 in runTest $ mkTest db "choose version of package containing correct sub-library" ["A"] $ 349 solverSuccess [("A", 1), ("B", 1)] 350 351 , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] 352 , Right $ exAv "B" 2 [] `withSubLibrary` ExSubLib "sub-lib" (dependencies []) 353 , Right $ exAv "B" 1 [] `withSubLibrary` ExSubLib "sub-lib" publicDependencies ] 354 in runTest $ mkTest db "choose version of package with public sub-library" ["A"] $ 355 solverSuccess [("A", 1), ("B", 1)] 356 ] 357 -- build-tool-depends dependencies 358 , testGroup "build-tool-depends" [ 359 runTest $ mkTest dbBuildTools "simple exe dependency" ["A"] (solverSuccess [("A", 1), ("bt-pkg", 2)]) 360 361 , runTest $ disableSolveExecutables $ 362 mkTest dbBuildTools "don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)]) 363 364 , runTest $ mkTest dbBuildTools "flagged exe dependency" ["B"] (solverSuccess [("B", 1), ("bt-pkg", 2)]) 365 366 , runTest $ enableAllTests $ 367 mkTest dbBuildTools "test suite exe dependency" ["C"] (solverSuccess [("C", 1), ("bt-pkg", 2)]) 368 369 , runTest $ mkTest dbBuildTools "unknown exe" ["D"] $ 370 solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by D") 371 372 , runTest $ disableSolveExecutables $ 373 mkTest dbBuildTools "don't check for build tool executables in legacy mode" ["D"] $ solverSuccess [("D", 1)] 374 375 , runTest $ mkTest dbBuildTools "unknown build tools package error mentions package, not exe" ["E"] $ 376 solverFailure (isInfixOf "unknown package: E:unknown-pkg:exe.unknown-pkg (dependency of E)") 377 378 , runTest $ mkTest dbBuildTools "unknown flagged exe" ["F"] $ 379 solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by F +flagF") 380 381 , runTest $ enableAllTests $ mkTest dbBuildTools "unknown test suite exe" ["G"] $ 382 solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by G *test") 383 384 , runTest $ mkTest dbBuildTools "wrong exe for build tool package version" ["H"] $ 385 solverFailure $ isInfixOf $ 386 -- The solver reports the version conflict when a version conflict 387 -- and an executable conflict apply to the same package version. 388 "[__1] rejecting: H:bt-pkg:exe.bt-pkg-4.0.0 (conflict: H => H:bt-pkg:exe.bt-pkg (exe exe1)==3.0.0)\n" 389 ++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-3.0.0 (does not contain executable 'exe1', which is required by H)\n" 390 ++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-2.0.0 (conflict: H => H:bt-pkg:exe.bt-pkg (exe exe1)==3.0.0)" 391 392 , runTest $ chooseExeAfterBuildToolsPackage True "choose exe after choosing its package - success" 393 394 , runTest $ chooseExeAfterBuildToolsPackage False "choose exe after choosing its package - failure" 395 396 , runTest $ rejectInstalledBuildToolPackage "reject installed package for build-tool dependency" 397 398 , runTest $ requireConsistentBuildToolVersions "build tool versions must be consistent within one package" 399 ] 400 -- build-tools dependencies 401 , testGroup "legacy build-tools" [ 402 runTest $ mkTest dbLegacyBuildTools1 "bt1" ["A"] (solverSuccess [("A", 1), ("alex", 1)]) 403 404 , runTest $ disableSolveExecutables $ 405 mkTest dbLegacyBuildTools1 "bt1 - don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)]) 406 407 , runTest $ mkTest dbLegacyBuildTools2 "bt2" ["A"] $ 408 solverFailure (isInfixOf "does not contain executable 'alex', which is required by A") 409 410 , runTest $ disableSolveExecutables $ 411 mkTest dbLegacyBuildTools2 "bt2 - don't check for build tool executables in legacy mode" ["A"] (solverSuccess [("A", 1)]) 412 413 , runTest $ mkTest dbLegacyBuildTools3 "bt3" ["A"] (solverSuccess [("A", 1)]) 414 415 , runTest $ mkTest dbLegacyBuildTools4 "bt4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("alex", 1), ("alex", 2)]) 416 417 , runTest $ mkTest dbLegacyBuildTools5 "bt5" ["B"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("alex", 1)]) 418 419 , runTest $ mkTest dbLegacyBuildTools6 "bt6" ["A"] (solverSuccess [("A", 1), ("alex", 1), ("happy", 1)]) 420 ] 421 -- internal dependencies 422 , testGroup "internal dependencies" [ 423 runTest $ mkTest dbIssue3775 "issue #3775" ["B"] (solverSuccess [("A", 2), ("B", 2), ("warp", 1)]) 424 ] 425 -- tests for partial fix for issue #5325 426 , testGroup "Components that are unbuildable in the current environment" $ 427 let flagConstraint = ExFlagConstraint . ScopeAnyQualifier 428 in [ 429 let db = [ Right $ exAv "A" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies] ] 430 in runTest $ constraints [flagConstraint "A" "build-lib" False] $ 431 mkTest db "install unbuildable library" ["A"] $ 432 solverSuccess [("A", 1)] 433 434 , let db = [ Right $ exAvNoLibrary "A" 1 435 `withExe` exExe "exe" [ExFlagged "build-exe" (dependencies []) unbuildableDependencies] ] 436 in runTest $ constraints [flagConstraint "A" "build-exe" False] $ 437 mkTest db "install unbuildable exe" ["A"] $ 438 solverSuccess [("A", 1)] 439 440 , let db = [ Right $ exAv "A" 1 [ExAny "B"] 441 , Right $ exAv "B" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies] ] 442 in runTest $ constraints [flagConstraint "B" "build-lib" False] $ 443 mkTest db "reject library dependency with unbuildable library" ["A"] $ 444 solverFailure $ isInfixOf $ 445 "rejecting: B-1.0.0 (library is not buildable in the " 446 ++ "current environment, but it is required by A)" 447 448 , let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"] 449 , Right $ exAv "B" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies] 450 `withExe` exExe "bt" [] ] 451 in runTest $ constraints [flagConstraint "B" "build-lib" False] $ 452 mkTest db "allow build-tool dependency with unbuildable library" ["A"] $ 453 solverSuccess [("A", 1), ("B", 1)] 454 455 , let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"] 456 , Right $ exAv "B" 1 [] 457 `withExe` exExe "bt" [ExFlagged "build-exe" (dependencies []) unbuildableDependencies] ] 458 in runTest $ constraints [flagConstraint "B" "build-exe" False] $ 459 mkTest db "reject build-tool dependency with unbuildable exe" ["A"] $ 460 solverFailure $ isInfixOf $ 461 "rejecting: A:B:exe.B-1.0.0 (executable 'bt' is not " 462 ++ "buildable in the current environment, but it is required by A)" 463 , runTest $ 464 chooseUnbuildableExeAfterBuildToolsPackage 465 "choose unbuildable exe after choosing its package" 466 ] 467 468 , testGroup "--fine-grained-conflicts" [ 469 470 -- Skipping a version because of a problematic dependency: 471 -- 472 -- When the solver explores A-4, it finds that it cannot satisfy B's 473 -- dependencies. This allows the solver to skip the subsequent 474 -- versions of A that also depend on B. 475 runTest $ 476 let db = [ 477 Right $ exAv "A" 4 [ExAny "B"] 478 , Right $ exAv "A" 3 [ExAny "B"] 479 , Right $ exAv "A" 2 [ExAny "B"] 480 , Right $ exAv "A" 1 [] 481 , Right $ exAv "B" 2 [ExAny "unknown1"] 482 , Right $ exAv "B" 1 [ExAny "unknown2"] 483 ] 484 msg = [ 485 "[__0] trying: A-4.0.0 (user goal)" 486 , "[__1] trying: B-2.0.0 (dependency of A)" 487 , "[__2] unknown package: unknown1 (dependency of B)" 488 , "[__2] fail (backjumping, conflict set: B, unknown1)" 489 , "[__1] trying: B-1.0.0" 490 , "[__2] unknown package: unknown2 (dependency of B)" 491 , "[__2] fail (backjumping, conflict set: B, unknown2)" 492 , "[__1] fail (backjumping, conflict set: A, B, unknown1, unknown2)" 493 , "[__0] skipping: A-3.0.0, A-2.0.0 (has the same characteristics that " 494 ++ "caused the previous version to fail: depends on 'B')" 495 , "[__0] trying: A-1.0.0" 496 , "[__1] done" 497 ] 498 in setVerbose $ 499 mkTest db "skip version due to problematic dependency" ["A"] $ 500 SolverResult (isInfixOf msg) $ Right [("A", 1)] 501 502 , -- Skipping a version because of a restrictive constraint on a 503 -- dependency: 504 -- 505 -- The solver rejects A-4 because its constraint on B excludes B-1. 506 -- Then the solver is able to skip A-3 and A-2 because they also 507 -- exclude B-1, even though they don't have the exact same constraints 508 -- on B. 509 runTest $ 510 let db = [ 511 Right $ exAv "A" 4 [ExFix "B" 14] 512 , Right $ exAv "A" 3 [ExFix "B" 13] 513 , Right $ exAv "A" 2 [ExFix "B" 12] 514 , Right $ exAv "A" 1 [ExFix "B" 11] 515 , Right $ exAv "B" 11 [] 516 ] 517 msg = [ 518 "[__0] trying: A-4.0.0 (user goal)" 519 , "[__1] next goal: B (dependency of A)" 520 , "[__1] rejecting: B-11.0.0 (conflict: A => B==14.0.0)" 521 , "[__1] fail (backjumping, conflict set: A, B)" 522 , "[__0] skipping: A-3.0.0, A-2.0.0 (has the same characteristics that " 523 ++ "caused the previous version to fail: depends on 'B' but excludes " 524 ++ "version 11.0.0)" 525 , "[__0] trying: A-1.0.0" 526 , "[__1] next goal: B (dependency of A)" 527 , "[__1] trying: B-11.0.0" 528 , "[__2] done" 529 ] 530 in setVerbose $ 531 mkTest db "skip version due to restrictive constraint on its dependency" ["A"] $ 532 SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 11)] 533 534 , -- This test tests the case where the solver chooses a version for one 535 -- package, B, before choosing a version for one of its reverse 536 -- dependencies, C. While the solver is exploring the subtree rooted 537 -- at B-3, it finds that C-2's dependency on B conflicts with B-3. 538 -- Then the solver is able to skip C-1, because it also excludes B-3. 539 -- 540 -- --fine-grained-conflicts could have a benefit in this case even 541 -- though the solver would have found the conflict between B-3 and C-1 542 -- immediately after trying C-1 anyway. It prevents C-1 from 543 -- introducing any other conflicts which could increase the size of 544 -- the conflict set. 545 runTest $ 546 let db = [ 547 Right $ exAv "A" 1 [ExAny "B", ExAny "C"] 548 , Right $ exAv "B" 3 [] 549 , Right $ exAv "B" 2 [] 550 , Right $ exAv "B" 1 [] 551 , Right $ exAv "C" 2 [ExFix "B" 2] 552 , Right $ exAv "C" 1 [ExFix "B" 1] 553 ] 554 goals = [P QualNone pkg | pkg <- ["A", "B", "C"]] 555 expectedMsg = [ 556 "[__0] trying: A-1.0.0 (user goal)" 557 , "[__1] trying: B-3.0.0 (dependency of A)" 558 , "[__2] next goal: C (dependency of A)" 559 , "[__2] rejecting: C-2.0.0 (conflict: B==3.0.0, C => B==2.0.0)" 560 , "[__2] skipping: C-1.0.0 (has the same characteristics that caused the " 561 ++ "previous version to fail: excludes 'B' version 3.0.0)" 562 , "[__2] fail (backjumping, conflict set: A, B, C)" 563 , "[__1] trying: B-2.0.0" 564 , "[__2] next goal: C (dependency of A)" 565 , "[__2] trying: C-2.0.0" 566 , "[__3] done" 567 ] 568 in setVerbose $ goalOrder goals $ 569 mkTest db "skip version that excludes dependency that was already chosen" ["A"] $ 570 SolverResult (isInfixOf expectedMsg) $ Right [("A", 1), ("B", 2), ("C", 2)] 571 572 , -- This test tests how the solver merges conflicts when it has 573 -- multiple reasons to add a variable to the conflict set. In this 574 -- case, package A conflicts with B and C. The solver should take the 575 -- union of the conflicts and then only skip a version if it does not 576 -- resolve any of the conflicts. 577 -- 578 -- The solver rejects A-3 because it can't find consistent versions for 579 -- its two dependencies, B and C. Then it skips A-2 because A-2 also 580 -- depends on B and C. This test ensures that the solver considers 581 -- A-1 even though A-1 only resolves one of the conflicts (A-1 removes 582 -- the dependency on C). 583 runTest $ 584 let db = [ 585 Right $ exAv "A" 3 [ExAny "B", ExAny "C"] 586 , Right $ exAv "A" 2 [ExAny "B", ExAny "C"] 587 , Right $ exAv "A" 1 [ExAny "B"] 588 , Right $ exAv "B" 1 [ExFix "D" 1] 589 , Right $ exAv "C" 1 [ExFix "D" 2] 590 , Right $ exAv "D" 1 [] 591 , Right $ exAv "D" 2 [] 592 ] 593 goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]] 594 msg = [ 595 "[__0] trying: A-3.0.0 (user goal)" 596 , "[__1] trying: B-1.0.0 (dependency of A)" 597 , "[__2] trying: C-1.0.0 (dependency of A)" 598 , "[__3] next goal: D (dependency of B)" 599 , "[__3] rejecting: D-2.0.0 (conflict: B => D==1.0.0)" 600 , "[__3] rejecting: D-1.0.0 (conflict: C => D==2.0.0)" 601 , "[__3] fail (backjumping, conflict set: B, C, D)" 602 , "[__2] fail (backjumping, conflict set: A, B, C, D)" 603 , "[__1] fail (backjumping, conflict set: A, B, C, D)" 604 , "[__0] skipping: A-2.0.0 (has the same characteristics that caused the " 605 ++ "previous version to fail: depends on 'B'; depends on 'C')" 606 , "[__0] trying: A-1.0.0" 607 , "[__1] trying: B-1.0.0 (dependency of A)" 608 , "[__2] next goal: D (dependency of B)" 609 , "[__2] rejecting: D-2.0.0 (conflict: B => D==1.0.0)" 610 , "[__2] trying: D-1.0.0" 611 , "[__3] done" 612 ] 613 in setVerbose $ goalOrder goals $ 614 mkTest db "only skip a version if it resolves none of the previous conflicts" ["A"] $ 615 SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1), ("D", 1)] 616 617 , -- This test ensures that the solver log doesn't show all conflicts 618 -- that the solver encountered in a subtree. The solver should only 619 -- show the conflicts that are contained in the current conflict set. 620 -- 621 -- The goal order forces the solver to try A-4, encounter a conflict 622 -- with B-2, try B-1, and then try C. A-4 conflicts with the only 623 -- version of C, so the solver backjumps with a conflict set of 624 -- {A, C}. When the solver skips the next version of A, the log should 625 -- mention the conflict with C but not B. 626 runTest $ 627 let db = [ 628 Right $ exAv "A" 4 [ExFix "B" 1, ExFix "C" 1] 629 , Right $ exAv "A" 3 [ExFix "B" 1, ExFix "C" 1] 630 , Right $ exAv "A" 2 [ExFix "C" 1] 631 , Right $ exAv "A" 1 [ExFix "C" 2] 632 , Right $ exAv "B" 2 [] 633 , Right $ exAv "B" 1 [] 634 , Right $ exAv "C" 2 [] 635 ] 636 goals = [P QualNone pkg | pkg <- ["A", "B", "C"]] 637 msg = [ 638 "[__0] trying: A-4.0.0 (user goal)" 639 , "[__1] next goal: B (dependency of A)" 640 , "[__1] rejecting: B-2.0.0 (conflict: A => B==1.0.0)" 641 , "[__1] trying: B-1.0.0" 642 , "[__2] next goal: C (dependency of A)" 643 , "[__2] rejecting: C-2.0.0 (conflict: A => C==1.0.0)" 644 , "[__2] fail (backjumping, conflict set: A, C)" 645 , "[__0] skipping: A-3.0.0, A-2.0.0 (has the same characteristics that caused the " 646 ++ "previous version to fail: depends on 'C' but excludes version 2.0.0)" 647 , "[__0] trying: A-1.0.0" 648 , "[__1] next goal: C (dependency of A)" 649 , "[__1] trying: C-2.0.0" 650 , "[__2] done" 651 ] 652 in setVerbose $ goalOrder goals $ 653 mkTest db "don't show conflicts that aren't part of the conflict set" ["A"] $ 654 SolverResult (isInfixOf msg) $ Right [("A", 1), ("C", 2)] 655 656 , -- Tests that the conflict set is properly updated when a version is 657 -- skipped due to being excluded by one of its reverse dependencies' 658 -- constraints. 659 runTest $ 660 let db = [ 661 Right $ exAv "A" 2 [ExFix "B" 3] 662 , Right $ exAv "A" 1 [ExFix "B" 1] 663 , Right $ exAv "B" 2 [] 664 , Right $ exAv "B" 1 [] 665 ] 666 msg = [ 667 "[__0] trying: A-2.0.0 (user goal)" 668 , "[__1] next goal: B (dependency of A)" 669 670 -- During this step, the solver adds A and B to the 671 -- conflict set, with the details of each package's 672 -- conflict: 673 -- 674 -- A: A's constraint rejected B-2. 675 -- B: B was rejected by A's B==3 constraint 676 , "[__1] rejecting: B-2.0.0 (conflict: A => B==3.0.0)" 677 678 -- When the solver skips B-1, it cannot simply reuse the 679 -- previous conflict set. It also needs to update A's 680 -- entry to say that A also rejected B-1. Otherwise, the 681 -- solver wouldn't know that A-1 could resolve one of 682 -- the conflicts encountered while exploring A-2. The 683 -- solver would skip A-1, even though it leads to the 684 -- solution. 685 , "[__1] skipping: B-1.0.0 (has the same characteristics that caused " 686 ++ "the previous version to fail: excluded by constraint '==3.0.0' from 'A')" 687 688 , "[__1] fail (backjumping, conflict set: A, B)" 689 , "[__0] trying: A-1.0.0" 690 , "[__1] next goal: B (dependency of A)" 691 , "[__1] rejecting: B-2.0.0 (conflict: A => B==1.0.0)" 692 , "[__1] trying: B-1.0.0" 693 , "[__2] done" 694 ] 695 in setVerbose $ 696 mkTest db "update conflict set after skipping version - 1" ["A"] $ 697 SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1)] 698 699 , -- Tests that the conflict set is properly updated when a version is 700 -- skipped due to excluding a version of one of its dependencies. 701 -- This test is similar the previous one, with the goal order reversed. 702 runTest $ 703 let db = [ 704 Right $ exAv "A" 2 [] 705 , Right $ exAv "A" 1 [] 706 , Right $ exAv "B" 2 [ExFix "A" 3] 707 , Right $ exAv "B" 1 [ExFix "A" 1] 708 ] 709 goals = [P QualNone pkg | pkg <- ["A", "B"]] 710 msg = [ 711 "[__0] trying: A-2.0.0 (user goal)" 712 , "[__1] next goal: B (user goal)" 713 , "[__1] rejecting: B-2.0.0 (conflict: A==2.0.0, B => A==3.0.0)" 714 , "[__1] skipping: B-1.0.0 (has the same characteristics that caused " 715 ++ "the previous version to fail: excludes 'A' version 2.0.0)" 716 , "[__1] fail (backjumping, conflict set: A, B)" 717 , "[__0] trying: A-1.0.0" 718 , "[__1] next goal: B (user goal)" 719 , "[__1] rejecting: B-2.0.0 (conflict: A==1.0.0, B => A==3.0.0)" 720 , "[__1] trying: B-1.0.0" 721 , "[__2] done" 722 ] 723 in setVerbose $ goalOrder goals $ 724 mkTest db "update conflict set after skipping version - 2" ["A", "B"] $ 725 SolverResult (isInfixOf msg) $ Right [("A", 1), ("B", 1)] 726 ] 727 -- Tests for the contents of the solver's log 728 , testGroup "Solver log" [ 729 -- See issue #3203. The solver should only choose a version for A once. 730 runTest $ 731 let db = [Right $ exAv "A" 1 []] 732 733 p :: [String] -> Bool 734 p lg = elem "targets: A" lg 735 && length (filter ("trying: A" `isInfixOf`) lg) == 1 736 in setVerbose $ mkTest db "deduplicate targets" ["A", "A"] $ 737 SolverResult p $ Right [("A", 1)] 738 , runTest $ 739 let db = [Right $ exAv "A" 1 [ExAny "B"]] 740 msg = "After searching the rest of the dependency tree exhaustively, " 741 ++ "these were the goals I've had most trouble fulfilling: A, B" 742 in mkTest db "exhaustive search failure message" ["A"] $ 743 solverFailure (isInfixOf msg) 744 , testSummarizedLog "show conflicts from final conflict set after exhaustive search" Nothing $ 745 "Could not resolve dependencies:\n" 746 ++ "[__0] trying: A-1.0.0 (user goal)\n" 747 ++ "[__1] unknown package: F (dependency of A)\n" 748 ++ "[__1] fail (backjumping, conflict set: A, F)\n" 749 ++ "After searching the rest of the dependency tree exhaustively, " 750 ++ "these were the goals I've had most trouble fulfilling: A, F" 751 , testSummarizedLog "show first conflicts after inexhaustive search" (Just 3) $ 752 "Could not resolve dependencies:\n" 753 ++ "[__0] trying: A-1.0.0 (user goal)\n" 754 ++ "[__1] trying: B-3.0.0 (dependency of A)\n" 755 ++ "[__2] unknown package: C (dependency of B)\n" 756 ++ "[__2] fail (backjumping, conflict set: B, C)\n" 757 ++ "Backjump limit reached (currently 3, change with --max-backjumps " 758 ++ "or try to run with --reorder-goals).\n" 759 , testSummarizedLog "don't show summarized log when backjump limit is too low" (Just 1) $ 760 "Backjump limit reached (currently 1, change with --max-backjumps " 761 ++ "or try to run with --reorder-goals).\n" 762 ++ "Failed to generate a summarized dependency solver log due to low backjump limit." 763 , testMinimizeConflictSet 764 "minimize conflict set with --minimize-conflict-set" 765 , testNoMinimizeConflictSet 766 "show original conflict set with --no-minimize-conflict-set" 767 , runTest $ 768 let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3] 769 , Left $ exInst "other-package" 2 "other-package-2.0.0" []] 770 msg = "rejecting: other-package-2.0.0/installed-2.0.0" 771 in mkTest db "show full installed package version (issue #5892)" ["my-package"] $ 772 solverFailure (isInfixOf msg) 773 , runTest $ 774 let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3] 775 , Left $ exInst "other-package" 2 "other-package-AbCdEfGhIj0123456789" [] ] 776 msg = "rejecting: other-package-2.0.0/installed-AbCdEfGhIj0123456789" 777 in mkTest db "show full installed package ABI hash (issue #5892)" ["my-package"] $ 778 solverFailure (isInfixOf msg) 779 ] 780 ] 781 where 782 indep = independentGoals 783 mkvrThis = V.thisVersion . makeV 784 mkvrOrEarlier = V.orEarlierVersion . makeV 785 makeV v = V.mkVersion [v,0,0] 786 787data GoalOrder = FixedGoalOrder | DefaultGoalOrder 788 789{------------------------------------------------------------------------------- 790 Specific example database for the tests 791-------------------------------------------------------------------------------} 792 793db1 :: ExampleDb 794db1 = 795 let a = exInst "A" 1 "A-1" [] 796 in [ Left a 797 , Right $ exAv "B" 1 [ExAny "A"] 798 , Right $ exAv "B" 2 [ExAny "A"] 799 , Right $ exAv "C" 1 [ExFix "B" 1] 800 , Right $ exAv "D" 1 [ExFix "B" 2] 801 , Right $ exAv "E" 1 [ExAny "B"] 802 , Right $ exAv "F" 1 [ExFix "B" 1, ExAny "E"] 803 , Right $ exAv "G" 1 [ExFix "B" 2, ExAny "E"] 804 , Right $ exAv "Z" 1 [] 805 ] 806 807-- In this example, we _can_ install C and D as independent goals, but we have 808-- to pick two different versions for B (arbitrarily) 809db2 :: ExampleDb 810db2 = [ 811 Right $ exAv "A" 1 [] 812 , Right $ exAv "A" 2 [] 813 , Right $ exAv "B" 1 [ExAny "A"] 814 , Right $ exAv "B" 2 [ExAny "A"] 815 , Right $ exAv "C" 1 [ExAny "B", ExFix "A" 1] 816 , Right $ exAv "D" 1 [ExAny "B", ExFix "A" 2] 817 ] 818 819db3 :: ExampleDb 820db3 = [ 821 Right $ exAv "A" 1 [] 822 , Right $ exAv "A" 2 [] 823 , Right $ exAv "B" 1 [exFlagged "flagB" [ExFix "A" 1] [ExFix "A" 2]] 824 , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"] 825 , Right $ exAv "D" 1 [ExFix "A" 2, ExAny "B"] 826 ] 827 828-- | Like db3, but the flag picks a different package rather than a 829-- different package version 830-- 831-- In db3 we cannot install C and D as independent goals because: 832-- 833-- * The multiple instance restriction says C and D _must_ share B 834-- * Since C relies on A-1, C needs B to be compiled with flagB on 835-- * Since D relies on A-2, D needs B to be compiled with flagB off 836-- * Hence C and D have incompatible requirements on B's flags. 837-- 838-- However, _even_ if we don't check explicitly that we pick the same flag 839-- assignment for 0.B and 1.B, we will still detect the problem because 840-- 0.B depends on 0.A-1, 1.B depends on 1.A-2, hence we cannot link 0.A to 841-- 1.A and therefore we cannot link 0.B to 1.B. 842-- 843-- In db4 the situation however is trickier. We again cannot install 844-- packages C and D as independent goals because: 845-- 846-- * As above, the multiple instance restriction says that C and D _must_ share B 847-- * Since C relies on Ax-2, it requires B to be compiled with flagB off 848-- * Since D relies on Ay-2, it requires B to be compiled with flagB on 849-- * Hence C and D have incompatible requirements on B's flags. 850-- 851-- But now this requirement is more indirect. If we only check dependencies 852-- we don't see the problem: 853-- 854-- * We link 0.B to 1.B 855-- * 0.B relies on Ay-1 856-- * 1.B relies on Ax-1 857-- 858-- We will insist that 0.Ay will be linked to 1.Ay, and 0.Ax to 1.Ax, but since 859-- we only ever assign to one of these, these constraints are never broken. 860db4 :: ExampleDb 861db4 = [ 862 Right $ exAv "Ax" 1 [] 863 , Right $ exAv "Ax" 2 [] 864 , Right $ exAv "Ay" 1 [] 865 , Right $ exAv "Ay" 2 [] 866 , Right $ exAv "B" 1 [exFlagged "flagB" [ExFix "Ax" 1] [ExFix "Ay" 1]] 867 , Right $ exAv "C" 1 [ExFix "Ax" 2, ExAny "B"] 868 , Right $ exAv "D" 1 [ExFix "Ay" 2, ExAny "B"] 869 ] 870 871-- | Simple database containing one package with a manual flag. 872dbManualFlags :: ExampleDb 873dbManualFlags = [ 874 Right $ declareFlags [ExFlag "flag" True Manual] $ 875 exAv "pkg" 1 [exFlagged "flag" [ExAny "true-dep"] [ExAny "false-dep"]] 876 , Right $ exAv "true-dep" 1 [] 877 , Right $ exAv "false-dep" 1 [] 878 ] 879 880-- | Database containing a setup dependency with a manual flag. A's library and 881-- setup script depend on two different versions of B. B's manual flag can be 882-- set to different values in the two places where it is used. 883dbSetupDepWithManualFlag :: ExampleDb 884dbSetupDepWithManualFlag = 885 let bFlags = [ExFlag "flag" True Manual] 886 in [ 887 Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 2] 888 , Right $ declareFlags bFlags $ 889 exAv "B" 1 [exFlagged "flag" [ExAny "b-1-true-dep"] 890 [ExAny "b-1-false-dep"]] 891 , Right $ declareFlags bFlags $ 892 exAv "B" 2 [exFlagged "flag" [ExAny "b-2-true-dep"] 893 [ExAny "b-2-false-dep"]] 894 , Right $ exAv "b-1-true-dep" 1 [] 895 , Right $ exAv "b-1-false-dep" 1 [] 896 , Right $ exAv "b-2-true-dep" 1 [] 897 , Right $ exAv "b-2-false-dep" 1 [] 898 ] 899 900-- | A database similar to 'dbSetupDepWithManualFlag', except that the library 901-- and setup script both depend on B-1. B must be linked because of the Single 902-- Instance Restriction, and its flag can only have one value. 903dbLinkedSetupDepWithManualFlag :: ExampleDb 904dbLinkedSetupDepWithManualFlag = [ 905 Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 1] 906 , Right $ declareFlags [ExFlag "flag" True Manual] $ 907 exAv "B" 1 [exFlagged "flag" [ExAny "b-1-true-dep"] 908 [ExAny "b-1-false-dep"]] 909 , Right $ exAv "b-1-true-dep" 1 [] 910 , Right $ exAv "b-1-false-dep" 1 [] 911 ] 912 913-- | Some tests involving testsuites 914-- 915-- Note that in this test framework test suites are always enabled; if you 916-- want to test without test suites just set up a test database without 917-- test suites. 918-- 919-- * C depends on A (through its test suite) 920-- * D depends on B-2 (through its test suite), but B-2 is unavailable 921-- * E depends on A-1 directly and on A through its test suite. We prefer 922-- to use A-1 for the test suite in this case. 923-- * F depends on A-1 directly and on A-2 through its test suite. In this 924-- case we currently fail to install F, although strictly speaking 925-- test suites should be considered independent goals. 926-- * G is like E, but for version A-2. This means that if we cannot install 927-- E and G together, unless we regard them as independent goals. 928db5 :: ExampleDb 929db5 = [ 930 Right $ exAv "A" 1 [] 931 , Right $ exAv "A" 2 [] 932 , Right $ exAv "B" 1 [] 933 , Right $ exAv "C" 1 [] `withTest` exTest "testC" [ExAny "A"] 934 , Right $ exAv "D" 1 [] `withTest` exTest "testD" [ExFix "B" 2] 935 , Right $ exAv "E" 1 [ExFix "A" 1] `withTest` exTest "testE" [ExAny "A"] 936 , Right $ exAv "F" 1 [ExFix "A" 1] `withTest` exTest "testF" [ExFix "A" 2] 937 , Right $ exAv "G" 1 [ExFix "A" 2] `withTest` exTest "testG" [ExAny "A"] 938 ] 939 940-- Now the _dependencies_ have test suites 941-- 942-- * Installing C is a simple example. C wants version 1 of A, but depends on 943-- B, and B's testsuite depends on an any version of A. In this case we prefer 944-- to link (if we don't regard test suites as independent goals then of course 945-- linking here doesn't even come into it). 946-- * Installing [C, D] means that we prefer to link B -- depending on how we 947-- set things up, this means that we should also link their test suites. 948db6 :: ExampleDb 949db6 = [ 950 Right $ exAv "A" 1 [] 951 , Right $ exAv "A" 2 [] 952 , Right $ exAv "B" 1 [] `withTest` exTest "testA" [ExAny "A"] 953 , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"] 954 , Right $ exAv "D" 1 [ExAny "B"] 955 ] 956 957-- | This test checks that the solver can backjump to disable a flag, even if 958-- the problematic dependency is also under a test suite. (issue #4390) 959-- 960-- The goal order forces the solver to choose the flag before enabling testing. 961-- Previously, the solver couldn't handle this case, because it only tried to 962-- disable testing, and when that failed, it backjumped past the flag choice. 963-- The solver should also try to set the flag to false, because that avoids the 964-- dependency on B. 965testTestSuiteWithFlag :: String -> SolverTest 966testTestSuiteWithFlag name = 967 goalOrder goals $ enableAllTests $ mkTest db name ["A", "B"] $ 968 solverSuccess [("A", 1), ("B", 1)] 969 where 970 db :: ExampleDb 971 db = [ 972 Right $ exAv "A" 1 [] 973 `withTest` 974 exTest "test" [exFlagged "flag" [ExFix "B" 2] []] 975 , Right $ exAv "B" 1 [] 976 ] 977 978 goals :: [ExampleVar] 979 goals = [ 980 P QualNone "B" 981 , P QualNone "A" 982 , F QualNone "A" "flag" 983 , S QualNone "A" TestStanzas 984 ] 985 986-- Packages with setup dependencies 987-- 988-- Install.. 989-- * B: Simple example, just make sure setup deps are taken into account at all 990-- * C: Both the package and the setup script depend on any version of A. 991-- In this case we prefer to link 992-- * D: Variation on C.1 where the package requires a specific (not latest) 993-- version but the setup dependency is not fixed. Again, we prefer to 994-- link (picking the older version) 995-- * E: Variation on C.2 with the setup dependency the more inflexible. 996-- Currently, in this case we do not see the opportunity to link because 997-- we consider setup dependencies after normal dependencies; we will 998-- pick A.2 for E, then realize we cannot link E.setup.A to A.2, and pick 999-- A.1 instead. This isn't so easy to fix (if we want to fix it at all); 1000-- in particular, considering setup dependencies _before_ other deps is 1001-- not an improvement, because in general we would prefer to link setup 1002-- setups to package deps, rather than the other way around. (For example, 1003-- if we change this ordering then the test for D would start to install 1004-- two versions of A). 1005-- * F: The package and the setup script depend on different versions of A. 1006-- This will only work if setup dependencies are considered independent. 1007db7 :: ExampleDb 1008db7 = [ 1009 Right $ exAv "A" 1 [] 1010 , Right $ exAv "A" 2 [] 1011 , Right $ exAv "B" 1 [] `withSetupDeps` [ExAny "A"] 1012 , Right $ exAv "C" 1 [ExAny "A" ] `withSetupDeps` [ExAny "A" ] 1013 , Right $ exAv "D" 1 [ExFix "A" 1] `withSetupDeps` [ExAny "A" ] 1014 , Right $ exAv "E" 1 [ExAny "A" ] `withSetupDeps` [ExFix "A" 1] 1015 , Right $ exAv "F" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1] 1016 ] 1017 1018-- If we install C and D together (not as independent goals), we need to build 1019-- both B.1 and B.2, both of which depend on A. 1020db8 :: ExampleDb 1021db8 = [ 1022 Right $ exAv "A" 1 [] 1023 , Right $ exAv "B" 1 [ExAny "A"] 1024 , Right $ exAv "B" 2 [ExAny "A"] 1025 , Right $ exAv "C" 1 [] `withSetupDeps` [ExFix "B" 1] 1026 , Right $ exAv "D" 1 [] `withSetupDeps` [ExFix "B" 2] 1027 ] 1028 1029-- Extended version of `db8` so that we have nested setup dependencies 1030db9 :: ExampleDb 1031db9 = db8 ++ [ 1032 Right $ exAv "E" 1 [ExAny "C"] 1033 , Right $ exAv "E" 2 [ExAny "D"] 1034 , Right $ exAv "F" 1 [] `withSetupDeps` [ExFix "E" 1] 1035 , Right $ exAv "G" 1 [] `withSetupDeps` [ExFix "E" 2] 1036 ] 1037 1038-- Multiple already-installed packages with inter-dependencies, and one package 1039-- (C) that depends on package A-1 for its setup script and package A-2 as a 1040-- library dependency. 1041db10 :: ExampleDb 1042db10 = 1043 let rts = exInst "rts" 1 "rts-inst" [] 1044 ghc_prim = exInst "ghc-prim" 1 "ghc-prim-inst" [rts] 1045 base = exInst "base" 1 "base-inst" [rts, ghc_prim] 1046 a1 = exInst "A" 1 "A1-inst" [base] 1047 a2 = exInst "A" 2 "A2-inst" [base] 1048 in [ 1049 Left rts 1050 , Left ghc_prim 1051 , Left base 1052 , Left a1 1053 , Left a2 1054 , Right $ exAv "C" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1] 1055 ] 1056 1057-- | This database tests that a package's setup dependencies are correctly 1058-- linked when the package is linked. See pull request #3268. 1059-- 1060-- When A and B are installed as independent goals, their dependencies on C must 1061-- be linked, due to the single instance restriction. Since C depends on D, 0.D 1062-- and 1.D must be linked. C also has a setup dependency on D, so 0.C-setup.D 1063-- and 1.C-setup.D must be linked. However, D's two link groups must remain 1064-- independent. The solver should be able to choose D-1 for C's library and D-2 1065-- for C's setup script. 1066dbSetupDeps :: ExampleDb 1067dbSetupDeps = [ 1068 Right $ exAv "A" 1 [ExAny "C"] 1069 , Right $ exAv "B" 1 [ExAny "C"] 1070 , Right $ exAv "C" 1 [ExFix "D" 1] `withSetupDeps` [ExFix "D" 2] 1071 , Right $ exAv "D" 1 [] 1072 , Right $ exAv "D" 2 [] 1073 ] 1074 1075-- | Tests for dealing with base shims 1076db11 :: ExampleDb 1077db11 = 1078 let base3 = exInst "base" 3 "base-3-inst" [base4] 1079 base4 = exInst "base" 4 "base-4-inst" [] 1080 in [ 1081 Left base3 1082 , Left base4 1083 , Right $ exAv "A" 1 [ExFix "base" 3] 1084 ] 1085 1086-- | Slightly more realistic version of db11 where base-3 depends on syb 1087-- This means that if a package depends on base-3 and on syb, then they MUST 1088-- share the version of syb 1089-- 1090-- * Package A relies on base-3 (which relies on base-4) 1091-- * Package B relies on base-4 1092-- * Package C relies on both A and B 1093-- * Package D relies on base-3 and on syb-2, which is not possible because 1094-- base-3 has a dependency on syb-1 (non-inheritance of the Base qualifier) 1095-- * Package E relies on base-4 and on syb-2, which is fine. 1096db12 :: ExampleDb 1097db12 = 1098 let base3 = exInst "base" 3 "base-3-inst" [base4, syb1] 1099 base4 = exInst "base" 4 "base-4-inst" [] 1100 syb1 = exInst "syb" 1 "syb-1-inst" [base4] 1101 in [ 1102 Left base3 1103 , Left base4 1104 , Left syb1 1105 , Right $ exAv "syb" 2 [ExFix "base" 4] 1106 , Right $ exAv "A" 1 [ExFix "base" 3, ExAny "syb"] 1107 , Right $ exAv "B" 1 [ExFix "base" 4, ExAny "syb"] 1108 , Right $ exAv "C" 1 [ExAny "A", ExAny "B"] 1109 , Right $ exAv "D" 1 [ExFix "base" 3, ExFix "syb" 2] 1110 , Right $ exAv "E" 1 [ExFix "base" 4, ExFix "syb" 2] 1111 ] 1112 1113dbBase :: ExampleDb 1114dbBase = [ 1115 Right $ exAv "base" 1 1116 [ExAny "ghc-prim", ExAny "integer-simple", ExAny "integer-gmp"] 1117 , Right $ exAv "ghc-prim" 1 [] 1118 , Right $ exAv "integer-simple" 1 [] 1119 , Right $ exAv "integer-gmp" 1 [] 1120 ] 1121 1122db13 :: ExampleDb 1123db13 = [ 1124 Right $ exAv "A" 1 [] 1125 , Right $ exAv "A" 2 [] 1126 , Right $ exAv "A" 3 [] 1127 ] 1128 1129-- | A, B, and C have three different dependencies on D that can be set to 1130-- different versions with qualified constraints. Each version of D can only 1131-- be depended upon by one version of A, B, or C, so that the versions of A, B, 1132-- and C in the install plan indicate which version of D was chosen for each 1133-- dependency. The one-to-one correspondence between versions of A, B, and C and 1134-- versions of D also prevents linking, which would complicate the solver's 1135-- behavior. 1136dbConstraints :: ExampleDb 1137dbConstraints = 1138 [Right $ exAv "A" v [ExFix "D" v] | v <- [1, 4, 7]] 1139 ++ [Right $ exAv "B" v [] `withSetupDeps` [ExFix "D" v] | v <- [2, 5, 8]] 1140 ++ [Right $ exAv "C" v [] `withSetupDeps` [ExFix "D" v] | v <- [3, 6, 9]] 1141 ++ [Right $ exAv "D" v [] | v <- [1..9]] 1142 1143dbStanzaPreferences1 :: ExampleDb 1144dbStanzaPreferences1 = [ 1145 Right $ exAv "pkg" 1 [] `withTest` exTest "test" [ExAny "test-dep"] 1146 , Right $ exAv "test-dep" 1 [] 1147 ] 1148 1149dbStanzaPreferences2 :: ExampleDb 1150dbStanzaPreferences2 = [ 1151 Right $ exAv "pkg" 1 [] `withTest` exTest "test" [ExAny "unknown"] 1152 ] 1153 1154-- | This is a test case for a bug in stanza preferences (#3930). The solver 1155-- should be able to install 'A' by enabling 'flag' and disabling testing. When 1156-- it tries goals in the specified order and prefers testing, it encounters 1157-- 'unknown-pkg2'. 'unknown-pkg2' is only introduced by testing and 'flag', so 1158-- the conflict set should contain both of those variables. Before the fix, it 1159-- only contained 'flag'. The solver backjumped past the choice to disable 1160-- testing and failed to find the solution. 1161testStanzaPreference :: String -> TestTree 1162testStanzaPreference name = 1163 let pkg = exAv "A" 1 [exFlagged "flag" 1164 [] 1165 [ExAny "unknown-pkg1"]] 1166 `withTest` 1167 exTest "test" [exFlagged "flag" 1168 [ExAny "unknown-pkg2"] 1169 []] 1170 goals = [ 1171 P QualNone "A" 1172 , F QualNone "A" "flag" 1173 , S QualNone "A" TestStanzas 1174 ] 1175 in runTest $ goalOrder goals $ 1176 preferences [ ExStanzaPref "A" [TestStanzas]] $ 1177 mkTest [Right pkg] name ["A"] $ 1178 solverSuccess [("A", 1)] 1179 1180-- | Database with some cycles 1181-- 1182-- * Simplest non-trivial cycle: A -> B and B -> A 1183-- * There is a cycle C -> D -> C, but it can be broken by picking the 1184-- right flag assignment. 1185db14 :: ExampleDb 1186db14 = [ 1187 Right $ exAv "A" 1 [ExAny "B"] 1188 , Right $ exAv "B" 1 [ExAny "A"] 1189 , Right $ exAv "C" 1 [exFlagged "flagC" [ExAny "D"] [ExAny "E"]] 1190 , Right $ exAv "D" 1 [ExAny "C"] 1191 , Right $ exAv "E" 1 [] 1192 ] 1193 1194-- | Cycles through setup dependencies 1195-- 1196-- The first cycle is unsolvable: package A has a setup dependency on B, 1197-- B has a regular dependency on A, and we only have a single version available 1198-- for both. 1199-- 1200-- The second cycle can be broken by picking different versions: package C-2.0 1201-- has a setup dependency on D, and D has a regular dependency on C-*. However, 1202-- version C-1.0 is already available (perhaps it didn't have this setup dep). 1203-- Thus, we should be able to break this cycle even if we are installing package 1204-- E, which explicitly depends on C-2.0. 1205db15 :: ExampleDb 1206db15 = [ 1207 -- First example (real cycle, no solution) 1208 Right $ exAv "A" 1 [] `withSetupDeps` [ExAny "B"] 1209 , Right $ exAv "B" 1 [ExAny "A"] 1210 -- Second example (cycle can be broken by picking versions carefully) 1211 , Left $ exInst "C" 1 "C-1-inst" [] 1212 , Right $ exAv "C" 2 [] `withSetupDeps` [ExAny "D"] 1213 , Right $ exAv "D" 1 [ExAny "C" ] 1214 , Right $ exAv "E" 1 [ExFix "C" 2] 1215 ] 1216 1217-- | Detect a cycle between a package and its setup script. 1218-- 1219-- This type of cycle can easily occur when v2-build adds default setup 1220-- dependencies to packages without custom-setup stanzas. For example, cabal 1221-- adds 'time' as a setup dependency for 'time'. The solver should detect the 1222-- cycle when it attempts to link the setup and non-setup instances of the 1223-- package and then choose a different version for the setup dependency. 1224issue4161 :: String -> SolverTest 1225issue4161 name = 1226 setVerbose $ mkTest db name ["target"] $ 1227 SolverResult checkFullLog $ Right [("target", 1), ("time", 1), ("time", 2)] 1228 where 1229 db :: ExampleDb 1230 db = [ 1231 Right $ exAv "target" 1 [ExFix "time" 2] 1232 , Right $ exAv "time" 2 [] `withSetupDeps` [ExAny "time"] 1233 , Right $ exAv "time" 1 [] 1234 ] 1235 1236 checkFullLog :: [String] -> Bool 1237 checkFullLog = any $ isInfixOf $ 1238 "rejecting: time:setup.time~>time-2.0.0 (cyclic dependencies; " 1239 ++ "conflict set: time:setup.time)" 1240 1241-- | Packages pkg-A, pkg-B, and pkg-C form a cycle. The solver should backtrack 1242-- as soon as it chooses the last package in the cycle, to avoid searching parts 1243-- of the tree that have no solution. Since there is no way to break the cycle, 1244-- it should fail with an error message describing the cycle. 1245testCyclicDependencyErrorMessages :: String -> SolverTest 1246testCyclicDependencyErrorMessages name = 1247 goalOrder goals $ 1248 mkTest db name ["pkg-A"] $ 1249 SolverResult checkFullLog $ Left checkSummarizedLog 1250 where 1251 db :: ExampleDb 1252 db = [ 1253 Right $ exAv "pkg-A" 1 [ExAny "pkg-B"] 1254 , Right $ exAv "pkg-B" 1 [ExAny "pkg-C"] 1255 , Right $ exAv "pkg-C" 1 [ExAny "pkg-A", ExAny "pkg-D"] 1256 , Right $ exAv "pkg-D" 1 [ExAny "pkg-E"] 1257 , Right $ exAv "pkg-E" 1 [] 1258 ] 1259 1260 -- The solver should backtrack as soon as pkg-A, pkg-B, and pkg-C form a 1261 -- cycle. It shouldn't try pkg-D or pkg-E. 1262 checkFullLog :: [String] -> Bool 1263 checkFullLog = 1264 not . any (\l -> "pkg-D" `isInfixOf` l || "pkg-E" `isInfixOf` l) 1265 1266 checkSummarizedLog :: String -> Bool 1267 checkSummarizedLog = 1268 isInfixOf "rejecting: pkg-C-1.0.0 (cyclic dependencies; conflict set: pkg-A, pkg-B, pkg-C)" 1269 1270 -- Solve for pkg-D and pkg-E last. 1271 goals :: [ExampleVar] 1272 goals = [P QualNone ("pkg-" ++ [c]) | c <- ['A'..'E']] 1273 1274-- | Check that the solver can backtrack after encountering the SIR (issue #2843) 1275-- 1276-- When A and B are installed as independent goals, the single instance 1277-- restriction prevents B from depending on C. This database tests that the 1278-- solver can backtrack after encountering the single instance restriction and 1279-- choose the only valid flag assignment (-flagA +flagB): 1280-- 1281-- > flagA flagB B depends on 1282-- > On _ C-* 1283-- > Off On E-* <-- only valid flag assignment 1284-- > Off Off D-2.0, C-* 1285-- 1286-- Since A depends on C-* and D-1.0, and C-1.0 depends on any version of D, 1287-- we must build C-1.0 against D-1.0. Since B depends on D-2.0, we cannot have 1288-- C in the transitive closure of B's dependencies, because that would mean we 1289-- would need two instances of C: one built against D-1.0 and one built against 1290-- D-2.0. 1291db16 :: ExampleDb 1292db16 = [ 1293 Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1] 1294 , Right $ exAv "B" 1 [ ExFix "D" 2 1295 , exFlagged "flagA" 1296 [ExAny "C"] 1297 [exFlagged "flagB" 1298 [ExAny "E"] 1299 [ExAny "C"]]] 1300 , Right $ exAv "C" 1 [ExAny "D"] 1301 , Right $ exAv "D" 1 [] 1302 , Right $ exAv "D" 2 [] 1303 , Right $ exAv "E" 1 [] 1304 ] 1305 1306 1307-- Try to get the solver to backtrack while satisfying 1308-- reject-unconstrained-dependencies: both the first and last versions of A 1309-- require packages outside the closed set, so it will have to try the 1310-- middle one. 1311db17 :: ExampleDb 1312db17 = [ 1313 Right $ exAv "A" 1 [ExAny "C"] 1314 , Right $ exAv "A" 2 [ExAny "B"] 1315 , Right $ exAv "A" 3 [ExAny "C"] 1316 , Right $ exAv "B" 1 [] 1317 , Right $ exAv "C" 1 [ExAny "B"] 1318 ] 1319 1320-- | This test checks that when the solver discovers a constraint on a 1321-- package's version after choosing to link that package, it can backtrack to 1322-- try alternative versions for the linked-to package. See pull request #3327. 1323-- 1324-- When A and B are installed as independent goals, their dependencies on C 1325-- must be linked. Since C depends on D, A and B's dependencies on D must also 1326-- be linked. This test fixes the goal order so that the solver chooses D-2 for 1327-- both 0.D and 1.D before it encounters the test suites' constraints. The 1328-- solver must backtrack to try D-1 for both 0.D and 1.D. 1329testIndepGoals2 :: String -> SolverTest 1330testIndepGoals2 name = 1331 goalOrder goals $ independentGoals $ 1332 enableAllTests $ mkTest db name ["A", "B"] $ 1333 solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)] 1334 where 1335 db :: ExampleDb 1336 db = [ 1337 Right $ exAv "A" 1 [ExAny "C"] `withTest` exTest "test" [ExFix "D" 1] 1338 , Right $ exAv "B" 1 [ExAny "C"] `withTest` exTest "test" [ExFix "D" 1] 1339 , Right $ exAv "C" 1 [ExAny "D"] 1340 , Right $ exAv "D" 1 [] 1341 , Right $ exAv "D" 2 [] 1342 ] 1343 1344 goals :: [ExampleVar] 1345 goals = [ 1346 P (QualIndep "A") "A" 1347 , P (QualIndep "A") "C" 1348 , P (QualIndep "A") "D" 1349 , P (QualIndep "B") "B" 1350 , P (QualIndep "B") "C" 1351 , P (QualIndep "B") "D" 1352 , S (QualIndep "B") "B" TestStanzas 1353 , S (QualIndep "A") "A" TestStanzas 1354 ] 1355 1356-- | Issue #2834 1357-- When both A and B are installed as independent goals, their dependencies on 1358-- C must be linked. The only combination of C's flags that is consistent with 1359-- A and B's dependencies on D is -flagA +flagB. This database tests that the 1360-- solver can backtrack to find the right combination of flags (requiring F, but 1361-- not E or G) and apply it to both 0.C and 1.C. 1362-- 1363-- > flagA flagB C depends on 1364-- > On _ D-1, E-* 1365-- > Off On F-* <-- Only valid choice 1366-- > Off Off D-2, G-* 1367-- 1368-- The single instance restriction means we cannot have one instance of C 1369-- built against D-1 and one instance built against D-2; since A depends on 1370-- D-1, and B depends on C-2, it is therefore important that C cannot depend 1371-- on any version of D. 1372db18 :: ExampleDb 1373db18 = [ 1374 Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1] 1375 , Right $ exAv "B" 1 [ExAny "C", ExFix "D" 2] 1376 , Right $ exAv "C" 1 [exFlagged "flagA" 1377 [ExFix "D" 1, ExAny "E"] 1378 [exFlagged "flagB" 1379 [ExAny "F"] 1380 [ExFix "D" 2, ExAny "G"]]] 1381 , Right $ exAv "D" 1 [] 1382 , Right $ exAv "D" 2 [] 1383 , Right $ exAv "E" 1 [] 1384 , Right $ exAv "F" 1 [] 1385 , Right $ exAv "G" 1 [] 1386 ] 1387 1388-- | When both values for flagA introduce package B, the solver should be able 1389-- to choose B before choosing a value for flagA. It should try to choose a 1390-- version for B that is in the union of the version ranges required by +flagA 1391-- and -flagA. 1392commonDependencyLogMessage :: String -> SolverTest 1393commonDependencyLogMessage name = 1394 mkTest db name ["A"] $ solverFailure $ isInfixOf $ 1395 "[__0] trying: A-1.0.0 (user goal)\n" 1396 ++ "[__1] next goal: B (dependency of A +/-flagA)\n" 1397 ++ "[__1] rejecting: B-2.0.0 (conflict: A +/-flagA => B==1.0.0 || ==3.0.0)" 1398 where 1399 db :: ExampleDb 1400 db = [ 1401 Right $ exAv "A" 1 [exFlagged "flagA" 1402 [ExFix "B" 1] 1403 [ExFix "B" 3]] 1404 , Right $ exAv "B" 2 [] 1405 ] 1406 1407-- | Test lifting dependencies out of multiple levels of conditionals. 1408twoLevelDeepCommonDependencyLogMessage :: String -> SolverTest 1409twoLevelDeepCommonDependencyLogMessage name = 1410 mkTest db name ["A"] $ solverFailure $ isInfixOf $ 1411 "unknown package: B (dependency of A +/-flagA +/-flagB)" 1412 where 1413 db :: ExampleDb 1414 db = [ 1415 Right $ exAv "A" 1 [exFlagged "flagA" 1416 [exFlagged "flagB" 1417 [ExAny "B"] 1418 [ExAny "B"]] 1419 [exFlagged "flagB" 1420 [ExAny "B"] 1421 [ExAny "B"]]] 1422 ] 1423 1424-- | Test handling nested conditionals that are controlled by the same flag. 1425-- The solver should treat flagA as introducing 'unknown' with value true, not 1426-- both true and false. That means that when +flagA causes a conflict, the 1427-- solver should try flipping flagA to false to resolve the conflict, rather 1428-- than backjumping past flagA. 1429testBackjumpingWithCommonDependency :: String -> SolverTest 1430testBackjumpingWithCommonDependency name = 1431 mkTest db name ["A"] $ solverSuccess [("A", 1), ("B", 1)] 1432 where 1433 db :: ExampleDb 1434 db = [ 1435 Right $ exAv "A" 1 [exFlagged "flagA" 1436 [exFlagged "flagA" 1437 [ExAny "unknown"] 1438 [ExAny "unknown"]] 1439 [ExAny "B"]] 1440 , Right $ exAv "B" 1 [] 1441 ] 1442 1443-- | Tricky test case with independent goals (issue #2842) 1444-- 1445-- Suppose we are installing D, E, and F as independent goals: 1446-- 1447-- * D depends on A-* and C-1, requiring A-1 to be built against C-1 1448-- * E depends on B-* and C-2, requiring B-1 to be built against C-2 1449-- * F depends on A-* and B-*; this means we need A-1 and B-1 both to be built 1450-- against the same version of C, violating the single instance restriction. 1451-- 1452-- We can visualize this DB as: 1453-- 1454-- > C-1 C-2 1455-- > /|\ /|\ 1456-- > / | \ / | \ 1457-- > / | X | \ 1458-- > | | / \ | | 1459-- > | |/ \| | 1460-- > | + + | 1461-- > | | | | 1462-- > | A B | 1463-- > \ |\ /| / 1464-- > \ | \ / | / 1465-- > \| V |/ 1466-- > D F E 1467testIndepGoals3 :: String -> SolverTest 1468testIndepGoals3 name = 1469 goalOrder goals $ independentGoals $ 1470 mkTest db name ["D", "E", "F"] anySolverFailure 1471 where 1472 db :: ExampleDb 1473 db = [ 1474 Right $ exAv "A" 1 [ExAny "C"] 1475 , Right $ exAv "B" 1 [ExAny "C"] 1476 , Right $ exAv "C" 1 [] 1477 , Right $ exAv "C" 2 [] 1478 , Right $ exAv "D" 1 [ExAny "A", ExFix "C" 1] 1479 , Right $ exAv "E" 1 [ExAny "B", ExFix "C" 2] 1480 , Right $ exAv "F" 1 [ExAny "A", ExAny "B"] 1481 ] 1482 1483 goals :: [ExampleVar] 1484 goals = [ 1485 P (QualIndep "D") "D" 1486 , P (QualIndep "D") "C" 1487 , P (QualIndep "D") "A" 1488 , P (QualIndep "E") "E" 1489 , P (QualIndep "E") "C" 1490 , P (QualIndep "E") "B" 1491 , P (QualIndep "F") "F" 1492 , P (QualIndep "F") "B" 1493 , P (QualIndep "F") "C" 1494 , P (QualIndep "F") "A" 1495 ] 1496 1497-- | This test checks that the solver correctly backjumps when dependencies 1498-- of linked packages are not linked. It is an example where the conflict set 1499-- from enforcing the single instance restriction is not sufficient. See pull 1500-- request #3327. 1501-- 1502-- When A, B, and C are installed as independent goals with the specified goal 1503-- order, the first choice that the solver makes for E is 0.E-2. Then, when it 1504-- chooses dependencies for B and C, it links both 1.E and 2.E to 0.E. Finally, 1505-- the solver discovers C's test's constraint on E. It must backtrack to try 1506-- 1.E-1 and then link 2.E to 1.E. Backjumping all the way to 0.E does not lead 1507-- to a solution, because 0.E's version is constrained by A and cannot be 1508-- changed. 1509testIndepGoals4 :: String -> SolverTest 1510testIndepGoals4 name = 1511 goalOrder goals $ independentGoals $ 1512 enableAllTests $ mkTest db name ["A", "B", "C"] $ 1513 solverSuccess [("A",1), ("B",1), ("C",1), ("D",1), ("E",1), ("E",2)] 1514 where 1515 db :: ExampleDb 1516 db = [ 1517 Right $ exAv "A" 1 [ExFix "E" 2] 1518 , Right $ exAv "B" 1 [ExAny "D"] 1519 , Right $ exAv "C" 1 [ExAny "D"] `withTest` exTest "test" [ExFix "E" 1] 1520 , Right $ exAv "D" 1 [ExAny "E"] 1521 , Right $ exAv "E" 1 [] 1522 , Right $ exAv "E" 2 [] 1523 ] 1524 1525 goals :: [ExampleVar] 1526 goals = [ 1527 P (QualIndep "A") "A" 1528 , P (QualIndep "A") "E" 1529 , P (QualIndep "B") "B" 1530 , P (QualIndep "B") "D" 1531 , P (QualIndep "B") "E" 1532 , P (QualIndep "C") "C" 1533 , P (QualIndep "C") "D" 1534 , P (QualIndep "C") "E" 1535 , S (QualIndep "C") "C" TestStanzas 1536 ] 1537 1538-- | Test the trace messages that we get when a package refers to an unknown pkg 1539-- 1540-- TODO: Currently we don't actually test the trace messages, and this particular 1541-- test still succeeds. The trace can only be verified by hand. 1542db21 :: ExampleDb 1543db21 = [ 1544 Right $ exAv "A" 1 [ExAny "B"] 1545 , Right $ exAv "A" 2 [ExAny "C"] -- A-2.0 will be tried first, but C unknown 1546 , Right $ exAv "B" 1 [] 1547 ] 1548 1549-- | A variant of 'db21', which actually fails. 1550db22 :: ExampleDb 1551db22 = [ 1552 Right $ exAv "A" 1 [ExAny "B"] 1553 , Right $ exAv "A" 2 [ExAny "C"] 1554 ] 1555 1556-- | Another test for the unknown package message. This database tests that 1557-- filtering out redundant conflict set messages in the solver log doesn't 1558-- interfere with generating a message about a missing package (part of issue 1559-- #3617). The conflict set for the missing package is {A, B}. That conflict set 1560-- is propagated up the tree to the level of A. Since the conflict set is the 1561-- same at both levels, the solver only keeps one of the backjumping messages. 1562db23 :: ExampleDb 1563db23 = [ 1564 Right $ exAv "A" 1 [ExAny "B"] 1565 ] 1566 1567-- | Database for (unsuccessfully) trying to expose a bug in the handling 1568-- of implied linking constraints. The question is whether an implied linking 1569-- constraint should only have the introducing package in its conflict set, 1570-- or also its link target. 1571-- 1572-- It turns out that as long as the Single Instance Restriction is in place, 1573-- it does not matter, because there will aways be an option that is failing 1574-- due to the SIR, which contains the link target in its conflict set. 1575-- 1576-- Even if the SIR is not in place, if there is a solution, one will always 1577-- be found, because without the SIR, linking is always optional, but never 1578-- necessary. 1579-- 1580testIndepGoals5 :: String -> GoalOrder -> SolverTest 1581testIndepGoals5 name fixGoalOrder = 1582 case fixGoalOrder of 1583 FixedGoalOrder -> goalOrder goals test 1584 DefaultGoalOrder -> test 1585 where 1586 test :: SolverTest 1587 test = independentGoals $ mkTest db name ["X", "Y"] $ 1588 solverSuccess 1589 [("A", 1), ("A", 2), ("B", 1), ("C", 1), ("C", 2), ("X", 1), ("Y", 1)] 1590 1591 db :: ExampleDb 1592 db = [ 1593 Right $ exAv "X" 1 [ExFix "C" 2, ExAny "A"] 1594 , Right $ exAv "Y" 1 [ExFix "C" 1, ExFix "A" 2] 1595 , Right $ exAv "A" 1 [] 1596 , Right $ exAv "A" 2 [ExAny "B"] 1597 , Right $ exAv "B" 1 [ExAny "C"] 1598 , Right $ exAv "C" 1 [] 1599 , Right $ exAv "C" 2 [] 1600 ] 1601 1602 goals :: [ExampleVar] 1603 goals = [ 1604 P (QualIndep "X") "X" 1605 , P (QualIndep "X") "A" 1606 , P (QualIndep "X") "B" 1607 , P (QualIndep "X") "C" 1608 , P (QualIndep "Y") "Y" 1609 , P (QualIndep "Y") "A" 1610 , P (QualIndep "Y") "B" 1611 , P (QualIndep "Y") "C" 1612 ] 1613 1614-- | A simplified version of 'testIndepGoals5'. 1615testIndepGoals6 :: String -> GoalOrder -> SolverTest 1616testIndepGoals6 name fixGoalOrder = 1617 case fixGoalOrder of 1618 FixedGoalOrder -> goalOrder goals test 1619 DefaultGoalOrder -> test 1620 where 1621 test :: SolverTest 1622 test = independentGoals $ mkTest db name ["X", "Y"] $ 1623 solverSuccess 1624 [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("X", 1), ("Y", 1)] 1625 1626 db :: ExampleDb 1627 db = [ 1628 Right $ exAv "X" 1 [ExFix "B" 2, ExAny "A"] 1629 , Right $ exAv "Y" 1 [ExFix "B" 1, ExFix "A" 2] 1630 , Right $ exAv "A" 1 [] 1631 , Right $ exAv "A" 2 [ExAny "B"] 1632 , Right $ exAv "B" 1 [] 1633 , Right $ exAv "B" 2 [] 1634 ] 1635 1636 goals :: [ExampleVar] 1637 goals = [ 1638 P (QualIndep "X") "X" 1639 , P (QualIndep "X") "A" 1640 , P (QualIndep "X") "B" 1641 , P (QualIndep "Y") "Y" 1642 , P (QualIndep "Y") "A" 1643 , P (QualIndep "Y") "B" 1644 ] 1645 1646dbExts1 :: ExampleDb 1647dbExts1 = [ 1648 Right $ exAv "A" 1 [ExExt (EnableExtension RankNTypes)] 1649 , Right $ exAv "B" 1 [ExExt (EnableExtension CPP), ExAny "A"] 1650 , Right $ exAv "C" 1 [ExAny "B"] 1651 , Right $ exAv "D" 1 [ExExt (DisableExtension CPP), ExAny "B"] 1652 , Right $ exAv "E" 1 [ExExt (UnknownExtension "custom"), ExAny "C"] 1653 ] 1654 1655dbLangs1 :: ExampleDb 1656dbLangs1 = [ 1657 Right $ exAv "A" 1 [ExLang Haskell2010] 1658 , Right $ exAv "B" 1 [ExLang Haskell98, ExAny "A"] 1659 , Right $ exAv "C" 1 [ExLang (UnknownLanguage "Haskell3000"), ExAny "B"] 1660 ] 1661 1662-- | cabal must set enable-exe to false in order to avoid the unavailable 1663-- dependency. Flags are true by default. The flag choice causes "pkg" to 1664-- depend on "false-dep". 1665testBuildable :: String -> ExampleDependency -> TestTree 1666testBuildable testName unavailableDep = 1667 runTest $ 1668 mkTestExtLangPC (Just []) (Just [Haskell98]) [] db testName ["pkg"] expected 1669 where 1670 expected = solverSuccess [("false-dep", 1), ("pkg", 1)] 1671 db = [ 1672 Right $ exAv "pkg" 1 [exFlagged "enable-exe" 1673 [ExAny "true-dep"] 1674 [ExAny "false-dep"]] 1675 `withExe` 1676 exExe "exe" [ unavailableDep 1677 , ExFlagged "enable-exe" (dependencies []) unbuildableDependencies ] 1678 , Right $ exAv "true-dep" 1 [] 1679 , Right $ exAv "false-dep" 1 [] 1680 ] 1681 1682-- | cabal must choose -flag1 +flag2 for "pkg", which requires packages 1683-- "flag1-false" and "flag2-true". 1684dbBuildable1 :: ExampleDb 1685dbBuildable1 = [ 1686 Right $ exAv "pkg" 1 1687 [ exFlagged "flag1" [ExAny "flag1-true"] [ExAny "flag1-false"] 1688 , exFlagged "flag2" [ExAny "flag2-true"] [ExAny "flag2-false"]] 1689 `withExes` 1690 [ exExe "exe1" 1691 [ ExAny "unknown" 1692 , ExFlagged "flag1" (dependencies []) unbuildableDependencies 1693 , ExFlagged "flag2" (dependencies []) unbuildableDependencies] 1694 , exExe "exe2" 1695 [ ExAny "unknown" 1696 , ExFlagged "flag1" 1697 (dependencies []) 1698 (dependencies [ExFlagged "flag2" unbuildableDependencies (dependencies [])])] 1699 ] 1700 , Right $ exAv "flag1-true" 1 [] 1701 , Right $ exAv "flag1-false" 1 [] 1702 , Right $ exAv "flag2-true" 1 [] 1703 , Right $ exAv "flag2-false" 1 [] 1704 ] 1705 1706-- | cabal must pick B-2 to avoid the unknown dependency. 1707dbBuildable2 :: ExampleDb 1708dbBuildable2 = [ 1709 Right $ exAv "A" 1 [ExAny "B"] 1710 , Right $ exAv "B" 1 [ExAny "unknown"] 1711 , Right $ exAv "B" 2 [] 1712 `withExe` 1713 exExe "exe" 1714 [ ExAny "unknown" 1715 , ExFlagged "disable-exe" unbuildableDependencies (dependencies []) 1716 ] 1717 , Right $ exAv "B" 3 [ExAny "unknown"] 1718 ] 1719 1720-- | Package databases for testing @pkg-config@ dependencies. 1721dbPC1 :: ExampleDb 1722dbPC1 = [ 1723 Right $ exAv "A" 1 [ExPkg ("pkgA", 1)] 1724 , Right $ exAv "B" 1 [ExPkg ("pkgB", 1), ExAny "A"] 1725 , Right $ exAv "B" 2 [ExPkg ("pkgB", 2), ExAny "A"] 1726 , Right $ exAv "C" 1 [ExAny "B"] 1727 ] 1728 1729-- | Test for the solver's summarized log. The final conflict set is {A, F}, 1730-- though the goal order forces the solver to find the (avoidable) conflict 1731-- between B and C first. When the solver reaches the backjump limit, it should 1732-- only show the log to the first conflict. When the backjump limit is high 1733-- enough to allow an exhaustive search, the solver should make use of the final 1734-- conflict set to only show the conflict between A and F in the summarized log. 1735testSummarizedLog :: String -> Maybe Int -> String -> TestTree 1736testSummarizedLog testName mbj expectedMsg = 1737 runTest $ maxBackjumps mbj $ goalOrder goals $ mkTest db testName ["A"] $ 1738 solverFailure (== expectedMsg) 1739 where 1740 db = [ 1741 Right $ exAv "A" 1 [ExAny "B", ExAny "F"] 1742 , Right $ exAv "B" 3 [ExAny "C"] 1743 , Right $ exAv "B" 2 [ExAny "D"] 1744 , Right $ exAv "B" 1 [ExAny "E"] 1745 , Right $ exAv "E" 1 [] 1746 ] 1747 1748 goals :: [ExampleVar] 1749 goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D", "E", "F"]] 1750 1751dbMinimizeConflictSet :: ExampleDb 1752dbMinimizeConflictSet = [ 1753 Right $ exAv "A" 3 [ExFix "B" 2, ExFix "C" 1, ExFix "D" 2] 1754 , Right $ exAv "A" 2 [ExFix "B" 1, ExFix "C" 2, ExFix "D" 2] 1755 , Right $ exAv "A" 1 [ExFix "B" 1, ExFix "C" 1, ExFix "D" 2] 1756 , Right $ exAv "B" 1 [] 1757 , Right $ exAv "C" 1 [] 1758 , Right $ exAv "D" 1 [] 1759 ] 1760 1761-- | Test that the solver can find a minimal conflict set with 1762-- --minimize-conflict-set. In the first run, the goal order causes the solver 1763-- to find that A-3 conflicts with B, A-2 conflicts with C, and A-1 conflicts 1764-- with D. The full log should show that the original final conflict set is 1765-- {A, B, C, D}. Then the solver should be able to reduce the conflict set to 1766-- {A, D}, since all versions of A conflict with D. The summarized log should 1767-- only mention A and D. 1768testMinimizeConflictSet :: String -> TestTree 1769testMinimizeConflictSet testName = 1770 runTest $ minimizeConflictSet $ goalOrder goals $ setVerbose $ 1771 mkTest dbMinimizeConflictSet testName ["A"] $ 1772 SolverResult checkFullLog (Left (== expectedMsg)) 1773 where 1774 checkFullLog :: [String] -> Bool 1775 checkFullLog = containsInOrder [ 1776 "[__0] fail (backjumping, conflict set: A, B, C, D)" 1777 , "Found no solution after exhaustively searching the dependency tree. " 1778 ++ "Rerunning the dependency solver to minimize the conflict set ({A, B, C, D})." 1779 , "Trying to remove variable \"A\" from the conflict set." 1780 , "Failed to remove \"A\" from the conflict set. Continuing with {A, B, C, D}." 1781 , "Trying to remove variable \"B\" from the conflict set." 1782 , "Successfully removed \"B\" from the conflict set. Continuing with {A, D}." 1783 , "Trying to remove variable \"D\" from the conflict set." 1784 , "Failed to remove \"D\" from the conflict set. Continuing with {A, D}." 1785 ] 1786 1787 expectedMsg = 1788 "Could not resolve dependencies:\n" 1789 ++ "[__0] trying: A-3.0.0 (user goal)\n" 1790 ++ "[__1] next goal: D (dependency of A)\n" 1791 ++ "[__1] rejecting: D-1.0.0 (conflict: A => D==2.0.0)\n" 1792 ++ "[__1] fail (backjumping, conflict set: A, D)\n" 1793 ++ "After searching the rest of the dependency tree exhaustively, these " 1794 ++ "were the goals I've had most trouble fulfilling: A (5), D (4)" 1795 1796 goals :: [ExampleVar] 1797 goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]] 1798 1799-- | This test uses the same packages and goal order as testMinimizeConflictSet, 1800-- but it doesn't set --minimize-conflict-set. The solver should print the 1801-- original final conflict set and the conflict between A and B. It should also 1802-- suggest rerunning with --minimize-conflict-set. 1803testNoMinimizeConflictSet :: String -> TestTree 1804testNoMinimizeConflictSet testName = 1805 runTest $ goalOrder goals $ setVerbose $ 1806 mkTest dbMinimizeConflictSet testName ["A"] $ 1807 solverFailure (== expectedMsg) 1808 where 1809 expectedMsg = 1810 "Could not resolve dependencies:\n" 1811 ++ "[__0] trying: A-3.0.0 (user goal)\n" 1812 ++ "[__1] next goal: B (dependency of A)\n" 1813 ++ "[__1] rejecting: B-1.0.0 (conflict: A => B==2.0.0)\n" 1814 ++ "[__1] fail (backjumping, conflict set: A, B)\n" 1815 ++ "After searching the rest of the dependency tree exhaustively, " 1816 ++ "these were the goals I've had most trouble fulfilling: " 1817 ++ "A (7), B (2), C (2), D (2)\n" 1818 ++ "Try running with --minimize-conflict-set to improve the error message." 1819 1820 goals :: [ExampleVar] 1821 goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]] 1822 1823{------------------------------------------------------------------------------- 1824 Simple databases for the illustrations for the backjumping blog post 1825-------------------------------------------------------------------------------} 1826 1827-- | Motivate conflict sets 1828dbBJ1a :: ExampleDb 1829dbBJ1a = [ 1830 Right $ exAv "A" 1 [ExFix "B" 1] 1831 , Right $ exAv "A" 2 [ExFix "B" 2] 1832 , Right $ exAv "B" 1 [] 1833 ] 1834 1835-- | Show that we can skip some decisions 1836dbBJ1b :: ExampleDb 1837dbBJ1b = [ 1838 Right $ exAv "A" 1 [ExFix "B" 1] 1839 , Right $ exAv "A" 2 [ExFix "B" 2, ExAny "C"] 1840 , Right $ exAv "B" 1 [] 1841 , Right $ exAv "C" 1 [] 1842 , Right $ exAv "C" 2 [] 1843 ] 1844 1845-- | Motivate why both A and B need to be in the conflict set 1846dbBJ1c :: ExampleDb 1847dbBJ1c = [ 1848 Right $ exAv "A" 1 [ExFix "B" 1] 1849 , Right $ exAv "B" 1 [] 1850 , Right $ exAv "B" 2 [] 1851 ] 1852 1853-- | Motivate the need for accumulating conflict sets while we walk the tree 1854dbBJ2 :: ExampleDb 1855dbBJ2 = [ 1856 Right $ exAv "A" 1 [ExFix "B" 1] 1857 , Right $ exAv "A" 2 [ExFix "B" 2] 1858 , Right $ exAv "B" 1 [ExFix "C" 1] 1859 , Right $ exAv "B" 2 [ExFix "C" 2] 1860 , Right $ exAv "C" 1 [] 1861 ] 1862 1863-- | Motivate the need for `QGoalReason` 1864dbBJ3 :: ExampleDb 1865dbBJ3 = [ 1866 Right $ exAv "A" 1 [ExAny "Ba"] 1867 , Right $ exAv "A" 2 [ExAny "Bb"] 1868 , Right $ exAv "Ba" 1 [ExFix "C" 1] 1869 , Right $ exAv "Bb" 1 [ExFix "C" 2] 1870 , Right $ exAv "C" 1 [] 1871 ] 1872 1873-- | `QGOalReason` not unique 1874dbBJ4 :: ExampleDb 1875dbBJ4 = [ 1876 Right $ exAv "A" 1 [ExAny "B", ExAny "C"] 1877 , Right $ exAv "B" 1 [ExAny "C"] 1878 , Right $ exAv "C" 1 [] 1879 ] 1880 1881-- | Flags are represented somewhat strangely in the tree 1882-- 1883-- This example probably won't be in the blog post itself but as a separate 1884-- bug report (#3409) 1885dbBJ5 :: ExampleDb 1886dbBJ5 = [ 1887 Right $ exAv "A" 1 [exFlagged "flagA" [ExFix "B" 1] [ExFix "C" 1]] 1888 , Right $ exAv "B" 1 [ExFix "D" 1] 1889 , Right $ exAv "C" 1 [ExFix "D" 2] 1890 , Right $ exAv "D" 1 [] 1891 ] 1892 1893-- | Conflict sets for cycles 1894dbBJ6 :: ExampleDb 1895dbBJ6 = [ 1896 Right $ exAv "A" 1 [ExAny "B"] 1897 , Right $ exAv "B" 1 [] 1898 , Right $ exAv "B" 2 [ExAny "C"] 1899 , Right $ exAv "C" 1 [ExAny "A"] 1900 ] 1901 1902-- | Conflicts not unique 1903dbBJ7 :: ExampleDb 1904dbBJ7 = [ 1905 Right $ exAv "A" 1 [ExAny "B", ExFix "C" 1] 1906 , Right $ exAv "B" 1 [ExFix "C" 1] 1907 , Right $ exAv "C" 1 [] 1908 , Right $ exAv "C" 2 [] 1909 ] 1910 1911-- | Conflict sets for SIR (C shared subgoal of independent goals A, B) 1912dbBJ8 :: ExampleDb 1913dbBJ8 = [ 1914 Right $ exAv "A" 1 [ExAny "C"] 1915 , Right $ exAv "B" 1 [ExAny "C"] 1916 , Right $ exAv "C" 1 [] 1917 ] 1918 1919{------------------------------------------------------------------------------- 1920 Databases for build-tool-depends 1921-------------------------------------------------------------------------------} 1922 1923-- | Multiple packages depending on exes from 'bt-pkg'. 1924dbBuildTools :: ExampleDb 1925dbBuildTools = [ 1926 Right $ exAv "A" 1 [ExBuildToolAny "bt-pkg" "exe1"] 1927 , Right $ exAv "B" 1 [exFlagged "flagB" [ExAny "unknown"] 1928 [ExBuildToolAny "bt-pkg" "exe1"]] 1929 , Right $ exAv "C" 1 [] `withTest` exTest "testC" [ExBuildToolAny "bt-pkg" "exe1"] 1930 , Right $ exAv "D" 1 [ExBuildToolAny "bt-pkg" "unknown-exe"] 1931 , Right $ exAv "E" 1 [ExBuildToolAny "unknown-pkg" "exe1"] 1932 , Right $ exAv "F" 1 [exFlagged "flagF" [ExBuildToolAny "bt-pkg" "unknown-exe"] 1933 [ExAny "unknown"]] 1934 , Right $ exAv "G" 1 [] `withTest` exTest "testG" [ExBuildToolAny "bt-pkg" "unknown-exe"] 1935 , Right $ exAv "H" 1 [ExBuildToolFix "bt-pkg" "exe1" 3] 1936 1937 , Right $ exAv "bt-pkg" 4 [] 1938 , Right $ exAv "bt-pkg" 3 [] `withExe` exExe "exe2" [] 1939 , Right $ exAv "bt-pkg" 2 [] `withExe` exExe "exe1" [] 1940 , Right $ exAv "bt-pkg" 1 [] 1941 ] 1942 1943-- The solver should never choose an installed package for a build tool 1944-- dependency. 1945rejectInstalledBuildToolPackage :: String -> SolverTest 1946rejectInstalledBuildToolPackage name = 1947 mkTest db name ["A"] $ solverFailure $ isInfixOf $ 1948 "rejecting: A:B:exe.B-1.0.0/installed-1 " 1949 ++ "(does not contain executable 'exe', which is required by A)" 1950 where 1951 db :: ExampleDb 1952 db = [ 1953 Right $ exAv "A" 1 [ExBuildToolAny "B" "exe"] 1954 , Left $ exInst "B" 1 "B-1" [] 1955 ] 1956 1957-- | This test forces the solver to choose B as a build-tool dependency before 1958-- it sees the dependency on executable exe2 from B. The solver needs to check 1959-- that the version that it already chose for B contains the necessary 1960-- executable. This order causes a different "missing executable" error message 1961-- than when the solver checks for the executable in the same step that it 1962-- chooses the build-tool package. 1963-- 1964-- This case may become impossible if we ever add the executable name to the 1965-- build-tool goal qualifier. Then this test would involve two qualified goals 1966-- for B, one for exe1 and another for exe2. 1967chooseExeAfterBuildToolsPackage :: Bool -> String -> SolverTest 1968chooseExeAfterBuildToolsPackage shouldSucceed name = 1969 goalOrder goals $ mkTest db name ["A"] $ 1970 if shouldSucceed 1971 then solverSuccess [("A", 1), ("B", 1)] 1972 else solverFailure $ isInfixOf $ 1973 "rejecting: A:+flagA (requires executable 'exe2' from A:B:exe.B, " 1974 ++ "but the component does not exist)" 1975 where 1976 db :: ExampleDb 1977 db = [ 1978 Right $ exAv "A" 1 [ ExBuildToolAny "B" "exe1" 1979 , exFlagged "flagA" [ExBuildToolAny "B" "exe2"] 1980 [ExAny "unknown"]] 1981 , Right $ exAv "B" 1 [] 1982 `withExes` 1983 [exExe exe [] | exe <- if shouldSucceed then ["exe1", "exe2"] else ["exe1"]] 1984 ] 1985 1986 goals :: [ExampleVar] 1987 goals = [ 1988 P QualNone "A" 1989 , P (QualExe "A" "B") "B" 1990 , F QualNone "A" "flagA" 1991 ] 1992 1993-- | Test that when one package depends on two executables from another package, 1994-- both executables must come from the same instance of that package. We could 1995-- lift this restriction in the future by adding the executable name to the goal 1996-- qualifier. 1997requireConsistentBuildToolVersions :: String -> SolverTest 1998requireConsistentBuildToolVersions name = 1999 mkTest db name ["A"] $ solverFailure $ isInfixOf $ 2000 "[__1] rejecting: A:B:exe.B-2.0.0 (conflict: A => A:B:exe.B (exe exe1)==1.0.0)\n" 2001 ++ "[__1] rejecting: A:B:exe.B-1.0.0 (conflict: A => A:B:exe.B (exe exe2)==2.0.0)" 2002 where 2003 db :: ExampleDb 2004 db = [ 2005 Right $ exAv "A" 1 [ ExBuildToolFix "B" "exe1" 1 2006 , ExBuildToolFix "B" "exe2" 2 ] 2007 , Right $ exAv "B" 2 [] `withExes` exes 2008 , Right $ exAv "B" 1 [] `withExes` exes 2009 ] 2010 2011 exes = [exExe "exe1" [], exExe "exe2" []] 2012 2013-- | This test is similar to the failure case for 2014-- chooseExeAfterBuildToolsPackage, except that the build tool is unbuildable 2015-- instead of missing. 2016chooseUnbuildableExeAfterBuildToolsPackage :: String -> SolverTest 2017chooseUnbuildableExeAfterBuildToolsPackage name = 2018 constraints [ExFlagConstraint (ScopeAnyQualifier "B") "build-bt2" False] $ 2019 goalOrder goals $ 2020 mkTest db name ["A"] $ solverFailure $ isInfixOf $ 2021 "rejecting: A:+use-bt2 (requires executable 'bt2' from A:B:exe.B, but " 2022 ++ "the component is not buildable in the current environment)" 2023 where 2024 db :: ExampleDb 2025 db = [ 2026 Right $ exAv "A" 1 [ ExBuildToolAny "B" "bt1" 2027 , exFlagged "use-bt2" [ExBuildToolAny "B" "bt2"] 2028 [ExAny "unknown"]] 2029 , Right $ exAvNoLibrary "B" 1 2030 `withExes` 2031 [ exExe "bt1" [] 2032 , exExe "bt2" [ExFlagged "build-bt2" (dependencies []) unbuildableDependencies] 2033 ] 2034 ] 2035 2036 goals :: [ExampleVar] 2037 goals = [ 2038 P QualNone "A" 2039 , P (QualExe "A" "B") "B" 2040 , F QualNone "A" "use-bt2" 2041 ] 2042 2043{------------------------------------------------------------------------------- 2044 Databases for legacy build-tools 2045-------------------------------------------------------------------------------} 2046dbLegacyBuildTools1 :: ExampleDb 2047dbLegacyBuildTools1 = [ 2048 Right $ exAv "alex" 1 [] `withExe` exExe "alex" [], 2049 Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"] 2050 ] 2051 2052-- Test that a recognized build tool dependency specifies the name of both the 2053-- package and the executable. This db has no solution. 2054dbLegacyBuildTools2 :: ExampleDb 2055dbLegacyBuildTools2 = [ 2056 Right $ exAv "alex" 1 [] `withExe` exExe "other-exe" [], 2057 Right $ exAv "other-package" 1 [] `withExe` exExe "alex" [], 2058 Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"] 2059 ] 2060 2061-- Test that build-tools on a random thing doesn't matter (only 2062-- the ones we recognize need to be in db) 2063dbLegacyBuildTools3 :: ExampleDb 2064dbLegacyBuildTools3 = [ 2065 Right $ exAv "A" 1 [ExLegacyBuildToolAny "otherdude"] 2066 ] 2067 2068-- Test that we can solve for different versions of executables 2069dbLegacyBuildTools4 :: ExampleDb 2070dbLegacyBuildTools4 = [ 2071 Right $ exAv "alex" 1 [] `withExe` exExe "alex" [], 2072 Right $ exAv "alex" 2 [] `withExe` exExe "alex" [], 2073 Right $ exAv "A" 1 [ExLegacyBuildToolFix "alex" 1], 2074 Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 2], 2075 Right $ exAv "C" 1 [ExAny "A", ExAny "B"] 2076 ] 2077 2078-- Test that exe is not related to library choices 2079dbLegacyBuildTools5 :: ExampleDb 2080dbLegacyBuildTools5 = [ 2081 Right $ exAv "alex" 1 [ExFix "A" 1] `withExe` exExe "alex" [], 2082 Right $ exAv "A" 1 [], 2083 Right $ exAv "A" 2 [], 2084 Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 1, ExFix "A" 2] 2085 ] 2086 2087-- Test that build-tools on build-tools works 2088dbLegacyBuildTools6 :: ExampleDb 2089dbLegacyBuildTools6 = [ 2090 Right $ exAv "alex" 1 [] `withExe` exExe "alex" [], 2091 Right $ exAv "happy" 1 [ExLegacyBuildToolAny "alex"] `withExe` exExe "happy" [], 2092 Right $ exAv "A" 1 [ExLegacyBuildToolAny "happy"] 2093 ] 2094 2095-- Test that build-depends on library/executable package works. 2096-- Extracted from https://github.com/haskell/cabal/issues/3775 2097dbIssue3775 :: ExampleDb 2098dbIssue3775 = [ 2099 Right $ exAv "warp" 1 [], 2100 -- NB: the warp build-depends refers to the package, not the internal 2101 -- executable! 2102 Right $ exAv "A" 2 [ExFix "warp" 1] `withExe` exExe "warp" [ExAny "A"], 2103 Right $ exAv "B" 2 [ExAny "A", ExAny "warp"] 2104 ] 2105 2106-- | Returns true if the second list contains all elements of the first list, in 2107-- order. 2108containsInOrder :: Eq a => [a] -> [a] -> Bool 2109containsInOrder [] _ = True 2110containsInOrder _ [] = False 2111containsInOrder (x:xs) (y:ys) 2112 | x == y = containsInOrder xs ys 2113 | otherwise = containsInOrder (x:xs) ys 2114