From 45b33ac54d795e69ef2625de1d9aae9628fe6327 Mon Sep 17 00:00:00 2001 From: Chris Done Date: Sun, 4 Jan 2015 22:26:33 +0100 Subject: [PATCH] Flexible tests for checkBuildPlan (#375) @snoyberg Can you confirm that this simple test suite works for you? I've set this up so that I can then add some cyclic dependencies and add an occurs check for that, but figured I'd setup tests for some of the existing invariants first. Should be like: $ cabal test --ghc-options=-O0; cat dist/test/stackage-0.4.0-spec.log Building stackage-0.4.0... Preprocessing library stackage-0.4.0... In-place registering stackage-0.4.0... Preprocessing executable 'stackage' for stackage-0.4.0... Preprocessing test suite 'spec' for stackage-0.4.0... [3 of 4] Compiling Stackage.BuildPlanSpec ( test/Stackage/BuildPlanSpec.hs, dist/build/spec/spec-tmp/Stackage/BuildPlanSpec.o ) Linking dist/build/spec/spec ... Running 1 test suites... Test suite spec: RUNNING... Test suite spec: PASS Test suite logged to: dist/test/stackage-0.4.0-spec.log 1 of 1 test suites (1 of 1 test cases) passed. Test suite spec: RUNNING... Stackage.BuildPlan simple package set bad version range on depdendency fails nonexistent package fails to check default package set checks ok Stackage.CorePackages works contains known core packages getCoreExecutables includes known executables Stackage.PackageIndex works getLatestDescriptions gives reasonable results Finished in 14.3302 seconds 9 examples, 0 failures Test suite spec: PASS Test suite logged to: dist/test/stackage-0.4.0-spec.log --- Stackage/BuildConstraints.hs | 1 + Stackage/CheckBuildPlan.hs | 1 + test/Stackage/BuildPlanSpec.hs | 124 +++++++++++++++++++++++++++---- test/test-build-constraints.yaml | 20 +++++ 4 files changed, 131 insertions(+), 15 deletions(-) create mode 100644 test/test-build-constraints.yaml diff --git a/Stackage/BuildConstraints.hs b/Stackage/BuildConstraints.hs index 3b3f0d01..674ac395 100644 --- a/Stackage/BuildConstraints.hs +++ b/Stackage/BuildConstraints.hs @@ -10,6 +10,7 @@ module Stackage.BuildConstraints , SystemInfo (..) , getSystemInfo , defaultBuildConstraints + , toBC ) where import Control.Monad.Writer.Strict (execWriter, tell) diff --git a/Stackage/CheckBuildPlan.hs b/Stackage/CheckBuildPlan.hs index f13265aa..ea656a9c 100644 --- a/Stackage/CheckBuildPlan.hs +++ b/Stackage/CheckBuildPlan.hs @@ -7,6 +7,7 @@ -- | Confirm that a build plan has a consistent set of dependencies. module Stackage.CheckBuildPlan ( checkBuildPlan + , BadBuildPlan ) where import Control.Monad.Writer.Strict (Writer, execWriter, tell) diff --git a/test/Stackage/BuildPlanSpec.hs b/test/Stackage/BuildPlanSpec.hs index 7c87d6d3..99679801 100644 --- a/test/Stackage/BuildPlanSpec.hs +++ b/test/Stackage/BuildPlanSpec.hs @@ -1,22 +1,56 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-} module Stackage.BuildPlanSpec (spec) where -import Stackage.BuildPlan -import Stackage.Prelude -import Stackage.BuildConstraints -import Stackage.UpdateBuildPlan -import Test.Hspec -import qualified Data.Yaml as Y -import Distribution.Version (anyVersion) import qualified Data.Map as Map -import Network.HTTP.Client (withManager) -import Network.HTTP.Client.TLS (tlsManagerSettings) +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import Data.Yaml +import qualified Data.Yaml as Y +import Distribution.Version +import Network.HTTP.Client +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Stackage.BuildConstraints +import Stackage.BuildPlan +import Stackage.CheckBuildPlan +import Stackage.PackageDescription +import Stackage.Prelude +import Stackage.UpdateBuildPlan +import Test.Hspec spec :: Spec -spec = it "works" $ withManager tlsManagerSettings $ \man -> do - bc <- defaultBuildConstraints man - pkgs <- getLatestAllowedPlans bc - bp <- newBuildPlan pkgs bc +spec = do + it "simple package set" $ check testBuildConstraints $ makePackageSet + [("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])]) + ,("bar", [0, 0, 0], [])] + it "bad version range on depdendency fails" $ badBuildPlan $ makePackageSet + [("foo", [0, 0, 0], [("bar", thisV [1, 1, 0])]) + ,("bar", [0, 0, 0], [])] + it "nonexistent package fails to check" $ badBuildPlan $ makePackageSet + [("foo", [0, 0, 0], [("nonexistent", thisV [0, 0, 0])]) + ,("bar", [0, 0, 0], [])] + it "default package set checks ok" $ check defaultBuildConstraints getLatestAllowedPlans + +-- | Checking should be considered a bad build plan. +badBuildPlan :: (BuildConstraints -> IO (Map PackageName PackagePlan)) + -> void + -> IO () +badBuildPlan m _ = do + mu <- try (check testBuildConstraints m) + case mu of + Left (_ :: BadBuildPlan) -> + return () + Right () -> + error "Expected bad build plan." + +-- | Check build plan with the given package set getter. +check :: (Manager -> IO BuildConstraints) + -> (BuildConstraints -> IO (Map PackageName PackagePlan)) + -> IO () +check readPlanFile getPlans = withManager tlsManagerSettings $ \man -> do + bc <- readPlanFile man + plans <- getPlans bc + bp <- newBuildPlan plans bc let bs = Y.encode bp ebp' = Y.decodeEither bs @@ -26,14 +60,74 @@ spec = it "works" $ withManager tlsManagerSettings $ \man -> do forM_ allPackages $ \name -> (name, lookup name (bpPackages bp')) `shouldBe` (name, lookup name (bpPackages bp)) - bpGithubUsers bp' `shouldBe` bpGithubUsers bp + when (bp' /= bp) $ error "bp' /= bp" - bp2 <- updateBuildPlan pkgs bp + bp2 <- updateBuildPlan plans bp when (dropVersionRanges bp2 /= dropVersionRanges bp) $ error "bp2 /= bp" + checkBuildPlan bp where dropVersionRanges bp = bp { bpPackages = map go $ bpPackages bp } where go pb = pb { ppConstraints = go' $ ppConstraints pb } go' pc = pc { pcVersionRange = anyVersion } + +-- | Make a package set from a convenient data structure. +makePackageSet + :: [(String,[Int],[(String,VersionRange)])] + -> BuildConstraints + -> IO (Map PackageName PackagePlan) +makePackageSet ps _ = + return $ + M.fromList $ + map + (\(name,ver,deps) -> + ( PackageName name + , dummyPackage ver $ + M.fromList $ + map + (\(dname,dver) -> + ( PackageName dname + , DepInfo {diComponents = S.fromList + [CompLibrary] + ,diRange = dver})) + deps)) + ps + where + dummyPackage v deps = + PackagePlan + {ppVersion = Version v [] + ,ppGithubPings = mempty + ,ppUsers = mempty + ,ppConstraints = + PackageConstraints + {pcVersionRange = anyV + ,pcMaintainer = Nothing + ,pcTests = Don'tBuild + ,pcHaddocks = Don'tBuild + ,pcBuildBenchmarks = False + ,pcFlagOverrides = mempty + ,pcEnableLibProfile = False} + ,ppDesc = + SimpleDesc + {sdPackages = deps + ,sdTools = mempty + ,sdProvidedExes = mempty + ,sdModules = mempty}} + +-- | This exact version is required. +thisV :: [Int] -> VersionRange +thisV ver = thisVersion (Version ver []) + +-- | Accept any version. +anyV :: VersionRange +anyV = anyVersion + +-- | Test plan. +testBuildConstraints :: void -> IO BuildConstraints +testBuildConstraints _ = + decodeFileEither + (fpToString fp) >>= + either throwIO toBC + where fp = "test/test-build-constraints.yaml" diff --git a/test/test-build-constraints.yaml b/test/test-build-constraints.yaml new file mode 100644 index 00000000..de831eaf --- /dev/null +++ b/test/test-build-constraints.yaml @@ -0,0 +1,20 @@ +packages: + "Test": + - foo + - bar + +global-flags: [] + +skipped-tests: [] +expected-test-failures: [] +expected-haddock-failures: [] +skipped-benchmarks: [] +skipped-profiling: [] + +github-users: + bar: + - demo + +package-flags: + foo: + demo: true