Skip to content
Snippets Groups Projects
Commit 9889296b authored by Oleg Grenrus's avatar Oleg Grenrus
Browse files

Reimpelement gen-extra-source-files in Haskell

- No need to add other-modules by hand
- Works on OSX (.sh didn't)
- Found missed files!
parent 34eecf48
No related branches found
No related tags found
No related merge requests found
......@@ -19,8 +19,9 @@ branches:
# lines listings versions you don't need/want testing for.
matrix:
include:
- env: GHCVER=none SCRIPT=meta BUILDER=none
- env: GHCVER=8.0.1 SCRIPT=meta BUILDER=none
os: linux
sudo: required
# These don't have -dyn/-prof whitelisted yet, so we have to
# do the old-style installation
- env: GHCVER=7.4.2 SCRIPT=script CABAL_LIB_ONLY=YES
......
......@@ -583,9 +583,11 @@ test-suite package-tests
PackageTests.AutogenModules.Package.Check
PackageTests.AutogenModules.SrcDist.Check
PackageTests.BenchmarkStanza.Check
PackageTests.BuildDeps.GlobalBuildDepsNotAdditive1.Check
PackageTests.BuildDeps.GlobalBuildDepsNotAdditive2.Check
PackageTests.CaretOperator.Check
PackageTests.TestStanza.Check
PackageTests.DeterministicAr.Check
PackageTests.TestStanza.Check
PackageTests.TestSuiteTests.ExeV10.Check
PackageTests.PackageTester
hs-source-dirs: tests
......
#!/usr/bin/env runhaskell
import Data.List (isPrefixOf, isSuffixOf, sort)
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse (ParseResult (..), parsePackageDescription)
import Distribution.Verbosity (silent)
import System.Environment (getArgs, getProgName)
import System.FilePath (takeExtension, takeFileName)
import System.Process (readProcess)
import qualified Distribution.ModuleName as ModuleName
import qualified System.IO as IO
main' :: FilePath -> IO ()
main' fp = do
-- Read cabal file, so we can determine test modules
contents <- strictReadFile fp
cabal <- case parsePackageDescription contents of
ParseOk _ x -> pure x
ParseFailed errs -> fail (show errs)
-- We skip some files
let testModuleFiles = getOtherModulesFiles cabal
let skipPredicates' = skipPredicates ++ map (==) testModuleFiles
-- Read all files git knows about under tests/
files0 <- lines <$> readProcess "git" ["ls-files", "tests"] ""
-- Filter
let files1 = filter (\f -> takeExtension f `elem` whitelistedExtensionss ||
takeFileName f `elem` whitelistedFiles)
files0
let files2 = filter (\f -> not $ any ($ dropTestsDir f) skipPredicates') files1
let files3 = sort files2
let files = files3
-- Read current file
let inputLines = lines contents
linesBefore = takeWhile (/= topLine) inputLines
linesAfter = dropWhile (/= bottomLine) inputLines
-- Output
let outputLines = linesBefore ++ [topLine] ++ map (" " ++) files ++ linesAfter
writeFile fp (unlines outputLines)
topLine, bottomLine :: String
topLine = " -- BEGIN gen-extra-source-files"
bottomLine = " -- END gen-extra-source-files"
dropTestsDir :: FilePath -> FilePath
dropTestsDir fp
| pfx `isPrefixOf` fp = drop (length pfx) fp
| otherwise = fp
where
pfx = "tests/"
whitelistedFiles :: [FilePath]
whitelistedFiles = [ "ghc", "ghc-pkg", "ghc-7.10", "ghc-pkg-7.10", "ghc-pkg-ghc-7.10" ]
whitelistedExtensionss :: [String]
whitelistedExtensionss = map ('.' : )
[ "hs", "lhs", "c", "sh", "cabal", "hsc", "err", "out", "in", "project" ]
getOtherModulesFiles :: GenericPackageDescription -> [FilePath]
getOtherModulesFiles gpd = mainModules ++ map fromModuleName otherModules'
where
testSuites :: [TestSuite]
testSuites = map (foldCondTree . snd) (condTestSuites gpd)
mainModules = concatMap (mainModule . testInterface) testSuites
otherModules' = concatMap (otherModules . testBuildInfo) testSuites
fromModuleName mn = ModuleName.toFilePath mn ++ ".hs"
mainModule (TestSuiteLibV09 _ mn) = [fromModuleName mn]
mainModule (TestSuiteExeV10 _ fp) = [fp]
mainModule _ = []
skipPredicates :: [FilePath -> Bool]
skipPredicates =
[ isSuffixOf "register.sh"
]
where
-- eq = (==)
main :: IO ()
main = do
args <- getArgs
case args of
[fp] -> main' fp
_ -> do
progName <- getProgName
putStrLn "Error too few arguments!"
putStrLn $ "Usage: " ++ progName ++ " FILE"
putStrLn " where FILE is Cabal.cabal or cabal-install.cabal"
strictReadFile :: FilePath -> IO String
strictReadFile fp = do
handle <- IO.openFile fp IO.ReadMode
contents <- get handle
IO.hClose handle
return contents
where
get h = IO.hGetContents h >>= \s -> length s `seq` return s
foldCondTree :: Monoid a => CondTree v c a -> a
foldCondTree (CondNode x _ cs)
= mappend x
-- list, 3-tuple, maybe
$ (foldMap . foldMapTriple . foldMap) foldCondTree cs
where
foldMapTriple :: (c -> x) -> (a, b, c) -> x
foldMapTriple f (_, _, x) = f x
#!/bin/sh
if [ "$#" -ne 1 ]; then
echo "Error: too few arguments!"
echo "Usage: $0 FILE"
exit 1
fi
set -ex
git ls-files tests \
| awk '/\.(hs|lhs|c|sh|cabal|hsc|err|out|in|project)$|ghc/ { print } { next }' \
| awk '/Check.hs$|UnitTests|PackageTester|autogen|register.sh|PackageTests.hs|IntegrationTests.hs|CreatePipe|^tests\/Test/ { next } { print }' \
| LC_ALL=C sort \
| sed -e 's/^/ /' \
> source-file-list
lead='^ -- BEGIN gen-extra-source-files'
tail='^ -- END gen-extra-source-files'
# cribbed off of http://superuser.com/questions/440013/how-to-replace-part-of-a-text-file-between-markers-with-another-text-file
sed -i.bak -e "/$lead/,/$tail/{ /$lead/{p; r source-file-list
}; /$tail/p; d }" $1
......@@ -196,7 +196,6 @@ Extra-Source-Files:
tests/IntegrationTests/user-config/runs_without_error.sh
tests/IntegrationTests/user-config/uses_CABAL_CONFIG.out
tests/IntegrationTests/user-config/uses_CABAL_CONFIG.sh
tests/IntegrationTests2.hs
tests/IntegrationTests2/build/keep-going/cabal.project
tests/IntegrationTests2/build/keep-going/p/P.hs
tests/IntegrationTests2/build/keep-going/p/p.cabal
......
......@@ -6,7 +6,9 @@ travis_retry () {
}
if [ "$GHCVER" = "none" ]; then
exit 0
travis_retry sudo add-apt-repository -y ppa:hvr/ghc
travis_retry sudo apt-get update
travis_retry sudo apt-get install --force-yes ghc-$GHCVER
fi
if [ -z ${STACKAGE_RESOLVER+x} ]; then
......
......@@ -11,10 +11,10 @@
#./Cabal/misc/gen-authors.sh > AUTHORS
# Regenerate the 'extra-source-files' field in Cabal.cabal.
(cd Cabal && timed ./misc/gen-extra-source-files.sh Cabal.cabal) || exit $?
(cd Cabal && timed ./misc/gen-extra-source-files.hs Cabal.cabal) || exit $?
# Regenerate the 'extra-source-files' field in cabal-install.cabal.
(cd cabal-install && ../Cabal/misc/gen-extra-source-files.sh cabal-install.cabal) || exit $?
(cd cabal-install && ../Cabal/misc/gen-extra-source-files.hs cabal-install.cabal) || exit $?
# Fail if the diff is not empty.
timed ./Cabal/misc/travis-diff-files.sh
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment