diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,9 @@ Changelog for Shake (* = breaking change) +0.19.5, released 2021-07-04 + #807, fix space leak in Database module + #796, fix a bug with newCache dependencies + #798, optimise dependency checking 0.19.4, released 2021-01-14 #790, add option shakeAllowRedefineRules * #790, remove overrideBuiltinRule diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# Shake [![Hackage version](https://img.shields.io/hackage/v/shake.svg?label=Hackage)](https://hackage.haskell.org/package/shake) [![Stackage version](https://www.stackage.org/package/shake/badge/nightly?label=Stackage)](https://www.stackage.org/package/shake) [![Build status](https://img.shields.io/github/workflow/status/ndmitchell/shake/ci.svg)](https://github.com/ndmitchell/shake/actions) +# Shake [![Hackage version](https://img.shields.io/hackage/v/shake.svg?label=Hackage)](https://hackage.haskell.org/package/shake) [![Stackage version](https://www.stackage.org/package/shake/badge/nightly?label=Stackage)](https://www.stackage.org/package/shake) [![Build status](https://img.shields.io/github/workflow/status/ndmitchell/shake/ci/master.svg)](https://github.com/ndmitchell/shake/actions) Shake is a tool for writing build systems - an alternative to make, Scons, Ant etc. Shake has been used commercially for over five years, running thousands of builds per day. The website for Shake users is at [shakebuild.com](https://shakebuild.com). diff --git a/shake.cabal b/shake.cabal --- a/shake.cabal +++ b/shake.cabal @@ -1,7 +1,7 @@ -cabal-version: >= 1.18 +cabal-version: 1.18 build-type: Simple name: shake -version: 0.19.4 +version: 0.19.5 license: BSD3 license-file: LICENSE category: Development, Shake @@ -30,7 +30,7 @@ (e.g. compiler version). homepage: https://shakebuild.com bug-reports: https://github.com/ndmitchell/shake/issues -tested-with: GHC==8.10, GHC==8.8, GHC==8.6, GHC==8.4, GHC==8.2, GHC==8.0 +tested-with: GHC==9.0, GHC==8.10, GHC==8.8, GHC==8.6, GHC==8.4, GHC==8.2, GHC==8.0 extra-doc-files: CHANGES.txt README.md diff --git a/src/Development/Shake/Internal/CmdOption.hs b/src/Development/Shake/Internal/CmdOption.hs --- a/src/Development/Shake/Internal/CmdOption.hs +++ b/src/Development/Shake/Internal/CmdOption.hs @@ -12,7 +12,7 @@ | AddEnv String String -- ^ Add an environment variable in the child process. | RemEnv String -- ^ Remove an environment variable from 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. + | Stdin String -- ^ Given as the @stdin@ of the spawned process. | StdinBS LBS.ByteString -- ^ Given as the @stdin@ of the spawned process. | FileStdin FilePath -- ^ Take the @stdin@ from a file. | Shell -- ^ Pass the command to the shell without escaping - any arguments will be joined with spaces. By default arguments are escaped properly. diff --git a/src/Development/Shake/Internal/Core/Action.hs b/src/Development/Shake/Internal/Core/Action.hs --- a/src/Development/Shake/Internal/Core/Action.hs +++ b/src/Development/Shake/Internal/Core/Action.hs @@ -395,8 +395,14 @@ pure $ depends r --- | This rule should not be cached or recorded in the history because it makes use of untracked dependencies --- (e.g. files in a system directory or items on the @$PATH@), or is trivial to compute locally. +-- | This rule should not be saved to shared/cloud storage via 'shakeShare'. +-- There are usually two reasons to call this function: +-- +-- 1. It makes use of untracked dependencies that are specific to this machine, +-- e.g. files in a system directory or items on the @$PATH@. +-- 2. The rule is trivial to compute locally, so there is no point sharing it. +-- +-- If you want the rule to not be cached at all, use 'alwaysRerun'. historyDisable :: Action () historyDisable = Action $ modifyRW $ \s -> s{localHistory = False} @@ -446,6 +452,7 @@ Nothing -> do bar <- newFence pure $ (Map.insert key bar mp,) $ do + Local{localDepends=pre} <- Action getRW Action $ modifyRW $ \s -> s{localDepends = newDepends []} res <- Action $ tryRAW $ fromAction $ act key case res of @@ -454,6 +461,7 @@ Action $ throwRAW err Right v -> do Local{localDepends=deps} <- Action getRW + Action $ modifyRW $ \s -> s{localDepends = addDepends pre deps} liftIO $ signalFence bar $ Right (deps, v) pure v @@ -477,6 +485,9 @@ -- | Execute a list of actions in parallel. In most cases 'need' will be more appropriate to benefit from parallelism. +-- If the two types of 'Action' are different dependencies which ultimately boil down to 'apply', +-- using 'Applicative' operations will still ensure the dependencies occur in parallel. +-- The main use of this function is to run work that happens in an 'Action' in parallel. parallel :: [Action a] -> Action [a] -- Note: There is no parallel_ unlike sequence_ because there is no stack benefit to doing so parallel [] = pure [] diff --git a/src/Development/Shake/Internal/Core/Database.hs b/src/Development/Shake/Internal/Core/Database.hs --- a/src/Development/Shake/Internal/Core/Database.hs +++ b/src/Development/Shake/Internal/Core/Database.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving, RecordWildCards #-} module Development.Shake.Internal.Core.Database( @@ -101,7 +102,9 @@ setMem Database{..} i k v = liftIO $ Ids.insert status i (k,v) modifyAllMem :: DatabasePoly k v -> (v -> v) -> Locked () -modifyAllMem Database{..} f = liftIO $ Ids.forMutate status $ second f +modifyAllMem Database{..} f = liftIO $ Ids.forMutate status $ \(k,v) -> + let !v' = f v + in (k, v') setDisk :: DatabasePoly k v -> Id -> k -> v -> IO () setDisk = journal diff --git a/src/Development/Shake/Internal/Core/Types.hs b/src/Development/Shake/Internal/Core/Types.hs --- a/src/Development/Shake/Internal/Core/Types.hs +++ b/src/Development/Shake/Internal/Core/Types.hs @@ -58,6 +58,10 @@ -- | The 'Action' monad, use 'liftIO' to raise 'IO' actions into it, and 'Development.Shake.need' to execute files. -- Action values are used by 'addUserRule' and 'action'. The 'Action' monad tracks the dependencies of a rule. -- To raise an exception call 'error', 'fail' or @'liftIO' . 'throwIO'@. +-- +-- The 'Action' type is both a 'Monad' and 'Applicative'. Anything that is depended upon applicatively +-- will have its dependencies run in parallel. For example @'need' [\"a\"] *> 'need [\"b\"]@ is equivalent +-- to @'need' [\"a\", \"b\"]@. newtype Action a = Action {fromAction :: RAW ([String],[Key]) [Value] Global Local a} deriving (Functor, Applicative, Monad, MonadIO, Typeable, Semigroup, Monoid, MonadFail) diff --git a/src/Development/Shake/Internal/Resource.hs b/src/Development/Shake/Internal/Resource.hs --- a/src/Development/Shake/Internal/Resource.hs +++ b/src/Development/Shake/Internal/Resource.hs @@ -25,7 +25,12 @@ {-# NOINLINE resourceId #-} resourceId :: IO Int -resourceId = unsafePerformIO $ do +resourceId = unsafePerformIO resourceCounter + +-- Work around for GHC bug https://gitlab.haskell.org/ghc/ghc/-/issues/19413 +{-# NOINLINE resourceCounter #-} +resourceCounter :: IO (IO Int) +resourceCounter = do ref <- newIORef 0 pure $ atomicModifyIORef' ref $ \i -> let j = i + 1 in (j, j) diff --git a/src/General/Wait.hs b/src/General/Wait.hs --- a/src/General/Wait.hs +++ b/src/General/Wait.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} -- | A bit like 'Fence', but not thread safe and optimised for avoiding taking the fence @@ -60,21 +61,21 @@ fail = Lift . Control.Monad.Fail.fail firstJustWaitUnordered :: MonadIO m => (a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b) -firstJustWaitUnordered f = go [] . map f +firstJustWaitUnordered f = go 0 [] . map f where -- keep a list of those things we might visit later, and ask for each we see in turn - go :: MonadIO m => [(Maybe a -> m ()) -> m ()] -> [Wait m (Maybe a)] -> Wait m (Maybe a) - go later (x:xs) = case x of + go :: MonadIO m => Int -> [(Maybe a -> m ()) -> m ()] -> [Wait m (Maybe a)] -> Wait m (Maybe a) + go !nlater later (x:xs) = case x of Now (Just a) -> Now $ Just a - Now Nothing -> go later xs - Later l -> go (l:later) xs + Now Nothing -> go nlater later xs + Later l -> go (succ nlater) (l:later) xs Lift x -> Lift $ do x <- x - pure $ go later (x:xs) - go [] [] = Now Nothing - go [l] [] = Later l - go ls [] = Later $ \callback -> do - ref <- liftIO $ newIORef $ length ls + pure $ go nlater later (x:xs) + go _ [] [] = Now Nothing + go _ [l] [] = Later l + go nls ls [] = Later $ \callback -> do + ref <- liftIO $ newIORef nls forM_ ls $ \l -> l $ \r -> do old <- liftIO $ readIORef ref when (old > 0) $ case r of diff --git a/src/Test/Cache.hs b/src/Test/Cache.hs --- a/src/Test/Cache.hs +++ b/src/Test/Cache.hs @@ -24,7 +24,15 @@ startCompiler () liftIO $ copyFile "compiler.txt" out + -- Bug fixed in https://github.com/ndmitchell/shake/pull/796 + bug796_2 <- newCache $ \() -> do + readFile' "bug796.2" + "bug796" %> \out -> do + a <- readFile' "bug796.1" + b <- bug796_2 () + writeFile' out $ a ++ b + test build = do build ["clean"] writeFile "trace.txt" "" @@ -53,3 +61,14 @@ writeFile "compiler.txt" "unstarted" build ["foo.lang","bar.lang"] assertContents "compiler.txt" "unstarted" + + writeFile "bug796.1" "a" + writeFile "bug796.2" "b" + build ["bug796", "--sleep"] + assertContents "bug796" "ab" + writeFile "bug796.1" "A" + build ["bug796", "--sleep"] + assertContents "bug796" "Ab" + writeFile "bug796.2" "B" + build ["bug796", "--sleep"] + assertContents "bug796" "AB" diff --git a/src/Test/Docs.hs b/src/Test/Docs.hs --- a/src/Test/Docs.hs +++ b/src/Test/Docs.hs @@ -114,7 +114,7 @@ ,"import Control.Applicative" ,"import Control.Monad.IO.Class" ,"import Control.Monad.Fail" - ,"import System.IO"] ++ + ,"import System.IO hiding (readFile')"] ++ ["import " ++ replace "_" "." (drop 5 $ takeBaseName out) | not $ "_md.hs" `isSuffixOf` out] ++ imports ++ ["(==>) :: Bool -> Bool -> Bool"