diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6a72c8cd690b50a99853d21c92da7dcc2d79d2a6..88810dcdb3ddc49fd0602c9e1108f875f039035c 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 7b4fefc38f66f27029dab6329ae940eadae27d6c..cdf8d0e54e2892d9b8a357a9bb7a4caa160bb025 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 0000000000000000000000000000000000000000..d8b46bd907b8bcfd7f10c8d5c89c533afc8bec1e --- /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