Add tools to test that cleaning works properly

3 files changed, 68 insertions, 0 deletions

diff --git a/utils/testremove/checkremove.hs b/utils/testremove/checkremove.hs
new file mode 100644
index 0000000000..5a948b896f
--- /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 0000000000..ac9ef6ce03
--- /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 0000000000..1c68e7563f
--- /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