summaryrefslogtreecommitdiff
path: root/Utility/QuickCheck.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@debian.org>2013-11-22 11:16:03 -0400
committerJoey Hess <joeyh@debian.org>2013-11-22 11:16:03 -0400
commit7e592e1d6ed5e0b25b37215da7558c6324688d6f (patch)
tree75a86ff02e9311bcff817f2dcfe9b0a6ca1b5708 /Utility/QuickCheck.hs
downloadgit-repair-7e592e1d6ed5e0b25b37215da7558c6324688d6f.tar.gz
git-repair (1.20131122) unstable; urgency=low
* Added test mode, which can be used to randomly corrupt test repositories, in reproducible ways, which allows easy corruption-driven-development. * Improve repair code in the case where the index file is corrupt, and this hides other problems. * Write a dummy .git/HEAD if the file is missing or corrupt, as git otherwise will not treat the repository as a git repo. * Improve fsck code to find badly corrupted objects that crash git fsck before it can complain about them. * Fixed crashes on bad file encodings. * Can now run 10000 tests (git-repair --test -n 10000 --force) with 0 failures. # imported from the archive
Diffstat (limited to 'Utility/QuickCheck.hs')
-rw-r--r--Utility/QuickCheck.hs48
1 files changed, 48 insertions, 0 deletions
diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs
new file mode 100644
index 0000000..82af09f
--- /dev/null
+++ b/Utility/QuickCheck.hs
@@ -0,0 +1,48 @@
+{- QuickCheck with additional instances
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Utility.QuickCheck
+ ( module X
+ , module Utility.QuickCheck
+ ) where
+
+import Test.QuickCheck as X
+import Data.Time.Clock.POSIX
+import System.Posix.Types
+import qualified Data.Map as M
+import Control.Applicative
+
+instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where
+ arbitrary = M.fromList <$> arbitrary
+
+{- Times before the epoch are excluded. -}
+instance Arbitrary POSIXTime where
+ arbitrary = nonNegative arbitrarySizedIntegral
+
+instance Arbitrary EpochTime where
+ arbitrary = nonNegative arbitrarySizedIntegral
+
+{- Pids are never negative, or 0. -}
+instance Arbitrary ProcessID where
+ arbitrary = arbitrarySizedBoundedIntegral `suchThat` (> 0)
+
+{- Inodes are never negative. -}
+instance Arbitrary FileID where
+ arbitrary = nonNegative arbitrarySizedIntegral
+
+{- File sizes are never negative. -}
+instance Arbitrary FileOffset where
+ arbitrary = nonNegative arbitrarySizedIntegral
+
+nonNegative :: (Num a, Ord a) => Gen a -> Gen a
+nonNegative g = g `suchThat` (>= 0)
+
+positive :: (Num a, Ord a) => Gen a -> Gen a
+positive g = g `suchThat` (> 0)