Commit 163da7f5 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Merge branch 'master' of http://darcs.haskell.org/ghc

parents f1fa6eb2 6ff3c318
module FilenameDescr where
import Data.Char
import Data.Either
import Data.List
......@@ -18,11 +19,11 @@ data FilenameDescrBit = VersionOf String
| Ways
deriving (Show, Eq, Ord)
normalise :: FilenameDescr -> FilenameDescr
normalise [] = []
normalise [x] = [x]
normalise (FP x1 : FP x2 : xs) = normalise (FP (x1 ++ x2) : xs)
normalise (x : xs) = x : normalise xs
normaliseDescr :: FilenameDescr -> FilenameDescr
normaliseDescr [] = []
normaliseDescr [x] = [x]
normaliseDescr (FP x1 : FP x2 : xs) = normaliseDescr (FP (x1 ++ x2) : xs)
normaliseDescr (x : xs) = x : normaliseDescr xs
-- Sanity check that the FilenameDescr matches the filename in the tar line
checkContent :: BuildInfo -> (FilenameDescr, TarLine) -> Errors
......@@ -32,7 +33,11 @@ checkContent buildInfo (fd, tl)
Right fn' ->
if fn' == fn
then []
else ["checkContent: Can't happen: filename mismatch: " ++ show fn]
else if all isAscii fn
then ["checkContent: Can't happen: filename mismatch: "
++ show fn]
else [] -- Ugly kludge; don't worry too much if filepaths
-- containing non-ASCII chars have gone wrong
Left errs ->
errs
......
......@@ -5,7 +5,7 @@ import Data.Function
import Data.List
import System.Exit
import System.IO
import Text.Regex.Posix
import Text.Regex.PCRE
die :: Errors -> IO a
die errs = do mapM_ (hPutStrLn stderr) errs
......
......@@ -3,8 +3,11 @@
module Main (main) where
import Control.Monad.State
import Data.Char
import Data.List
import System.Directory
import System.Environment
import System.FilePath
import BuildInfo
import FilenameDescr
......@@ -26,13 +29,61 @@ sizeChangeThresholds = [( 1000, 150),
main :: IO ()
main = do args <- getArgs
case args of
[bd1, bd2] -> doit False bd1 bd2
["--ignore-size-changes", bd1, bd2] -> doit True bd1 bd2
_ -> die ["Bad args. Need 2 bindists."]
(ignoreSizeChanges, p1, p2) <-
case args of
[p1, p2] -> return (False, p1, p2)
["--ignore-size-changes", p1, p2] -> return (True, p1, p2)
_ -> die ["Bad args. Need 2 filepaths."]
doFileOrDirectory ignoreSizeChanges p1 p2
doit :: Bool -> FilePath -> FilePath -> IO ()
doit ignoreSizeChanges bd1 bd2
doFileOrDirectory :: Bool -> FilePath -> FilePath -> IO ()
doFileOrDirectory ignoreSizeChanges p1 p2
= do b <- doesDirectoryExist p1
let doit = if b then doDirectory else doFile
doit ignoreSizeChanges p1 p2
doDirectory :: Bool -> FilePath -> FilePath -> IO ()
doDirectory ignoreSizeChanges p1 p2
= do fs1 <- getDirectoryContents p1
fs2 <- getDirectoryContents p2
let isVersionChar c = isDigit c || c == '.'
mkFileInfo "." = return []
mkFileInfo ".." = return []
mkFileInfo fp@('g':'h':'c':'-':x:xs)
| isDigit x = return [(("ghc-", "VERSION", dropWhile isVersionChar xs), fp)]
| otherwise = die ["No version number in " ++ show fp]
mkFileInfo fp = die ["Unrecognised filename " ++ show fp]
fss1' <- mapM mkFileInfo fs1
fss2' <- mapM mkFileInfo fs2
let fs1' = sort $ concat fss1'
fs2' = sort $ concat fss2'
putBreak = putStrLn "=========="
extraFile d fp = do putBreak
putStrLn ("Extra file in " ++ show d
++ ": " ++ show fp)
doFiles [] [] = do putBreak
putStrLn "Done."
doFiles ((_, fp) : xs) [] = do extraFile p1 fp
doFiles xs []
doFiles [] ((_, fp) : ys) = do extraFile p2 fp
doFiles [] ys
doFiles xs@((fpc1, fp1) : xs') ys@((fpc2, fp2) : ys')
= do case fpc1 `compare` fpc2 of
EQ ->
do putBreak
putStrLn $ unwords ["Doing", show fp1, show fp2]
doFile ignoreSizeChanges (p1 </> fp1)
(p2 </> fp2)
doFiles xs' ys'
LT -> do extraFile p1 fp1
doFiles xs' ys
GT -> do extraFile p2 fp2
doFiles xs ys'
doFiles fs1' fs2'
doFile :: Bool -> FilePath -> FilePath -> IO ()
doFile ignoreSizeChanges bd1 bd2
= do tls1 <- readTarLines bd1
tls2 <- readTarLines bd2
let mWays1 = findWays tls1
......@@ -124,7 +175,7 @@ mkFilePathDescr fp
middle' <- mkMiddleDescr middle
filename' <- mkFileNameDescr filename
let fd = FP "ghc-" : VersionOf "ghc" : middle' ++ FP "/" : filename'
return $ normalise fd
return $ normaliseDescr fd
| otherwise = return [FP fp]
mkMiddleDescr :: FilePath -> BIMonad FilenameDescr
......
......@@ -1438,7 +1438,7 @@ scavenge_mutable_list(bdescr *bd, generation *gen)
// definitely doesn't point into a young generation.
// Clean objects don't need to be scavenged. Some clean
// objects (MUT_VAR_CLEAN) are not kept on the mutable
// list at all; others, such as TSO
// list at all; others, such as MUT_ARR_PTRS
// are always on the mutable list.
//
switch (get_itbl((StgClosure *)p)->type) {
......
......@@ -335,7 +335,7 @@ sub scmall {
}
my $darcs_repo_present = 1 if -d "$localpath/_darcs";
my $git_repo_present = 1 if -d "$localpath/.git" || ($bare_flag && -d "$localpath");
my $git_repo_present = 1 if -e "$localpath/.git" || ($bare_flag && -d "$localpath");
if ($darcs_repo_present) {
if ($git_repo_present) {
die "Found both _darcs and .git in $localpath";
......
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