Add tools to test that cleaning works properly

diff --git a/ghc.mk b/ghc.mk
index ec7e840..f368875 100644 (file)
--- 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 639b93b..34bfcde 100644 (file)
--- 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 (file)
index 0000000..5a948b8
--- /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 (file)
index 0000000..ac9ef6c
--- /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 (file)
index 0000000..1c68e75
--- /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