make fuzztest honor annex.diskreserve
This commit is contained in:
parent
62c368dd7c
commit
9978269b55
1 changed files with 22 additions and 8 deletions
|
@ -8,11 +8,13 @@
|
||||||
module Command.FuzzTest where
|
module Command.FuzzTest where
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
|
import qualified Annex
|
||||||
import Command
|
import Command
|
||||||
import qualified Git.Config
|
import qualified Git.Config
|
||||||
import Config
|
import Config
|
||||||
import Utility.ThreadScheduler
|
import Utility.ThreadScheduler
|
||||||
import Annex.Exception
|
import Annex.Exception
|
||||||
|
import Utility.DiskFree
|
||||||
|
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import System.Random (getStdRandom, random, randomR)
|
import System.Random (getStdRandom, random, randomR)
|
||||||
|
@ -67,18 +69,30 @@ record h tmpl = liftIO $ do
|
||||||
hFlush h
|
hFlush h
|
||||||
|
|
||||||
{- Delay for either a fraction of a second, or a few seconds, or up
|
{- Delay for either a fraction of a second, or a few seconds, or up
|
||||||
- to 1 minute. -}
|
- to 1 minute.
|
||||||
randomDelay :: Delay -> IO ()
|
-
|
||||||
randomDelay TinyDelay = threadDelay =<< getStdRandom (randomR (10000, 1000000))
|
- The MinutesDelay is used as an opportunity to do housekeeping tasks.
|
||||||
randomDelay SecondsDelay = threadDelaySeconds =<< Seconds <$> getStdRandom (randomR (1, 10))
|
-}
|
||||||
randomDelay MinutesDelay = threadDelaySeconds =<< Seconds <$> getStdRandom (randomR (1, 60))
|
randomDelay :: Delay -> Annex ()
|
||||||
randomDelay NoDelay = noop
|
randomDelay TinyDelay = liftIO $
|
||||||
|
threadDelay =<< getStdRandom (randomR (10000, 1000000))
|
||||||
|
randomDelay SecondsDelay = liftIO $
|
||||||
|
threadDelaySeconds =<< Seconds <$> getStdRandom (randomR (1, 10))
|
||||||
|
randomDelay MinutesDelay = do
|
||||||
|
liftIO $ threadDelaySeconds =<< Seconds <$> getStdRandom (randomR (1, 60))
|
||||||
|
reserve <- annexDiskReserve <$> Annex.getGitConfig
|
||||||
|
free <- liftIO $ getDiskFree "."
|
||||||
|
case free of
|
||||||
|
Just have | have < reserve -> do
|
||||||
|
warning "Low disk space; fuzz test paused."
|
||||||
|
liftIO $ threadDelaySeconds (Seconds 60)
|
||||||
|
randomDelay MinutesDelay
|
||||||
|
_ -> noop
|
||||||
|
|
||||||
data Delay
|
data Delay
|
||||||
= TinyDelay
|
= TinyDelay
|
||||||
| SecondsDelay
|
| SecondsDelay
|
||||||
| MinutesDelay
|
| MinutesDelay
|
||||||
| NoDelay
|
|
||||||
deriving (Read, Show, Eq)
|
deriving (Read, Show, Eq)
|
||||||
|
|
||||||
instance Arbitrary Delay where
|
instance Arbitrary Delay where
|
||||||
|
@ -175,7 +189,7 @@ runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $
|
||||||
removeDirectoryRecursive d
|
removeDirectoryRecursive d
|
||||||
runFuzzAction (FuzzMoveDir (FuzzDir src) (FuzzDir dest)) = liftIO $
|
runFuzzAction (FuzzMoveDir (FuzzDir src) (FuzzDir dest)) = liftIO $
|
||||||
rename src dest
|
rename src dest
|
||||||
runFuzzAction (FuzzPause d) = liftIO $ randomDelay d
|
runFuzzAction (FuzzPause d) = randomDelay d
|
||||||
|
|
||||||
genFuzzAction :: Annex FuzzAction
|
genFuzzAction :: Annex FuzzAction
|
||||||
genFuzzAction = do
|
genFuzzAction = do
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue