quickcheck test for transfer info read/write code

Fixed a bug the quickcheck turned up.
This commit is contained in:
Joey Hess 2012-12-19 16:15:39 -04:00
parent 987db10116
commit bf71d42681
2 changed files with 37 additions and 3 deletions

View file

@ -294,7 +294,9 @@ readTransferInfo mpid s = TransferInfo
<*> pure False
where
(firstline, rest) = separate (== '\n') s
(filename, _) = separate (== '\n') rest
filename
| end rest == "\n" = beginning rest
| otherwise = rest
bits = split " " firstline
numbits = length bits
time = if numbits > 0
@ -304,6 +306,16 @@ 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
| associatedFile info == Just "" = True -- file cannot be empty
| 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

26
test.hs
View file

@ -1,11 +1,12 @@
{- git-annex test suite
-
- Copyright 2010,2011 Joey Hess <joey@kitenet.net>
- Copyright 2010-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TypeSynonymInstances #-}
import Test.HUnit
import Test.HUnit.Tools
@ -36,6 +37,7 @@ import qualified Logs.UUIDBased
import qualified Logs.Trust
import qualified Logs.Remote
import qualified Logs.Unused
import qualified Logs.Transfer
import qualified Remote
import qualified Types.Key
import qualified Types.Messages
@ -50,7 +52,10 @@ import qualified Utility.Verifiable
import qualified Utility.Process
import qualified Utility.Misc
-- for quickcheck
import Data.Time.Clock.POSIX
import System.Posix.Types
-- instances for quickcheck
instance Arbitrary Types.Key.Key where
arbitrary = do
n <- arbitrary
@ -62,6 +67,22 @@ instance Arbitrary Types.Key.Key where
Types.Key.keyMtime = Nothing
}
instance Arbitrary Logs.Transfer.TransferInfo where
arbitrary = Logs.Transfer.TransferInfo
<$> arbitrary
<*> arbitrary
<*> pure Nothing -- cannot generate a ThreadID
<*> pure Nothing -- remote not needed
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary POSIXTime where
arbitrary = arbitrarySizedIntegral
instance Arbitrary ProcessID where
arbitrary = arbitraryBoundedIntegral
main :: IO ()
main = do
prepare
@ -93,6 +114,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
, qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
, qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
, qctest "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
, qctest "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo
]
blackbox :: Test