shake 0.15.1 → 0.15.2
raw patch · 23 files changed
+267/−80 lines, 23 filesdep ~process
Dependency ranges changed: process
Files
- CHANGES.txt +8/−0
- shake.cabal +1/−1
- src/Development/Ninja/All.hs +2/−2
- src/Development/Ninja/Parse.hs +4/−1
- src/Development/Ninja/Type.hs +7/−2
- src/Development/Shake/Command.hs +109/−24
- src/Development/Shake/Core.hs +2/−2
- src/Development/Shake/Database.hs +1/−1
- src/Development/Shake/FilePath.hs +22/−7
- src/Development/Shake/Rules/File.hs +7/−1
- src/Development/Shake/Types.hs +7/−4
- src/General/Process.hs +1/−1
- src/Test/Command.hs +3/−1
- src/Test/Docs.hs +1/−1
- src/Test/Lint.hs +21/−9
- src/Test/Ninja.hs +25/−9
- src/Test/Ninja/buildseparate.ninja +10/−0
- src/Test/Ninja/outputtouch.ninja +5/−0
- src/Test/Ninja/redefine.ninja +13/−0
- src/Test/Ninja/test3-unix.ninja +0/−3
- src/Test/Ninja/test3-win.ninja +0/−3
- src/Test/Ninja/test3.ninja +2/−1
- src/Test/Type.hs +16/−7
CHANGES.txt view
@@ -1,5 +1,13 @@ Changelog for Shake +0.15.2+ #248, add another example of using cmd+ #245, initial support for fsatrace lint checking+ Reexport -<.> from filepath where available+ Hoogle #106, trigger on filepath version, not GHC version+ Add AddEnv and AddPath command options+ #243, close fds in child processes when spawning commands+ Make Ninja variable handling more accurate 0.15.1 If you have Shakefile.hs, pass it all arguments without interp Add shakeArgsPrune and shakeArgsPruneWith
shake.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.10 build-type: Simple name: shake-version: 0.15.1+version: 0.15.2 license: BSD3 license-file: LICENSE category: Development, Shake
src/Development/Ninja/All.hs view
@@ -40,7 +40,7 @@ addEnv env (BS.pack "out") (BS.unwords $ map quote out) addEnv env (BS.pack "in") (BS.unwords $ map quote depsNormal) addEnv env (BS.pack "in_newline") (BS.unlines depsNormal)- addBinds env buildBind+ forM_ buildBind $ \(a,b) -> addEnv env a b addBinds env ruleBind commandline <- fmap BS.unpack $ askVar env $ BS.pack "command" return $ CompDb dir commandline $ BS.unpack $ head depsNormal@@ -101,7 +101,7 @@ addEnv env (BS.pack "out") (BS.unwords $ map quote out) addEnv env (BS.pack "in") (BS.unwords $ map quote depsNormal) addEnv env (BS.pack "in_newline") (BS.unlines depsNormal)- addBinds env buildBind+ forM_ buildBind $ \(a,b) -> addEnv env a b addBinds env ruleBind applyRspfile env $ do
src/Development/Ninja/Parse.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards, TupleSections #-} module Development.Ninja.Parse(parse) where @@ -6,7 +6,9 @@ import Development.Ninja.Env import Development.Ninja.Type import Development.Ninja.Lexer+import Control.Applicative import Control.Monad+import Prelude parse :: FilePath -> Env Str Str -> IO Ninja@@ -32,6 +34,7 @@ LexBuild outputs rule deps -> do outputs <- mapM (askExpr env) outputs deps <- mapM (askExpr env) deps+ binds <- mapM (\(a,b) -> (a,) <$> askExpr env b) binds let (normal,implicit,orderOnly) = splitDeps deps let build = Build rule env normal implicit orderOnly binds return $
src/Development/Ninja/Type.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TupleSections #-} -- | The IO in this module is only to evaluate an envrionment variable, -- the 'Env' itself it passed around purely.@@ -7,9 +8,11 @@ Ninja(..), newNinja, Build(..), Rule(..), ) where +import Control.Applicative import Development.Ninja.Env import qualified Data.ByteString.Char8 as BS import Data.Maybe+import Prelude type Str = BS.ByteString@@ -34,7 +37,9 @@ addBind e k v = addEnv e k =<< askExpr e v addBinds :: Env Str Str -> [(Str, Expr)] -> IO ()-addBinds e = mapM_ (uncurry $ addBind e)+addBinds e bs = do+ bs <- mapM (\(a,b) -> (a,) <$> askExpr e b) bs+ mapM_ (uncurry $ addEnv e) bs ---------------------------------------------------------------------@@ -59,7 +64,7 @@ ,depsNormal :: [FileStr] ,depsImplicit :: [FileStr] ,depsOrderOnly :: [FileStr]- ,buildBind :: [(Str,Expr)]+ ,buildBind :: [(Str,Str)] } deriving Show data Rule = Rule
src/Development/Shake/Command.hs view
@@ -42,7 +42,6 @@ import Development.Shake.Types import Development.Shake.Rules.File - --------------------------------------------------------------------- -- ACTUAL EXECUTION @@ -50,7 +49,8 @@ data CmdOption = Cwd FilePath -- ^ Change the current directory in the spawned process. By default uses this processes current directory. | Env [(String,String)] -- ^ Change the environment variables in the spawned process. By default uses this processes environment.- -- Use 'addPath' to modify the @$PATH@ variable, or 'addEnv' to modify other variables.+ | AddEnv String String -- ^ Add an environment variable in the child process.+ | AddPath [String] [String] -- ^ Add some items to the prefix and suffix of the @$PATH@ variable. | Stdin String -- ^ Given as the @stdin@ of the spawned process. By default the @stdin@ is inherited. | StdinBS LBS.ByteString -- ^ Given as the @stdin@ of the spawned process. | Shell -- ^ Pass the command to the shell without escaping - any arguments will be joined with spaces. By default arguments are escaped properly.@@ -66,9 +66,10 @@ deriving (Eq,Ord,Show) --- | Produce a 'CmdOption' of value 'Env' that is the current environment, plus a--- prefix and suffix to the @$PATH@ environment variable. For example:+-- | /Deprecated:/ Use 'AddPath'. This function will be removed in a future version. --+-- Add a prefix and suffix to the @$PATH@ environment variable. For example:+-- -- @ -- opt <- 'addPath' [\"\/usr\/special\"] [] -- 'cmd' opt \"userbinary --version\"@@ -85,9 +86,10 @@ [(a,intercalate [searchPathSeparator] $ pre ++ [b | b /= ""] ++ post) | (a,b) <- path] ++ other --- | Produce a 'CmdOption' of value 'Env' that is the current environment, plus the argument--- environment variables. For example:+-- | /Deprecated:/ Use 'AddEnv'. This function will be removed in a future version. --+-- Add a single variable to the environment. For example:+-- -- @ -- opt <- 'addEnv' [(\"CFLAGS\",\"-O2\")] -- 'cmd' opt \"gcc -c main.c\"@@ -100,6 +102,7 @@ args <- liftIO getEnvironment return $ Env $ extra ++ filter (\(a,b) -> a `notElem` map fst extra) args + data Str = Str String | BS BS.ByteString | LBS LBS.ByteString | Unit deriving Eq data Result@@ -137,24 +140,36 @@ [] -> traced (takeFileName exe) let tracker act = case shakeLint opts of- Just LintTracker -> do- dir <- liftIO $ getTemporaryDirectory- (file, handle) <- liftIO $ openTempFile dir "shake.lint"- liftIO $ hClose handle- dir <- return $ file <.> "dir"- liftIO $ createDirectory dir- let cleanup = removeDirectoryRecursive dir >> removeFile file- flip actionFinally cleanup $ do- res <- act "tracker" $ "/if":dir:"/c":exe:args- (read,write) <- liftIO $ trackerFiles dir- trackRead read- trackWrite write- return res- _ -> act exe args+ Just LintTracker -> (if isWindows then winTracker else unixTracker) act+ _ -> act [] exe args - skipper $ tracker $ \exe args -> verboser $ tracer $ commandExplicitIO funcName copts results exe args+ winTracker act = do+ (dir, cleanup) <- liftIO newTempDir+ flip actionFinally cleanup $ do+ res <- act [] "tracker" $ "/if":dir:"/c":exe:args+ (rs, ws) <- liftIO $ trackerFiles dir+ trackRead rs+ trackWrite ws+ return res + unixTracker act = do+ (file, cleanup) <- liftIO newTempFile+ flip actionFinally cleanup $ do+ fsat <- liftIO $ getEnv "FSAT"+ let vars = [AddEnv "DYLD_INSERT_LIBRARIES" fsat+ ,AddEnv "DYLD_FORCE_FLAT_NAMESPACE" "1"+ ,AddEnv "FSAT_OUT" file]+ res <- act vars exe args+ (rs, ws) <- liftIO $ fsatraceFiles file+ whitelist <- liftIO unixWhitelist+ let whitelisted x = any (\w -> (w ++ "/") `isPrefixOf` x) whitelist+ trackRead $ filter (not . whitelisted) rs+ trackWrite $ filter (not . whitelisted) ws+ return res + skipper $ tracker $ \opts exe args -> verboser $ tracer $ commandExplicitIO funcName (opts++copts) results exe args++ -- | Given a directory (as passed to tracker /if) report on which files were used for reading/writing trackerFiles :: FilePath -> IO ([FilePath], [FilePath]) trackerFiles dir = do@@ -183,6 +198,42 @@ a +/+ b = if null a then b else a ++ "/" ++ b +fsatraceFiles :: FilePath -> IO ([FilePath], [FilePath])+fsatraceFiles file = do+ xs <- parseFSAT <$> readFileUTF8 file+ let reader (FSATRead x) = Just x; reader _ = Nothing+ writer (FSATWrite x) = Just x; writer (FSATMove x y) = Just x; writer _ = Nothing+ frs <- liftIO $ filterM doesFileExist $ nubOrd $ map normalise $ mapMaybe reader xs+ fws <- liftIO $ filterM doesFileExist $ nubOrd $ map normalise $ mapMaybe writer xs+ return (frs, fws)+++data FSAT = FSATWrite FilePath | FSATRead FilePath | FSATMove FilePath FilePath | FSATDelete FilePath++parseFSAT :: String -> [FSAT] -- any parse errors are skipped+parseFSAT = mapMaybe (f . wordsBy (== ':')) . lines+ where f ["w",x] = Just $ FSATWrite x+ f ["r",x] = Just $ FSATRead x+ f ["m",x,y] = Just $ FSATMove x y+ f ["d",x] = Just $ FSATDelete x+ f _ = Nothing+++unixWhitelist :: IO [FilePath]+unixWhitelist = do+ home <- getEnv "HOME"+ return [home ++ "/.ghc"+ ,home ++ "/Library/Haskell"+ ,home ++ "/Applications"+ ,home ++ "/.cabal"+ ,"/Applications"+ ,"/var/folders"+ ,"/usr"+ ,"/Library"+ ,"/System"+ ]++ --------------------------------------------------------------------- -- IO EXPLICIT OPERATION @@ -194,8 +245,8 @@ ResultStdouterr{} -> (True, True) _ -> (False, False) + optEnv <- resolveEnv opts let optCwd = let x = last $ "" : [x | Cwd x <- opts] in if x == "" then Nothing else Just x- let optEnv = let x = [x | Env x <- opts] in if null x then Nothing else Just $ concat x let optStdin = flip mapMaybe opts $ \x -> case x of Stdin x -> Just $ Left x; StdinBS x -> Just $ Right x; _ -> Nothing let optShell = Shell `elem` opts let optBinary = BinaryPipes `elem` opts@@ -259,6 +310,25 @@ Right (dur,(pid,ex)) -> mapM (\f -> f dur pid ex) resultBuild +resolveEnv :: [CmdOption] -> IO (Maybe [(String, String)])+resolveEnv opts+ | null env, null addEnv, null addPath = return Nothing+ | otherwise = Just . unique . tweakPath . (++ addEnv) <$>+ if null env then getEnvironment else return (concat env)+ where+ env = [x | Env x <- opts]+ addEnv = [(x,y) | AddEnv x y <- opts]+ addPath = [(x,y) | AddPath x y <- opts]++ newPath mid = intercalate [searchPathSeparator] $+ concat (reverse $ map fst addPath) ++ [mid | mid /= ""] ++ concatMap snd addPath+ isPath x = (if isWindows then upper else id) x == "PATH"+ tweakPath xs | not $ any (isPath . fst) xs = ("PATH", newPath "") : xs+ | otherwise = map (\(a,b) -> (a, if isPath a then newPath b else b)) xs++ unique = reverse . nubOrdOn (if isWindows then upper . fst else fst) . reverse++ -- | If the user specifies a custom $PATH, and not Shell, then try and resolve their exe ourselves. -- Tricky, because on Windows it doesn't look in the $PATH first. resolvePath :: ProcessOpts -> IO ProcessOpts@@ -458,9 +528,19 @@ -- -- * 'CmdOption' arguments are used as options. ----- To take the examples from 'command':+-- As some examples, here are some calls, and the resulting command string: -- -- @+-- 'unit' $ 'cmd' \"git log --pretty=\" \"oneline\" -- git log --pretty= oneline+-- 'unit' $ 'cmd' \"git log --pretty=\" [\"oneline\"] -- git log --pretty= oneline+-- 'unit' $ 'cmd' \"git log\" (\"--pretty=\" ++ \"oneline\") -- git log --pretty=oneline+-- 'unit' $ 'cmd' \"git log\" (\"--pretty=\" ++ \"one line\") -- git log --pretty=one line+-- 'unit' $ 'cmd' \"git log\" [\"--pretty=\" ++ \"one line\"] -- git log "--pretty=one line"+-- @+--+-- More examples, including return values, see this translation of the examples given for the 'command' function:+--+-- @ -- () <- 'cmd' \"gcc -c myfile.c\" -- compile a file, throwing an exception on failure -- 'unit' $ 'cmd' \"gcc -c myfile.c\" -- alternative to () <- binding. -- 'Exit' c <- 'cmd' \"gcc -c\" [myfile] -- run a command, recording the exit code@@ -475,7 +555,12 @@ -- unable to deduce 'CmdResult'. To avoid this error, bind the result to @()@, or include a type signature, or use -- the 'unit' function. ----- The 'cmd' command can also be run in the 'IO' monad, but then 'Traced' is ignored and command lines are not echoed.+-- The 'cmd' function can also be run in the 'IO' monad, but then 'Traced' is ignored and command lines are not echoed.+-- As an example:+--+-- @+-- 'cmd' ('Cwd' \"generated\") 'Shell' \"gcc -c myfile.c\" :: IO ()+-- @ cmd :: CmdArguments args => args :-> Action r cmd = cmdArguments []
src/Development/Shake/Core.hs view
@@ -676,7 +676,7 @@ unless (null bad) $ do let n = length bad errorStructured- ("Link checking error - " ++ (if n == 1 then "value was" else show n ++ " values were") ++ " used but not depended upon")+ ("Lint checking error - " ++ (if n == 1 then "value was" else show n ++ " values were") ++ " used but not depended upon") [("Used", Just $ show x) | x <- bad] "" @@ -685,7 +685,7 @@ unless (null bad) $ do let n = length bad errorStructured- ("Link checking error - " ++ (if n == 1 then "value was" else show n ++ " values were") ++ " depended upon after being used")+ ("Lint checking error - " ++ (if n == 1 then "value was" else show n ++ " values were") ++ " depended upon after being used") [("Used", Just $ show x) | x <- bad] ""
src/Development/Shake/Database.hs view
@@ -447,7 +447,7 @@ unless (null bad) $ do let n = length bad errorStructured- ("Link checking error - " ++ (if n == 1 then "value" else show n ++ " values") ++ " did not have " ++ (if n == 1 then "its" else "their") ++ " creation tracked")+ ("Lint checking error - " ++ (if n == 1 then "value" else show n ++ " values") ++ " did not have " ++ (if n == 1 then "its" else "their") ++ " creation tracked") (intercalate [("",Just "")] [ [("Rule", Just $ show parent), ("Created", Just $ show key)] | (parent,key) <- bad]) ""
src/Development/Shake/FilePath.hs view
@@ -1,5 +1,13 @@ {-# LANGUAGE CPP #-} +#ifndef MIN_VERSION_filepath+#if __GLASGOW_HASKELL__ >= 709+#define MIN_VERSION_filepath(a,b,c) 1+#else+#define MIN_VERSION_filepath(a,b,c) 0+#endif+#endif+ -- | A module for 'FilePath' operations exposing "System.FilePath" plus some additional operations. -- -- /Windows note:/ The extension methods ('<.>', 'takeExtension' etc) use the Posix variants since on@@ -8,7 +16,9 @@ module Development.Shake.FilePath( module System.FilePath, module System.FilePath.Posix, dropDirectory1, takeDirectory1, normaliseEx,+#if !MIN_VERSION_filepath(1,4,0) (-<.>),+#endif toNative, toStandard, exe ) where@@ -19,17 +29,27 @@ import System.FilePath hiding (splitExtension, takeExtension, replaceExtension, dropExtension, addExtension ,hasExtension, (<.>), splitExtensions, takeExtensions, dropExtensions-#if __GLASGOW_HASKELL__ >= 709+#if MIN_VERSION_filepath(1,4,0) ,(-<.>) #endif ) import System.FilePath.Posix (splitExtension, takeExtension, replaceExtension, dropExtension, addExtension- ,hasExtension, (<.>), splitExtensions, takeExtensions, dropExtensions)+ ,hasExtension, (<.>), splitExtensions, takeExtensions, dropExtensions+#if MIN_VERSION_filepath(1,4,0)+ ,(-<.>)+#endif+ ) +#if !MIN_VERSION_filepath(1,4,0) infixr 7 -<.> +-- | Remove the current extension and add another, an alias for 'replaceExtension'.+(-<.>) :: FilePath -> String -> FilePath+(-<.>) = replaceExtension+#endif + -- | Drop the first directory from a 'FilePath'. Should only be used on -- relative paths. --@@ -98,11 +118,6 @@ -- | Convert all path separators to @/@, even on Windows. toStandard :: FilePath -> FilePath toStandard = if isWindows then map (\x -> if x == '\\' then '/' else x) else id----- | Remove the current extension and add another, an alias for 'replaceExtension'.-(-<.>) :: FilePath -> String -> FilePath-(-<.>) = replaceExtension -- | The extension of executables, @\"exe\"@ on Windows and @\"\"@ otherwise.
src/Development/Shake/Rules/File.hs view
@@ -11,7 +11,7 @@ ) where import Control.Applicative-import Control.Monad+import Control.Monad.Extra import Control.Monad.IO.Class import System.Directory import qualified Data.ByteString.Char8 as BS@@ -79,6 +79,12 @@ where bool b = if b then EqualCheap else NotEqual storedValueError :: ShakeOptions -> Bool -> String -> FileQ -> IO FileA+{-+storedValueError opts False msg x | False && not (shakeOutputCheck opts) = do+ when (shakeCreationCheck opts) $ do+ whenM (isNothing <$> (storedValue opts x :: IO (Maybe FileA))) $ error $ msg ++ "\n " ++ unpackU (fromFileQ x)+ return $ FileA fileInfoEq fileInfoEq fileInfoEq+-} storedValueError opts input msg x = fromMaybe def <$> storedValue opts2 x where def = if shakeCreationCheck opts || input then error err else FileA fileInfoNeq fileInfoNeq fileInfoNeq err = msg ++ "\n " ++ unpackU (fromFileQ x)
src/Development/Shake/Types.hs view
@@ -129,6 +129,9 @@ ,shakeCreationCheck :: Bool -- ^ Default to 'True'. After running a rule to create a file, is it an error if the file does not exist. -- Provided for compatibility with @make@ and @ninja@ (which have ugly file creation semantics).++-- ,shakeOutputCheck :: Bool+-- -- ^ Default to 'True'. If a file produced by a rule changes, should you rebuild it. ,shakeLiveFiles :: [FilePath] -- ^ Default to '[]'. After the build system completes, write a list of all files which were /live/ in that run, -- i.e. those which Shake checked were valid or rebuilt. Produces best answers if nothing rebuilds.@@ -161,14 +164,14 @@ ,"shakeLiveFiles","shakeVersionIgnore","shakeProgress", "shakeOutput"] tyShakeOptions = mkDataType "Development.Shake.Types.ShakeOptions" [conShakeOptions] conShakeOptions = mkConstr tyShakeOptions "ShakeOptions" fieldsShakeOptions Prefix-unhide x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 =- ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 (fromFunction x19) (fromFunction x20)+unhide x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 y1 y2 =+ ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 (fromFunction y1) (fromFunction y2) instance Data ShakeOptions where- gfoldl k z (ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20) =+ gfoldl k z (ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 y1 y2) = z unhide `k` x1 `k` x2 `k` x3 `k` x4 `k` x5 `k` x6 `k` x7 `k` x8 `k` x9 `k` x10 `k` x11 `k` x12 `k` x13 `k` x14 `k` x15 `k` x16 `k` x17 `k` x18 `k`- Function x19 `k` Function x20+ Function y1 `k` Function y2 gunfold k z c = k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ z unhide toConstr ShakeOptions{} = conShakeOptions dataTypeOf _ = tyShakeOptions
src/General/Process.hs view
@@ -140,7 +140,7 @@ let files = nubOrd [x | DestFile x <- poStdout ++ poStderr] withs (map (`withFile` WriteMode) files) $ \handles -> do let fileHandle x = fromJust $ lookup x $ zip files handles- let cp = (cmdSpec poCommand){cwd = poCwd, env = poEnv, create_group = isJust poTimeout+ let cp = (cmdSpec poCommand){cwd = poCwd, env = poEnv, create_group = isJust poTimeout, close_fds = True ,std_in = fst $ stdIn poStdin ,std_out = stdStream fileHandle poStdout poStderr, std_err = stdStream fileHandle poStderr poStdout} withCreateProcess cp $ \(inh, outh, errh, pid) -> do
src/Test/Command.hs view
@@ -83,9 +83,11 @@ -- use liftIO since it blows away PATH which makes lint-tracker stop working Stdout out <- liftIO $ cmd (Env [("FOO","HELLO SHAKE")]) Shell helper "vFOO" liftIO $ out === "HELLO SHAKE\n"+ Stdout out <- cmd (AddEnv "FOO" "GOODBYE SHAKE") Shell helper "vFOO"+ liftIO $ out === "GOODBYE SHAKE\n" "path" !> do- path <- addPath [dropTrailingPathSeparator $ obj ""] []+ let path = AddPath [dropTrailingPathSeparator $ obj ""] [] unit $ cmd $ obj "shake_helper" unit $ cmd $ obj "shake_helper" <.> exe unit $ cmd path Shell "shake_helper"
src/Test/Docs.hs view
@@ -156,7 +156,7 @@ restmt i (x:xs) | " ?== " `isInfixOf` x || " == " `isInfixOf` x = zipWith (\j x -> "hack_" ++ show i ++ "_" ++ show j ++ " = " ++ x) [1..] (x:xs) restmt i (x:xs) |- not ("let" `isPrefixOf` x) && not ("[" `isPrefixOf` x) && (" = " `isInfixOf` x || " | " `isInfixOf` x || " :: " `isInfixOf` x) ||+ not ("let" `isPrefixOf` x) && not ("[" `isPrefixOf` x) && not ("cmd " `isPrefixOf` x) && (" = " `isInfixOf` x || " | " `isInfixOf` x || " :: " `isInfixOf` x) || "import " `isPrefixOf` x || "infix" `isPrefixOf` x || "instance " `isPrefixOf` x = map f $ x:xs where f x = if takeWhile (not . isSpace) x `elem` dupes then "_" ++ show i ++ "_" ++ x else x restmt i xs = ("stmt_" ++ show i ++ " = do") : map (" " ++) xs ++
src/Test/Lint.hs view
@@ -6,8 +6,8 @@ import Test.Type import Control.Exception hiding (assert) import System.Directory as IO-import Control.Monad-import Data.Maybe+import System.Info.Extra+import Control.Monad.Extra main = shaken test $ \args obj -> do@@ -69,28 +69,38 @@ writeFile' out "" obj "tracker-write1" %> \out -> do- () <- cmd "cmd /c" ["echo x > " ++ out <.> "txt"]+ gen "x" $ out <.> "txt" need [out <.> "txt"] writeFile' out "" obj "tracker-write2" %> \out -> do- () <- cmd "cmd /c" ["echo x > " ++ out <.> "txt"]+ gen "x" $ out <.> "txt" writeFile' out "" obj "tracker-source2" %> \out -> copyFile' (obj "tracker-source1") out obj "tracker-read1" %> \out -> do- () <- cmd "cmd /c" ["type " ++ toNative (obj "tracker-source1") ++ " > nul"]+ access $ toNative (obj "tracker-source1") writeFile' out "" obj "tracker-read2" %> \out -> do- () <- cmd "cmd /c" ["type " ++ toNative (obj "tracker-source1") ++ " > nul"]+ access $ toNative (obj "tracker-source1") need [obj "tracker-source1"] writeFile' out "" obj "tracker-read3" %> \out -> do- () <- cmd "cmd /c" ["type " ++ toNative (obj "tracker-source2") ++ " > nul"]+ access $ toNative (obj "tracker-source2") need [obj "tracker-source2"] writeFile' out "" + obj "tracker-compile.o" %> \out -> do+ need [obj "tracker-source.c", obj "tracker-source.h"]+ cmd "gcc" ["-c", obj "tracker-source.c", "-o", out]+ where gen t f = unit $ if isWindows+ then cmd "cmd /c" ["echo" ++ t ++ " > " ++ f]+ else cmd Shell "echo" ["x", ">", f]+ access f = unit $ if isWindows+ then cmd "cmd /c" ["type " ++ f ++ " > nul"]+ else cmd Shell "cat" [f, ">/dev/null"] + test build obj = do dir <- getCurrentDirectory let crash args parts = do@@ -108,12 +118,14 @@ crash ["needed1"] ["'needed' file required rebuilding"] build ["needed2"] - tracker <- findExecutable "tracker.exe"- when (isJust tracker) $ do+ whenM hasTracker $ do writeFile (obj "tracker-source1") "" writeFile (obj "tracker-source2") ""+ writeFile (obj "tracker-source.c") "#include <stdio.h>\n#include \"tracker-source.h\"\n"+ writeFile (obj "tracker-source.h") "" crash ["tracker-write1"] ["not have its creation tracked","lint/tracker-write1","lint/tracker-write1.txt"] build ["tracker-write2"] crash ["tracker-read1"] ["used but not depended upon","lint/tracker-source1"] build ["tracker-read2"] crash ["tracker-read3"] ["depended upon after being used","lint/tracker-source2"]+ build ["tracker-compile.o"]
src/Test/Ninja.hs view
@@ -2,9 +2,8 @@ module Test.Ninja(main) where import Development.Shake-import Development.Shake.FilePath import qualified Development.Shake.Config as Config-import System.Directory(copyFile, createDirectoryIfMissing)+import System.Directory(copyFile, createDirectoryIfMissing, removeFile) import Control.Monad import Test.Type import qualified Data.HashMap.Strict as Map@@ -41,15 +40,14 @@ copyFile "src/Test/Ninja/test3-sub.ninja" $ obj "test3-sub.ninja" copyFile "src/Test/Ninja/test3-inc.ninja" $ obj "test3-inc.ninja"- copyFile ("src/Test/Ninja/" ++ if null exe then "test3-unix.ninja" else "test3-win.ninja") $ obj "test3-platform.ninja" createDirectoryIfMissing True $ obj "subdir" copyFile "src/Test/Ninja/subdir/1.ninja" $ obj "subdir/1.ninja" copyFile "src/Test/Ninja/subdir/2.ninja" $ obj "subdir/2.ninja" run "-f../../src/Test/Ninja/test3.ninja"- assertNonSpace (obj "out3.1") "g4+b1+++i1"- assertNonSpace (obj "out3.2") "g4++++i1"- assertNonSpace (obj "out3.3") "g4++++i1"- assertNonSpace (obj "out3.4") "g4+++s1+s2"+ assertContentsWords (obj "out3.1") "g4+b1+++i1"+ assertContentsWords (obj "out3.2") "g4++++i1"+ assertContentsWords (obj "out3.3") "g4++++i1"+ assertContentsWords (obj "out3.4") "g4+++s1+s2" run "-f../../src/Test/Ninja/test4.ninja out" assertExists $ obj "out.txt"@@ -61,10 +59,10 @@ writeFile (obj "nocreate.log") "" writeFile (obj "nocreate.in") "" run "-f../../src/Test/Ninja/nocreate.ninja"- assertNonSpace (obj "nocreate.log") "x"+ assertContentsWords (obj "nocreate.log") "x" run "-f../../src/Test/Ninja/nocreate.ninja" run "-f../../src/Test/Ninja/nocreate.ninja"- assertNonSpace (obj "nocreate.log") "xxx"+ assertContentsWords (obj "nocreate.log") "x x x" writeFile (obj "input") "" runFail "-f../../src/Test/Ninja/lint.ninja bad --lint" "'needed' file required rebuilding"@@ -90,3 +88,21 @@ Map.lookup "v2" config === Just "g2" run "-f../../src/Test/Ninja/phonyorder.ninja bar.txt"++ -- tests from ninjasmith: https://github.com/ndmitchell/ninjasmith/+ run "-f../../src/Test/Ninja/redefine.ninja"+ assertContentsWords (obj "redefine.txt") "version3 version2"++ run "-f../../src/Test/Ninja/buildseparate.ninja"+ assertContentsWords (obj "buildseparate.txt") "XX"++ when False $ do+ -- currently fails because Shake doesn't match Ninja here+ run "-f../../src/Test/Ninja/outputtouch.ninja"+ assertContentsWords (obj "outputtouch.txt") "hello"+ writeFile (obj "outputtouch.txt") "goodbye"+ run "-f../../src/Test/Ninja/outputtouch.ninja"+ assertContentsWords (obj "outputtouch.txt") "goodbye"+ removeFile (obj "outputtouch.txt")+ run "-f../../src/Test/Ninja/outputtouch.ninja"+ assertContentsWords (obj "outputtouch.txt") "hello"
+ src/Test/Ninja/buildseparate.ninja view
@@ -0,0 +1,10 @@++rule record+ # produces XX+ command = hello+ command = echo $vBar $command > $out++build buildseparate.txt: record+ vFoo = foo+ vBar = bar+ vBar = X${vFoo}${vBar}X
+ src/Test/Ninja/outputtouch.ninja view
@@ -0,0 +1,5 @@++rule record+ command = echo hello > $out++build outputtouch.txt: record
+ src/Test/Ninja/redefine.ninja view
@@ -0,0 +1,13 @@++vGlobal = version1++rule record+ # should produce version3 version2+ command = echo $vGlobal $vBuild > $out++vGlobal = version2++build redefine.txt: record+ vBuild = $vGlobal++vGlobal = version3
− src/Test/Ninja/test3-unix.ninja
@@ -1,3 +0,0 @@--rule dump- command = echo "$v1+$v2+$v3+$v4+$v5" > $out
− src/Test/Ninja/test3-win.ninja
@@ -1,3 +0,0 @@--rule dump- command = cmd /c "echo $v1+$v2+$v3+$v4+$v5 > $out"
src/Test/Ninja/test3.ninja view
@@ -3,7 +3,8 @@ v1 = g1 v5 = g1 -include test3-platform.ninja+rule dump+ command = echo $v1+$v2+$v3+$v4+$v5 > $out v1 = g2
src/Test/Type.hs view
@@ -7,18 +7,20 @@ import Development.Shake.FileInfo import Development.Shake.FilePath +import Control.Applicative import Control.Exception.Extra hiding (assert) import Control.Monad.Extra-import Data.Char import Data.List import Data.Maybe import qualified Data.ByteString as BS import System.Directory as IO-import System.Environment+import System.Environment.Extra import System.Random import System.Console.GetOpt import System.IO import System.Time.Extra+import System.Info.Extra+import Prelude shaken@@ -61,14 +63,20 @@ args -> do let (_,files,_) = getOpt Permute [] args- tracker <- findExecutable "tracker.exe"+ tracker <- hasTracker withArgs (args \\ files) $ shakeWithClean- (removeDirectoryRecursive out) - (shakeOptions{shakeFiles=out, shakeReport=["output/" ++ name ++ "/report.html"], shakeLint=Just $ if isJust tracker then LintTracker else LintBasic})+ (removeDirectoryRecursive out)+ (shakeOptions{shakeFiles = out+ ,shakeReport = ["output/" ++ name ++ "/report.html"]+ ,shakeLint = Just $ if tracker then LintTracker else LintBasic+ }) (rules files obj) +hasTracker :: IO Bool+hasTracker = isJust <$> if isWindows then findExecutable "tracker.exe" else lookupEnv "FSAT" + shakeWithClean :: IO () -> ShakeOptions -> Rules () -> IO () shakeWithClean clean opts rules = shakeArgsWith opts [cleanOpt] f where@@ -115,8 +123,9 @@ assert (f want == f got) $ "File contents are wrong: " ++ file ++ "\nWANT: " ++ want ++ "\nGOT: " ++ got ++ "\nWANT (transformed): " ++ f want ++ "\nGOT (transformed): " ++ f got -assertNonSpace :: FilePath -> String -> IO ()-assertNonSpace = assertContentsOn $ filter (not . isSpace)+assertContentsWords :: FilePath -> String -> IO ()+assertContentsWords = assertContentsOn (unwords . words)+ assertContentsInfix :: FilePath -> String -> IO () assertContentsInfix file want = do