Commit e1c36a33 authored by Ben Gamari's avatar Ben Gamari 🐢

Add support for expecting some packages to fail

This adds a `--expect-broken` option to the CI driver executable along
with a simple shell script containing the list of packages which we
expect to fail for a given GHC version.
parent b5c1eeec
......@@ -93,6 +93,9 @@ build-8.8:
--out-link ghc \
ghcHEAD
- GHC=`pwd`/ghc/bin/ghc
- |
source ci/broken-packages.sh
EXTRA_OPTS="$EXTRA_OPTS $BROKEN_ARGS"
- rm -Rf $HOME/.cabal/pacakages/local tmp; mkdir -p tmp; cd tmp
- |
EXTRA_OPTS="--cabal-option=-j$CPUS" # Use cabal's build parallelism
......
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module TestPatches
( testPatches
......@@ -45,6 +46,12 @@ import Types
import MakeConstraints
import Utils
newtype BrokenPackages = BrokenPackages { getBrokenPackageNames :: S.Set PkgName }
deriving (Semigroup, Monoid)
failureExpected :: BrokenPackages -> PkgName -> Bool
failureExpected (BrokenPackages pkgs) name = name `S.member` pkgs
data Config = Config { configPatchDir :: FilePath
, configCompiler :: FilePath
, configGhcOptions :: [String]
......@@ -52,6 +59,7 @@ data Config = Config { configPatchDir :: FilePath
, configOnlyPackages :: Maybe (S.Set Cabal.PackageName)
, configConcurrency :: Int
, configExtraCabalFragments :: [FilePath]
, configExpectedBrokenPkgs :: BrokenPackages
}
cabalOptions :: Config -> [String]
......@@ -70,6 +78,7 @@ config =
<*> onlyPackages
<*> concurrency
<*> extraCabalFragments
<*> expectedBrokenPkgs
where
patchDir = option str (short 'p' <> long "patches" <> help "patch directory" <> value "./patches")
compiler = option str (short 'w' <> long "with-compiler" <> help "path of compiler")
......@@ -80,6 +89,11 @@ config =
<|> pure Nothing
concurrency = option auto (short 'j' <> long "concurrency" <> value 1 <> help "number of concurrent builds")
extraCabalFragments = many $ option str (long "extra-cabal-fragment" <> help "path of extra configuration to include in cabal project files")
expectedBrokenPkgs =
fmap (BrokenPackages . S.fromList) $ many
$ option
(fmap toPkgName pkgName)
(short 'b' <> long "expect-broken" <> metavar "PKGNAME" <> help "expect the given package to fail to build")
pkgName :: ReadM Cabal.PackageName
pkgName = str >>= maybe (fail "invalid package name") pure . simpleParse
......@@ -106,14 +120,17 @@ testPatches cfg = do
testedPatches <- fold <$> mapConcurrentlyN (fromIntegral $ configConcurrency cfg) build (S.toList packages')
let runResult = RunResult testedPatches
print $ resultSummary runResult
print $ resultSummary (configExpectedBrokenPkgs cfg) runResult
BSL.writeFile "results.json" $ encode runResult
exitWith $ if anyFailures runResult then ExitFailure 1 else ExitSuccess
exitWith $ if anyFailures (configExpectedBrokenPkgs cfg) runResult then ExitFailure 1 else ExitSuccess
anyFailures :: RunResult -> Bool
anyFailures (RunResult testedPatches) =
any patchFailed testedPatches
anyFailures :: BrokenPackages -> RunResult -> Bool
anyFailures broken (RunResult testedPatches) =
any failed testedPatches
where
failed tp =
patchFailed tp /= failureExpected broken (patchedPackageName tp)
patchFailed :: TestedPatch -> Bool
patchFailed tp =
case patchedPackageResult tp of
......@@ -121,17 +138,21 @@ anyFailures (RunResult testedPatches) =
PackageResult False _ -> True
_ -> False
resultSummary :: RunResult -> Doc
resultSummary runResult = vcat
resultSummary :: BrokenPackages -> RunResult -> Doc
resultSummary broken runResult = vcat
[ "Total units built:" <+> pshow (length allUnits)
, ""
, pshow (length planningErrors) <+> "had no valid install plan:"
, PP.indent 4 $ vcat $ map (uncurry prettyPkgVer) planningErrors
, ""
, pshow (length failedUnits) <+> "units failed to build:"
, PP.indent 4 $ vcat [ prettyPkgVer (pkgName binfo) (version binfo)
| (binfo, _) <- M.elems failedUnits
]
, PP.indent 4 $ vcat
[ prettyPkgVer (pkgName binfo) (version binfo) <+> expectedDoc
| (binfo, _) <- M.elems failedUnits
, let expectedDoc
| failureExpected broken (pkgName binfo) = PP.parens $ PP.yellow $ PP.text "expected"
| otherwise = mempty
]
, ""
, pshow (length failedDependsUnits) <+> "units failed to build due to unbuildable dependencies."
]
......
# vi: set filetype=sh
# Packages expected not to build due to GHC bugs. This is `source`'d by the CI
# script and the arguments in BROKEN_ARGS are added to the hackage-ci
# command-line.
# Mark the named package as broken.
#
# Usage:
# broken $pkg_name $ghc_ticket_number
#
function broken() {
pkg_name="$1"
ticket="$2"
echo "Marking $pkg_name as broken due to #$ticket"
BROKEN_ARGS="$BROKEN_ARGS --expect-broken=$pkg_name"
}
if [ -z "$GHC" ]; then GHC=ghc; fi
function ghc_version() {
$GHC --version | sed 's/.*version \([0-9]*\.\([0-9]*\.\)*\)/\1/'
}
# ======================================================================
# The lists begin here
#
# For instance:
#
# broken "lens" 17988
version="$(ghc_version)"
case $version in
8.8.*)
;;
8.9.*)
# package ticket
broken "singletons" 17405
broken "vinyl" 17405
;;
*)
echo "No broken packages for GHC $version"
;;
esac
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment