shake 0.18.4 → 0.18.5

raw patch · 15 files changed

+63/−21 lines, 15 files

Files

• CHANGES.txt +4/−0
• LICENSE +1/−1
• shake.cabal +2/−2
• src/Development/Shake/Command.hs +7/−1
• src/Development/Shake/Internal/Demo.hs +1/−1
• src/Development/Shake/Internal/Profile.hs +3/−3
• src/General/Chunks.hs +1/−1
• src/General/Cleanup.hs +6/−2
• src/Test/Cleanup.hs +1/−1
• src/Test/Command.hs +2/−2
• src/Test/Database.hs +29/−2
• src/Test/Docs.hs +1/−0
• src/Test/Progress.hs +1/−1
• src/Test/Resources.hs +2/−2
• src/Test/Type.hs +2/−2

@@ -1,5 +1,9 @@ Changelog for Shake (* = breaking change) +0.18.5, released 2020-02-02+    Use uninterruptibleMask_ to ensure all cleanup happens robustly+    #742, make the Chrome profile only include the last run+    #740, make CmdArgument an instance of IsCmdArgument 0.18.4, released 2019-12-15     #734, add Forward.cacheActionWith     #734, make forward fail if shakeLintInside is empty

@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2011-2019.+Copyright Neil Mitchell 2011-2020. All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,13 +1,13 @@ cabal-version:      >= 1.18 build-type:         Simple name:               shake-version:            0.18.4+version:            0.18.5 license:            BSD3 license-file:       LICENSE category:           Development, Shake author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2011-2019+copyright:          Neil Mitchell 2011-2020 synopsis:           Build system library, like Make, but more accurate dependencies. description:     Shake is a Haskell library for writing build systems - designed as a

@@ -625,7 +625,7 @@ type a :-> t = a  --- | Execute a system command. Before running 'cmd' make sure you 'Development.Shake.need' any files+-- | Build or execute a system command. Before using 'cmd' to run a command, make sure you 'Development.Shake.need' any files --   that are used by the command. -- -- * @String@ arguments are treated as a list of whitespace separated arguments.@@ -634,6 +634,8 @@ -- -- * 'CmdOption' arguments are used as options. --+-- * 'CmdArgument' arguments, which can be built by 'cmd' itself, are spliced into the containing command.+-- --   Typically only string literals should be passed as @String@ arguments. When using variables --   prefer @[myvar]@ so that if @myvar@ contains spaces they are properly escaped. --@@ -655,6 +657,9 @@ -- ('Exit' c, 'Stderr' err) <- 'cmd' \"gcc -c myfile.c\"                -- run a command, recording the exit code and error output -- 'Stdout' out <- 'cmd' \"gcc -MM myfile.c\"                         -- run a command, recording the output -- 'cmd' ('Cwd' \"generated\") \"gcc -c\" [myfile] :: 'Action' ()         -- run a command in a directory+--+-- let gccCommand = 'cmd' \"gcc -c\" :: 'CmdArgument'                 -- build a sub-command. 'cmd' can return 'CmdArgument' values as well as execute commands+-- cmd ('Cwd' \"generated\") gccCommand [myfile]                 -- splice that command into a greater command -- @ -- --   If you use 'cmd' inside a @do@ block and do not use the result, you may get a compile-time error about being@@ -704,6 +709,7 @@ instance IsCmdArgument [String] where toCmdArgument = CmdArgument . map Right instance IsCmdArgument CmdOption where toCmdArgument = CmdArgument . return . Left instance IsCmdArgument [CmdOption] where toCmdArgument = CmdArgument . map Left+instance IsCmdArgument CmdArgument where toCmdArgument = id instance IsCmdArgument a => IsCmdArgument (Maybe a) where toCmdArgument = maybe mempty toCmdArgument  

@@ -38,7 +38,7 @@     require shakeLib "% You don't have the 'shake' library installed with GHC, which is required to run the demo."     require hasManual "% You don't have the Shake data files installed, which are required to run the demo." -    empty <- not . any (not . all (== '.')) <$> getDirectoryContents "."+    empty <- all (all (== '.')) <$> getDirectoryContents "."     dir <- if empty then getCurrentDirectory else do         home <- getHomeDirectory         dir <- getDirectoryContents home

@@ -94,7 +94,6 @@     {prfCommand :: String, prfStart :: Double, prfStop :: Double} prfTime ProfileTrace{..} = prfStop - prfStart - -- | Generates an report given some build system profiling data. writeProfile :: FilePath -> Database -> IO () writeProfile out db = writeProfileInternal out =<< toReport db@@ -138,9 +137,10 @@  generateTrace :: [ProfileEntry] -> String generateTrace xs = jsonListLines $-    showEntries 0 [y{prfCommand=prfName x} | x <- xs, y <- prfTraces x] ++-    showEntries 1 (concatMap prfTraces xs)+    showEntries 0 [y{prfCommand=prfName x} | x <- onlyLast, y <- prfTraces x] +++    showEntries 1 (concatMap prfTraces onlyLast)     where+        onlyLast = filter (\x -> prfBuilt x == 0) xs         showEntries pid xs = map (showEntry pid) $ snd $ mapAccumL alloc [] $ sortOn prfStart xs          alloc :: [ProfileTrace] -> ProfileTrace -> ([ProfileTrace], (Int, ProfileTrace))

@@ -62,7 +62,7 @@ -- Make sure all exceptions happen on the caller, so we don't have to move exceptions back -- Make sure we only write on one thread, otherwise async exceptions can cause partial writes usingWriteChunks cleanup Chunks{..} = do-    h <- allocate cleanup (takeMVar chunksHandle)  (putMVar chunksHandle)+    h <- allocate cleanup (takeMVar chunksHandle) (putMVar chunksHandle)     chan <- newChan -- operations to perform on the file     kick <- newEmptyMVar -- kicked whenever something is written     died <- newBarrier -- has the writing thread finished

@@ -33,7 +33,11 @@ newCleanup :: IO (Cleanup, IO ()) newCleanup = do     ref <- newIORef $ S 0 Map.empty-    let clean = mask_ $ do+    -- important to use uninterruptibleMask_ otherwise in things like allocateThread+    -- we might end up being interrupted and failing to close down the thread+    -- e.g. see https://github.com/digital-asset/ghcide/issues/381+    -- note that packages like safe-exceptions also use uninterruptibleMask_+    let clean = uninterruptibleMask_ $ do             items <- atomicModifyIORef' ref $ \s -> (s{items=Map.empty}, items s)             mapM_ snd $ sortOn (negate . fst) $ Map.toList items     return (Cleanup ref, clean)@@ -47,7 +51,7 @@ unprotect (ReleaseKey ref i) = atomicModifyIORef' ref $ \s -> (s{items = Map.delete i $ items s}, ())  release :: ReleaseKey -> IO ()-release (ReleaseKey ref i) = mask_ $ do+release (ReleaseKey ref i) = uninterruptibleMask_ $ do     undo <- atomicModifyIORef' ref $ \s -> (s{items = Map.delete i $ items s}, Map.lookup i $ items s)     fromMaybe (return ()) undo 

@@ -39,7 +39,7 @@     do -- cleanup actions are masked https://github.com/snoyberg/conduit/issues/144         let checkMasked name = do                 ms <- getMaskingState-                unless (ms == MaskedInterruptible) $+                unless (ms == MaskedUninterruptible) $                     error $ show (name, ms)         withCleanup $ \cleanup -> do             register cleanup (checkMasked "release") >>= release

@@ -71,8 +71,8 @@     "failure" !> do         (Exit e, Stdout (), Stderr ()) <- cmd helper "oo ee x"         when (e == ExitSuccess) $ error "/= ExitSuccess"-        liftIO $ assertException ["BAD"] $ cmd helper "oo eBAD x" (EchoStdout False) (EchoStderr False)-        liftIO $ assertException ["MORE"] $ cmd helper "oMORE eBAD x" (WithStdout True) (WithStderr False) (EchoStdout False) (EchoStderr False)+        liftIO $ assertException ["BAD"] $ cmd_ helper "oo eBAD x" (EchoStdout False) (EchoStderr False)+        liftIO $ assertException ["MORE"] $ cmd_ helper "oMORE eBAD x" (WithStdout True) (WithStderr False) (EchoStdout False) (EchoStderr False)      "throws" ~>         cmd Shell "not_a_process foo"

