Commit cabb1ad4 authored by Ian Lynagh's avatar Ian Lynagh

Add tools to test that cleaning works properly

parent ee9a93fd
......@@ -549,6 +549,7 @@ BUILD_DIRS += \
compiler \
$(GHC_HSC2HS_DIR) \
$(GHC_PKG_DIR) \
utils/testremove \
utils/ghctags \
utils/hpc \
utils/runghc \
......
......@@ -51,7 +51,7 @@ INPLACE_PERL = $(INPLACE)/perl
# unconfigured tree so that the various clean targets can be used
# without configuring:
ifeq "$(ONLY_SHOW_CLEANS)" "YES"
RM = echo
RM = utils/testremove/wouldrm
RM_OPTS = CLEAN_FILES
RM_OPTS_REC = CLEAN_REC
else
......
module Main (main) where
import Control.Monad
import Data.List
import System.Environment
import System.Exit
import System.FilePath
import System.IO
data CleanWhat = CleanFile FilePath
| CleanRec FilePath
deriving (Read, Show)
main :: IO ()
main = do args <- getArgs
case args of
[contentsBeforeFile, contentsAfterFile, wouldBeCleanedFile] ->
doit contentsBeforeFile contentsAfterFile wouldBeCleanedFile
_ ->
error "Bad args"
doit :: FilePath -> FilePath -> FilePath -> IO ()
doit contentsBeforeFile contentsAfterFile wouldBeCleanedFile
= do contentsBefore <- liftM lines $ readFile contentsBeforeFile
contentsAfter <- liftM lines $ readFile contentsAfterFile
wouldBeCleaned <- liftM (map read . lines) $ readFile wouldBeCleanedFile
let newContentsAfter = contentsAfter \\ contentsBefore
let cleanedAfter = simulateCleans newContentsAfter wouldBeCleaned
unless (null cleanedAfter) $ do
hPutStrLn stderr "Files not cleaned:"
mapM_ (hPutStrLn stderr . show) cleanedAfter
exitWith (ExitFailure 1)
simulateCleans :: [FilePath] -> [CleanWhat] -> [FilePath]
simulateCleans fs cws = filter (not . cleaned) fs
where cleaned f = any (`willClean` f) cws
willClean :: CleanWhat -> FilePath -> Bool
CleanFile fp `willClean` f = fp `equalFilePath` f
CleanRec fp `willClean` f
= any (fp `equalFilePath`) (map joinPath $ inits $ splitPath f)
.PHONY: utils/testremove_all
utils/testremove_all: utils/testremove/wouldrm utils/testremove/checkremove
utils/testremove/wouldrm: $$@.hs
$(GHC_STAGE1) --make -O $@
utils/testremove/checkremove: $$@.hs
$(GHC_STAGE1) --make -O $@
module Main (main) where
import System.Environment
data CleanWhat = CleanFile FilePath
| CleanRec FilePath
deriving (Read, Show)
main :: IO ()
main = do args <- getArgs
ls <- case args of
"CLEAN_FILES" : files -> return $ map CleanFile files
"CLEAN_REC" : dirs -> return $ map CleanRec dirs
_ -> error "Bad args"
appendFile "would-be-cleaned" $ unlines $ map show ls
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