Skip to content

Commit

Permalink
Merge pull request #3929 from grayjay/stanza-preference-tests
Browse files Browse the repository at this point in the history 
Add unit tests for solver stanza preferences.
  • Loading branch information
@23Skidoo
23Skidoo committed Oct 4, 2016
2 parents ed32907 + d5d35cc commit c6929fc
Show file tree
Hide file tree
Showing 3 changed files with 79 additions and 32 deletions.
26 changes: 20 additions & 6 deletions cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | DSL for testing the modular solver
module UnitTests.Distribution.Solver.Modular.DSL (
ExampleDependency(..)
Expand All @@ -14,6 +15,7 @@ module UnitTests.Distribution.Solver.Modular.DSL (
, ExampleInstalled(..)
, ExampleQualifier(..)
, ExampleVar(..)
, EnableAllTests(..)
, exAv
, exInst
, exFlag
Expand Down Expand Up @@ -42,6 +44,7 @@ import qualified Distribution.Package as C
hiding (HasUnitId(..))
import qualified Distribution.PackageDescription as C
import qualified Distribution.Simple.PackageIndex as C.PackageIndex
import Distribution.Simple.Setup (BooleanFlag(..))
import qualified Distribution.System as C
import qualified Distribution.Version as C
import Language.Haskell.Extension (Extension(..), Language)
Expand Down Expand Up @@ -152,7 +155,9 @@ exFlag :: ExampleFlagName -> [ExampleDependency] -> [ExampleDependency]
-> ExampleDependency
exFlag n t e = ExFlag n (Buildable t) (Buildable e)

data ExPreference = ExPref String ExampleVersionRange
data ExPreference =
ExPkgPref ExamplePkgName ExampleVersionRange
| ExStanzaPref ExamplePkgName [OptionalStanza]

data ExampleAvailable = ExAv {
exAvName :: ExamplePkgName
Expand All @@ -171,6 +176,10 @@ data ExampleQualifier =
| Setup ExamplePkgName
| IndepSetup Int ExamplePkgName

-- | Whether to enable tests in all packages in a test case.
newtype EnableAllTests = EnableAllTests Bool
deriving BooleanFlag

-- | Constructs an 'ExampleAvailable' package for the 'ExampleDb',
-- given:
--
Expand Down Expand Up @@ -467,9 +476,10 @@ exResolve :: ExampleDb
-> EnableBackjumping
-> Maybe [ExampleVar]
-> [ExPreference]
-> EnableAllTests
-> Progress String String CI.SolverInstallPlan.SolverInstallPlan
exResolve db exts langs pkgConfigDb targets solver mbj indepGoals reorder
enableBj vars prefs
enableBj vars prefs enableAllTests
= resolveDependencies C.buildPlatform compiler pkgConfigDb solver params
where
defaultCompiler = C.unknownCompilerInfo C.buildCompilerId C.NoAbiTag
Expand All @@ -482,9 +492,11 @@ exResolve db exts langs pkgConfigDb targets solver mbj indepGoals reorder
packageIndex = exAvIdx avai
, packagePreferences = Map.empty
}
enableTests = fmap (\p -> PackageConstraintStanzas
(C.mkPackageName p) [TestStanzas])
(exDbPkgs db)
enableTests
| asBool enableAllTests = fmap (\p -> PackageConstraintStanzas
(C.mkPackageName p) [TestStanzas])
(exDbPkgs db)
| otherwise = []
targets' = fmap (\p -> NamedPackage (C.mkPackageName p) []) targets
params = addPreferences (fmap toPref prefs)
$ addConstraints (fmap toLpc enableTests)
Expand All @@ -495,7 +507,9 @@ exResolve db exts langs pkgConfigDb targets solver mbj indepGoals reorder
$ setGoalOrder goalOrder
$ standardInstallPolicy instIdx avaiIdx targets'
toLpc pc = LabeledPackageConstraint pc ConstraintSourceUnknown
toPref (ExPref n v) = PackageVersionPreference (C.mkPackageName n) v

toPref (ExPkgPref n v) = PackageVersionPreference (C.mkPackageName n) v
toPref (ExStanzaPref n stanzas) = PackageStanzasPreference (C.mkPackageName n) stanzas

goalOrder :: Maybe (Variable P.QPN -> Variable P.QPN -> Ordering)
goalOrder = (orderFromList . map toVariable) `fmap` vars
Expand Down
2 changes: 1 addition & 1 deletion cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,7 +106,7 @@ solve enableBj reorder indep solver targets (TestDb db) =
-- The backjump limit prevents individual tests from using
-- too much time and memory.
(Just defaultMaxBackjumps)
indep reorder enableBj Nothing []
indep reorder enableBj Nothing [] (EnableAllTests True)

failure :: String -> Failure
failure msg
Expand Down
83 changes: 58 additions & 25 deletions cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,15 +55,15 @@ tests = [
, runTest $ indep $ mkTest db18 "linkFlags3" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("F", 1)])
]
, testGroup "Stanzas" [
runTest $ mkTest db5 "simpleTest1" ["C"] (solverSuccess [("A", 2), ("C", 1)])
, runTest $ mkTest db5 "simpleTest2" ["D"] anySolverFailure
, runTest $ mkTest db5 "simpleTest3" ["E"] (solverSuccess [("A", 1), ("E", 1)])
, runTest $ mkTest db5 "simpleTest4" ["F"] anySolverFailure -- TODO
, runTest $ mkTest db5 "simpleTest5" ["G"] (solverSuccess [("A", 2), ("G", 1)])
, runTest $ mkTest db5 "simpleTest6" ["E", "G"] anySolverFailure
, runTest $ indep $ mkTest db5 "simpleTest7" ["E", "G"] (solverSuccess [("A", 1), ("A", 2), ("E", 1), ("G", 1)])
, runTest $ mkTest db6 "depsWithTests1" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
, runTest $ indep $ mkTest db6 "depsWithTests2" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)])
runTest $ enableAllTests $ mkTest db5 "simpleTest1" ["C"] (solverSuccess [("A", 2), ("C", 1)])
, runTest $ enableAllTests $ mkTest db5 "simpleTest2" ["D"] anySolverFailure
, runTest $ enableAllTests $ mkTest db5 "simpleTest3" ["E"] (solverSuccess [("A", 1), ("E", 1)])
, runTest $ enableAllTests $ mkTest db5 "simpleTest4" ["F"] anySolverFailure -- TODO
, runTest $ enableAllTests $ mkTest db5 "simpleTest5" ["G"] (solverSuccess [("A", 2), ("G", 1)])
, runTest $ enableAllTests $ mkTest db5 "simpleTest6" ["E", "G"] anySolverFailure
, runTest $ indep $ enableAllTests $ mkTest db5 "simpleTest7" ["E", "G"] (solverSuccess [("A", 1), ("A", 2), ("E", 1), ("G", 1)])
, runTest $ enableAllTests $ mkTest db6 "depsWithTests1" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)])
, runTest $ indep $ enableAllTests $ mkTest db6 "depsWithTests2" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)])
]
, testGroup "Setup dependencies" [
runTest $ mkTest db7 "setupDeps1" ["B"] (solverSuccess [("A", 2), ("B", 1)])
Expand Down Expand Up @@ -110,23 +110,36 @@ tests = [
, runTest $ mkTestLangs [Haskell98, Haskell2010, UnknownLanguage "Haskell3000"] dbLangs1 "supportedUnknown" ["C"] (solverSuccess [("A",1),("B",1),("C",1)])
]

, testGroup "Soft Constraints" [
runTest $ soft [ ExPref "A" $ mkvrThis 1] $ mkTest db13 "selectPreferredVersionSimple" ["A"] (solverSuccess [("A", 1)])
, runTest $ soft [ ExPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionSimple2" ["A"] (solverSuccess [("A", 2)])
, runTest $ soft [ ExPref "A" $ mkvrOrEarlier 2
, ExPref "A" $ mkvrOrEarlier 1] $ mkTest db13 "selectPreferredVersionMultiple" ["A"] (solverSuccess [("A", 1)])
, runTest $ soft [ ExPref "A" $ mkvrOrEarlier 1
, ExPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple2" ["A"] (solverSuccess [("A", 1)])
, runTest $ soft [ ExPref "A" $ mkvrThis 1
, ExPref "A" $ mkvrThis 2] $ mkTest db13 "selectPreferredVersionMultiple3" ["A"] (solverSuccess [("A", 2)])
, runTest $ soft [ ExPref "A" $ mkvrThis 1
, ExPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple4" ["A"] (solverSuccess [("A", 1)])
, testGroup "Package Preferences" [
runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1] $ mkTest db13 "selectPreferredVersionSimple" ["A"] (solverSuccess [("A", 1)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionSimple2" ["A"] (solverSuccess [("A", 2)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2
, ExPkgPref "A" $ mkvrOrEarlier 1] $ mkTest db13 "selectPreferredVersionMultiple" ["A"] (solverSuccess [("A", 1)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 1
, ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple2" ["A"] (solverSuccess [("A", 1)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1
, ExPkgPref "A" $ mkvrThis 2] $ mkTest db13 "selectPreferredVersionMultiple3" ["A"] (solverSuccess [("A", 2)])
, runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1
, ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple4" ["A"] (solverSuccess [("A", 1)])
]
, testGroup "Stanza Preferences" [
runTest $
mkTest dbStanzaPreferences1 "disable tests by default" ["pkg"] $
solverSuccess [("pkg", 1)]

, runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $
mkTest dbStanzaPreferences1 "enable tests with testing preference" ["pkg"] $
solverSuccess [("pkg", 1), ("test-dep", 1)]

, runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $
mkTest dbStanzaPreferences2 "disable testing when it's not possible" ["pkg"] $
solverSuccess [("pkg", 1)]
]
, testGroup "Buildable Field" [
testBuildable "avoid building component with unknown dependency" (ExAny "unknown")
, testBuildable "avoid building component with unknown extension" (ExExt (UnknownExtension "unknown"))
, testBuildable "avoid building component with unknown language" (ExLang (UnknownLanguage "unknown"))
, runTest $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (solverSuccess [("flag1-false", 1), ("flag2-true", 1), ("pkg", 1)])
, runTest $ enableAllTests $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (solverSuccess [("flag1-false", 1), ("flag2-true", 1), ("pkg", 1)])
, runTest $ mkTest dbBuildable2 "choose version that sets buildable to false" ["A"] (solverSuccess [("A", 1), ("B", 2)])
]
, testGroup "Pkg-config dependencies" [
Expand Down Expand Up @@ -179,7 +192,6 @@ tests = [
]
]
where
soft prefs test = test { testSoftConstraints = prefs }
mkvrThis = V.thisVersion . makeV
mkvrOrEarlier = V.orEarlierVersion . makeV
makeV v = V.mkVersion [v,0,0]
Expand All @@ -192,6 +204,12 @@ indep test = test { testIndepGoals = IndependentGoals True }
goalOrder :: [ExampleVar] -> SolverTest -> SolverTest
goalOrder order test = test { testGoalOrder = Just order }

preferences :: [ExPreference] -> SolverTest -> SolverTest
preferences prefs test = test { testSoftConstraints = prefs }

enableAllTests :: SolverTest -> SolverTest
enableAllTests test = test { testEnableAllTests = EnableAllTests True }

data GoalOrder = FixedGoalOrder | DefaultGoalOrder

{-------------------------------------------------------------------------------
Expand All @@ -209,6 +227,7 @@ data SolverTest = SolverTest {
, testSupportedExts :: Maybe [Extension]
, testSupportedLangs :: Maybe [Language]
, testPkgConfigDb :: PkgConfigDb
, testEnableAllTests :: EnableAllTests
}

-- | Expected result of a solver test.
Expand Down Expand Up @@ -296,6 +315,7 @@ mkTestExtLangPC exts langs pkgConfigDb db label targets result = SolverTest {
, testSupportedExts = exts
, testSupportedLangs = langs
, testPkgConfigDb = pkgConfigDbFromList pkgConfigDb
, testEnableAllTests = EnableAllTests False
}

runTest :: SolverTest -> TF.TestTree
Expand All @@ -305,6 +325,7 @@ runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) ->
testSupportedLangs testPkgConfigDb testTargets
Modular Nothing testIndepGoals (ReorderGoals False)
(EnableBackjumping True) testGoalOrder testSoftConstraints
testEnableAllTests
printMsg msg = if showSolverLog
then putStrLn msg
else return ()
Expand Down Expand Up @@ -586,6 +607,17 @@ db13 = [
, Right $ exAv "A" 3 []
]

dbStanzaPreferences1 :: ExampleDb
dbStanzaPreferences1 = [
Right $ exAv "pkg" 1 [] `withTest` ExTest "test" [ExAny "test-dep"]
, Right $ exAv "test-dep" 1 []
]

dbStanzaPreferences2 :: ExampleDb
dbStanzaPreferences2 = [
Right $ exAv "pkg" 1 [] `withTest` ExTest "test" [ExAny "unknown"]
]

-- | Database with some cycles
--
-- * Simplest non-trivial cycle: A -> B and B -> A
Expand Down Expand Up @@ -667,7 +699,7 @@ db16 = [
testIndepGoals2 :: String -> SolverTest
testIndepGoals2 name =
goalOrder goals $ indep $
mkTest db name ["A", "B"] $
enableAllTests $ mkTest db name ["A", "B"] $
solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)]
where
db :: ExampleDb
Expand Down Expand Up @@ -792,7 +824,7 @@ testIndepGoals3 name =
testIndepGoals4 :: String -> SolverTest
testIndepGoals4 name =
goalOrder goals $ indep $
mkTest db name ["A", "B", "C"] $
enableAllTests $ mkTest db name ["A", "B", "C"] $
solverSuccess [("A",1), ("B",1), ("C",1), ("D",1), ("E",1), ("E",2)]
where
db :: ExampleDb
Expand Down Expand Up @@ -947,7 +979,8 @@ dbLangs1 = [
-- depend on "false-dep".
testBuildable :: String -> ExampleDependency -> TestTree
testBuildable testName unavailableDep =
runTest $ mkTestExtLangPC (Just []) (Just []) [] db testName ["pkg"] expected
runTest $ enableAllTests $
mkTestExtLangPC (Just []) (Just []) [] db testName ["pkg"] expected
where
expected = solverSuccess [("false-dep", 1), ("pkg", 1)]
db = [
Expand Down

0 comments on commit c6929fc

Please sign in to comment.