From f95ed1d57f0b6ad44bf909c85da0e3af4aa89f31 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Fri, 1 Nov 2019 11:57:17 -0400
Subject: [PATCH] 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.
---
.gitlab-ci.yml | 3 +++
ci/TestPatches.hs | 41 ++++++++++++++++++++++++++++----------
ci/broken-packages.sh | 46 +++++++++++++++++++++++++++++++++++++++++++
3 files changed, 80 insertions(+), 10 deletions(-)
create mode 100644 ci/broken-packages.sh
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 6a72c8cd..88810dcd 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -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
diff --git a/ci/TestPatches.hs b/ci/TestPatches.hs
index 7b4fefc3..cdf8d0e5 100644
--- a/ci/TestPatches.hs
+++ b/ci/TestPatches.hs
@@ -1,6 +1,7 @@
{-# 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."
]
diff --git a/ci/broken-packages.sh b/ci/broken-packages.sh
new file mode 100644
index 00000000..d8b46bd9
--- /dev/null
+++ b/ci/broken-packages.sh
@@ -0,0 +1,46 @@
+# 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
--
GitLab