move Arbitrary instances out of Test and into modules that define the types

This is possible now that we build-depend on QuickCheck.
This commit is contained in:
Joey Hess 2013-02-27 21:42:07 -04:00
parent e7b78c2eec
commit a2f17146fa
5 changed files with 54 additions and 51 deletions

View file

@ -29,6 +29,8 @@ import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import qualified Data.Map as M
import Test.QuickCheck
import Utility.QuickCheck ()
import Common.Annex
import qualified Annex.Branch
@ -74,10 +76,6 @@ showLog = unlines . map genline
genstatus InfoPresent = "1"
genstatus InfoMissing = "0"
-- for quickcheck
prop_parse_show_log :: [LogLine] -> Bool
prop_parse_show_log l = parseLog (showLog l) == l
{- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> String -> Annex LogLine
logNow s i = do
@ -113,3 +111,13 @@ mapLog l m
better = maybe True newer $ M.lookup i m
newer l' = date l' <= date l
i = info l
instance Arbitrary LogLine where
arbitrary = LogLine
<$> arbitrary
<*> elements [minBound..maxBound]
<*> arbitrary `suchThat` ('\n' `notElem`)
prop_parse_show_log :: [LogLine] -> Bool
prop_parse_show_log l = parseLog (showLog l) == l

View file

@ -21,6 +21,8 @@ import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import Control.Concurrent
import Test.QuickCheck
import Utility.QuickCheck ()
{- Enough information to uniquely identify a transfer, used as the filename
- of the transfer information file. -}
@ -306,15 +308,6 @@ readTransferInfo mpid s = TransferInfo
then Just <$> readish =<< headMaybe (drop 1 bits)
else pure Nothing -- not failure
{- for quickcheck -}
prop_read_write_transferinfo :: TransferInfo -> Bool
prop_read_write_transferinfo info
| transferRemote info /= Nothing = True -- remote not stored
| transferTid info /= Nothing = True -- tid not stored
| otherwise = Just (info { transferPaused = False }) == info'
where
info' = readTransferInfo (transferPid info) (writeTransferInfo info)
parsePOSIXTime :: String -> Maybe POSIXTime
parsePOSIXTime s = utcTimeToPOSIXSeconds
<$> parseTime defaultTimeLocale "%s%Qs" s
@ -330,3 +323,23 @@ failedTransferDir u direction r = gitAnnexTransferDir r
</> "failed"
</> showLcDirection direction
</> filter (/= '/') (fromUUID u)
instance Arbitrary TransferInfo where
arbitrary = TransferInfo
<$> arbitrary
<*> arbitrary
<*> pure Nothing -- cannot generate a ThreadID
<*> pure Nothing -- remote not needed
<*> arbitrary
-- associated file cannot be empty (but can be Nothing)
<*> arbitrary `suchThat` (/= Just "")
<*> arbitrary
prop_read_write_transferinfo :: TransferInfo -> Bool
prop_read_write_transferinfo info
| transferRemote info /= Nothing = True -- remote not stored
| transferTid info /= Nothing = True -- tid not stored
| otherwise = Just (info { transferPaused = False }) == info'
where
info' = readTransferInfo (transferPid info) (writeTransferInfo info)

34
Test.hs
View file

@ -5,13 +5,10 @@
- Licensed under the GNU GPL version 3 or higher.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test where
import Test.HUnit
import Test.HUnit.Tools
import Test.QuickCheck
import Test.QuickCheck.Instances ()
import System.Posix.Directory (changeWorkingDirectory)
@ -58,37 +55,6 @@ import qualified Utility.Process
import qualified Utility.Misc
import qualified Utility.InodeCache
-- instances for quickcheck
instance Arbitrary Types.Key.Key where
arbitrary = Types.Key.Key
<$> arbitrary
<*> (listOf1 $ elements ['A'..'Z']) -- BACKEND
<*> ((abs <$>) <$> arbitrary) -- size cannot be negative
<*> arbitrary
instance Arbitrary Logs.Transfer.TransferInfo where
arbitrary = Logs.Transfer.TransferInfo
<$> arbitrary
<*> arbitrary
<*> pure Nothing -- cannot generate a ThreadID
<*> pure Nothing -- remote not needed
<*> arbitrary
-- associated file cannot be empty (but can be Nothing)
<*> arbitrary `suchThat` (/= Just "")
<*> arbitrary
instance Arbitrary Utility.InodeCache.InodeCache where
arbitrary = Utility.InodeCache.InodeCache
<$> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary Logs.Presence.LogLine where
arbitrary = Logs.Presence.LogLine
<$> arbitrary
<*> elements [minBound..maxBound]
<*> arbitrary `suchThat` ('\n' `notElem`)
main :: IO ()
main = do
prepare

View file

@ -17,6 +17,8 @@ module Types.Key (
) where
import System.Posix.Types
import Test.QuickCheck
import Utility.QuickCheck ()
import Common
@ -74,5 +76,12 @@ file2key s = if key == Just stubKey then Nothing else key
addfield 'm' k v = Just k { keyMtime = readish v }
addfield _ _ _ = Nothing
instance Arbitrary Key where
arbitrary = Key
<$> arbitrary
<*> (listOf1 $ elements ['A'..'Z']) -- BACKEND
<*> ((abs <$>) <$> arbitrary) -- size cannot be negative
<*> arbitrary
prop_idempotent_key_encode :: Key -> Bool
prop_idempotent_key_encode k = Just k == (file2key . key2file) k

View file

@ -9,6 +9,8 @@ module Utility.InodeCache where
import Common
import System.Posix.Types
import Test.QuickCheck
import Utility.QuickCheck ()
data InodeCache = InodeCache FileID FileOffset EpochTime
deriving (Eq, Show)
@ -35,10 +37,6 @@ readInodeCache s = case words s of
<*> readish mtime
_ -> Nothing
-- for quickcheck
prop_read_show_inodecache :: InodeCache -> Bool
prop_read_show_inodecache c = readInodeCache (showInodeCache c) == Just c
genInodeCache :: FilePath -> IO (Maybe InodeCache)
genInodeCache f = catchDefaultIO Nothing $ toInodeCache <$> getFileStatus f
@ -49,3 +47,12 @@ toInodeCache s
(fileSize s)
(modificationTime s)
| otherwise = Nothing
instance Arbitrary InodeCache where
arbitrary = InodeCache
<$> arbitrary
<*> arbitrary
<*> arbitrary
prop_read_show_inodecache :: InodeCache -> Bool
prop_read_show_inodecache c = readInodeCache (showInodeCache c) == Just c