diff --git a/ghc.mk b/ghc.mk index ec7e8409a8eafb69688f5e9338fc10d5d2e2ba96..f368875aecda92bd0f2a6471bd5ca84ccba8198b 100644 --- a/ghc.mk +++ b/ghc.mk @@ -549,6 +549,7 @@ BUILD_DIRS += \ compiler \ $(GHC_HSC2HS_DIR) \ $(GHC_PKG_DIR) \ + utils/testremove \ utils/ghctags \ utils/hpc \ utils/runghc \ diff --git a/mk/tree.mk b/mk/tree.mk index 639b93bd9bedbca46cec5a9035426ba1dac61f70..34bfcde763cf3765dd7514270d444b1e527db3db 100644 --- a/mk/tree.mk +++ b/mk/tree.mk @@ -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 diff --git a/utils/testremove/checkremove.hs b/utils/testremove/checkremove.hs new file mode 100644 index 0000000000000000000000000000000000000000..5a948b896f7cf7b5d9b11822843dc0595e0cbabd --- /dev/null +++ b/utils/testremove/checkremove.hs @@ -0,0 +1,43 @@ + +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) + diff --git a/utils/testremove/ghc.mk b/utils/testremove/ghc.mk new file mode 100644 index 0000000000000000000000000000000000000000..ac9ef6ce03115b4b41dc71715f9dec9aa4f31f9b --- /dev/null +++ b/utils/testremove/ghc.mk @@ -0,0 +1,9 @@ + +.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 $@ diff --git a/utils/testremove/wouldrm.hs b/utils/testremove/wouldrm.hs new file mode 100644 index 0000000000000000000000000000000000000000..1c68e7563f9f8174915445dec93fa4a652948fba --- /dev/null +++ b/utils/testremove/wouldrm.hs @@ -0,0 +1,16 @@ + +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