This commit is contained in:
Joey Hess 2012-12-19 22:58:31 -04:00
parent 8491917d04
commit 3ef0ac2fa5
2 changed files with 39 additions and 21 deletions

37
Utility/QuickCheck.hs Normal file
View file

@ -0,0 +1,37 @@
{- QuickCheck 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 where
import Test.QuickCheck
import Data.Time.Clock.POSIX
import System.Posix.Types
{- 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)

23
test.hs
View file

@ -6,7 +6,6 @@
-} -}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TypeSynonymInstances #-}
import Test.HUnit import Test.HUnit
import Test.HUnit.Tools import Test.HUnit.Tools
@ -21,6 +20,7 @@ import System.IO.HVFS (SystemFS(..))
import Text.JSON import Text.JSON
import Common import Common
import Utility.QuickCheck ()
import qualified Utility.SafeCommand import qualified Utility.SafeCommand
import qualified Annex import qualified Annex
@ -54,9 +54,6 @@ import qualified Utility.Process
import qualified Utility.Misc import qualified Utility.Misc
import qualified Annex.Content.Direct import qualified Annex.Content.Direct
import Data.Time.Clock.POSIX
import System.Posix.Types
-- instances for quickcheck -- instances for quickcheck
instance Arbitrary Types.Key.Key where instance Arbitrary Types.Key.Key where
arbitrary = Types.Key.Key arbitrary = Types.Key.Key
@ -76,32 +73,17 @@ instance Arbitrary Logs.Transfer.TransferInfo where
<*> arbitrary `suchThat` (/= Just "") <*> arbitrary `suchThat` (/= Just "")
<*> arbitrary <*> arbitrary
instance Arbitrary POSIXTime where
arbitrary = abs <$> arbitrarySizedIntegral
instance Arbitrary ProcessID where
arbitrary = abs <$> arbitraryBoundedIntegral
instance Arbitrary Annex.Content.Direct.Cache where instance Arbitrary Annex.Content.Direct.Cache where
arbitrary = Annex.Content.Direct.Cache arbitrary = Annex.Content.Direct.Cache
<$> arbitrary <$> arbitrary
<*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
instance Arbitrary EpochTime where
arbitrary = abs <$> arbitrarySizedIntegral
instance Arbitrary FileID where
arbitrary = abs <$> arbitrarySizedIntegral
instance Arbitrary FileOffset where
arbitrary = abs <$> arbitrarySizedIntegral
instance Arbitrary Logs.Presence.LogLine where instance Arbitrary Logs.Presence.LogLine where
arbitrary = Logs.Presence.LogLine arbitrary = Logs.Presence.LogLine
<$> arbitrary <$> arbitrary
<*> elements [minBound..maxBound] <*> elements [minBound..maxBound]
<*> (arbitrary `suchThat` ('\n' `notElem`)) <*> arbitrary `suchThat` ('\n' `notElem`)
main :: IO () main :: IO ()
main = do main = do
@ -125,7 +107,6 @@ quickcheck = TestLabel "quickcheck" $ TestList
, qctest "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword , qctest "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword
, qctest "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape , qctest "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape
, qctest "prop_parentDir_basics" Utility.Path.prop_parentDir_basics , qctest "prop_parentDir_basics" Utility.Path.prop_parentDir_basics
, qctest "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics , qctest "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics
, qctest "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest , qctest "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest
, qctest "prop_cost_sane" Config.prop_cost_sane , qctest "prop_cost_sane" Config.prop_cost_sane