@@ -5,6 +5,7 @@ import Control.Exception.Extra import Control.Monad import Data.List+import Data.IORef import Development.Shake import Development.Shake.Database import Development.Shake.FilePath@@ -64,12 +65,38 @@         assertBool ("currently running" `isInfixOf` results) "Contains 'currently using'"      close-    assertException ["already closed"] $ void $ shakeRunDatabase db []+    assertException ["already closed"] $ shakeRunDatabase db []      shakeRunAfter opts after     assertBoolIO (not <$> IO.doesFileExist "log.txt") "Log must be deleted"      errs <- shakeWithDatabase opts{shakeStaunch=True, shakeVerbosity=Silent} rules $ \db -> do-        assertException ["Error when running"] $ void $ shakeRunDatabase db [need ["foo.err","bar.err"]]+        assertException ["Error when running"] $ shakeRunDatabase db [need ["foo.err","bar.err"]]         shakeErrorsDatabase db     sort (map fst errs) === ["bar.err","foo.err"]++    -- check the progress thread gets killed properly on normal cleanup+    ref <- newIORef 0+    opts <- return opts{shakeProgress = const $ bracket_ (modifyIORef ref succ) (modifyIORef ref succ) $ sleep 100}+    (open, close) <- shakeOpenDatabase opts rules+    db <- open+    ([12], after) <- shakeRunDatabase db [need ["a.out"] >> liftIO (modifyIORef ref succ) >> return 12]+    (=== 3) =<< readIORef ref -- success if it all shuts down cleanly++    -- and on an exception+    writeIORef ref 0+    assertException ["terminate"] $ shakeRunDatabase db [liftIO (modifyIORef ref succ) >> fail "terminate"]+    (=== 3) =<< readIORef ref++    -- and on an external exception+    writeIORef ref 0+    bar <- newBarrier; bar2 <- newBarrier+    t <- flip forkFinally (signalBarrier bar2)  $ void $ shakeRunDatabase db $ return $ do+        liftIO $ modifyIORef ref succ+        liftIO $ signalBarrier bar ()+        need ["sleep"]+    waitBarrier bar+    sleep 0.1+    killThread t+    waitBarrier bar2+    (=== 3) =<< readIORef ref

@@ -99,6 +99,7 @@             ,"import Data.Maybe"             ,"import Data.Monoid"             ,"import Development.Shake hiding ((*>))"+            ,"import Development.Shake.Command"             ,"import Development.Shake.Classes"             ,"import Development.Shake.Database"             ,"import Development.Shake.Rule"

@@ -46,7 +46,7 @@     xs <- progEx 2 $ 100:map (*2) [10,9..1]     drop 5 xs === [6,5..1]     xs <- progEx 1 [10,9,100,8,7,6,5,4,3,2,1]-    assertBool (all (<= 1.5) $ map abs $ zipWith (-) (drop 5 xs) [6,5..1]) "Close"+    assertBool (all ((<= 1.5) . abs) $ zipWith (-) (drop 5 xs) [6,5..1]) "Close"      -- if no progress is made, don't keep the time going up     xs <- prog [10,9,8,7,7,7,7,7]

@@ -74,5 +74,5 @@             (s, _) <- duration $ build [flags,"throttle","--no-report","--clean"]             -- the 0.1s cap is a guess at an upper bound for how long everything else should take             -- and should be raised on slower machines-            assertBool (s >= 1.4 && s < 1.6) $-                "Bad throttling, expected to take 1.4s + computation time (cap of 0.2s), took " ++ show s ++ "s"+            assertBool (s >= 1.4 && s < 1.8) $+                "Bad throttling, expected to take 1.4s + computation time (cap of 0.4s), took " ++ show s ++ "s"

@@ -210,7 +210,7 @@ assertContentsUnordered :: FilePath -> [String] -> IO () assertContentsUnordered file xs = assertContentsOn (unlines . sort . lines) file (unlines xs) -assertExceptionAfter :: (String -> String) -> [String] -> IO () -> IO ()+assertExceptionAfter :: (String -> String) -> [String] -> IO a -> IO () assertExceptionAfter tweak parts act = do     res <- try_ act     case res of@@ -218,7 +218,7 @@             assertBool (p `isInfixOf` s) $ "Incorrect exception, missing part:\nGOT: " ++ s ++ "\nWANTED: " ++ p         Right _ -> error $ "Expected an exception containing " ++ show parts ++ ", but succeeded" -assertException :: [String] -> IO () -> IO ()+assertException :: [String] -> IO a -> IO () assertException = assertExceptionAfter id  defaultTest :: ([String] -> IO ()) -> IO ()