diff --git a/Stackage/InstallInfo.hs b/Stackage/InstallInfo.hs index b3116a5b..d35b2aac 100644 --- a/Stackage/InstallInfo.hs +++ b/Stackage/InstallInfo.hs @@ -29,6 +29,7 @@ getInstallInfo = do { iiCore = totalCore , iiPackages = Map.map fst final , iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp + , iiPackageDB = pdb } showDep :: (PackageName, (Version, [PackageName])) -> String diff --git a/Stackage/LoadDatabase.hs b/Stackage/LoadDatabase.hs index 64064b2b..0f179334 100644 --- a/Stackage/LoadDatabase.hs +++ b/Stackage/LoadDatabase.hs @@ -58,21 +58,24 @@ loadPackageDB core deps = do | not $ withinRange v vrange -> return pdb _ -> case Tar.entryContent e of - Tar.NormalFile bs _ -> return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo - { piVersion = v - , piDeps = parseDeps bs - } + Tar.NormalFile bs _ -> do + let (deps', hasTests) = parseDeps bs + return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo + { piVersion = v + , piDeps = deps' + , piHasTests = hasTests + } _ -> return pdb parseDeps lbs = case parsePackageDescription $ L8.unpack lbs of - ParseOk _ gpd -> mconcat + ParseOk _ gpd -> (mconcat [ maybe mempty (go gpd) $ condLibrary gpd , mconcat $ map (go gpd . snd) $ condExecutables gpd , mconcat $ map (go gpd . snd) $ condTestSuites gpd , mconcat $ map (go gpd . snd) $ condBenchmarks gpd - ] - _ -> mempty + ], not $ null $ condTestSuites gpd) + _ -> (mempty, defaultHasTestSuites) where go gpd tree = Set.unions diff --git a/Stackage/Test.hs b/Stackage/Test.hs index 80cd658f..675b831c 100644 --- a/Stackage/Test.hs +++ b/Stackage/Test.hs @@ -16,16 +16,18 @@ import System.FilePath ((<.>), ()) import System.IO (IOMode (WriteMode, AppendMode), withBinaryFile) import System.Process (runProcess, waitForProcess) -import Distribution.Text -import Data.Maybe runTestSuites :: InstallInfo -> IO () runTestSuites ii = do let testdir = "runtests" rm_r testdir createDirectory testdir - allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii + allPass <- foldM (runTestSuite testdir) True $ filter hasTestSuites $ Map.toList $ iiPackages ii unless allPass $ error $ "There were failures, please see the logs in " ++ testdir + where + PackageDB pdb = iiPackageDB ii + + hasTestSuites (name, _) = maybe defaultHasTestSuites piHasTests $ Map.lookup name pdb -- | Separate for the PATH environment variable pathSep :: Char diff --git a/Stackage/Types.hs b/Stackage/Types.hs index a9d18bc9..76bac501 100644 --- a/Stackage/Types.hs +++ b/Stackage/Types.hs @@ -25,8 +25,9 @@ instance Monoid PackageDB where | otherwise = pi2 data PackageInfo = PackageInfo - { piVersion :: Version - , piDeps :: Set PackageName + { piVersion :: Version + , piDeps :: Set PackageName + , piHasTests :: Bool } deriving (Show, Eq, Ord) @@ -46,4 +47,5 @@ data InstallInfo = InstallInfo -- ^ This is intended to hold onto packages which might be automatically -- provided in the global package database. In practice, this would be -- Haskell Platform packages provided by distributions. + , iiPackageDB :: PackageDB } diff --git a/Stackage/Util.hs b/Stackage/Util.hs index 8f146508..9bb344b0 100644 --- a/Stackage/Util.hs +++ b/Stackage/Util.hs @@ -61,3 +61,10 @@ getPackageVersion e = do Just (package, version) where fp = TarEntry.fromTarPathToPosixPath $ TarEntry.entryTarPath e + +-- | If a package cannot be parsed or is not found, the default value for +-- whether it has a test suite. We default to @True@ since, worst case +-- scenario, this just means a little extra time trying to run a suite that's +-- not there. Defaulting to @False@ would result in silent failures. +defaultHasTestSuites :: Bool +defaultHasTestSuites = True