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 <*> pure False
where where
(firstline, rest) = separate (== '\n') s (firstline, rest) = separate (== '\n') s
(filename, _) = separate (== '\n') rest filename
| end rest == "\n" = beginning rest
| otherwise = rest
bits = split " " firstline bits = split " " firstline
numbits = length bits numbits = length bits
time = if numbits > 0 time = if numbits > 0
@ -304,6 +306,16 @@ readTransferInfo mpid s = TransferInfo
then Just <$> readish =<< headMaybe (drop 1 bits) then Just <$> readish =<< headMaybe (drop 1 bits)
else pure Nothing -- not failure 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 :: String -> Maybe POSIXTime
parsePOSIXTime s = utcTimeToPOSIXSeconds parsePOSIXTime s = utcTimeToPOSIXSeconds
<$> parseTime defaultTimeLocale "%s%Qs" s <$> parseTime defaultTimeLocale "%s%Qs" s

26
test.hs
View file

@ -1,11 +1,12 @@
{- git-annex test suite {- 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. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# 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
@ -36,6 +37,7 @@ import qualified Logs.UUIDBased
import qualified Logs.Trust import qualified Logs.Trust
import qualified Logs.Remote import qualified Logs.Remote
import qualified Logs.Unused import qualified Logs.Unused
import qualified Logs.Transfer
import qualified Remote import qualified Remote
import qualified Types.Key import qualified Types.Key
import qualified Types.Messages import qualified Types.Messages
@ -50,7 +52,10 @@ import qualified Utility.Verifiable
import qualified Utility.Process import qualified Utility.Process
import qualified Utility.Misc import qualified Utility.Misc
-- for quickcheck import Data.Time.Clock.POSIX
import System.Posix.Types
-- instances for quickcheck
instance Arbitrary Types.Key.Key where instance Arbitrary Types.Key.Key where
arbitrary = do arbitrary = do
n <- arbitrary n <- arbitrary
@ -62,6 +67,22 @@ instance Arbitrary Types.Key.Key where
Types.Key.keyMtime = Nothing 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 :: IO ()
main = do main = do
prepare prepare
@ -93,6 +114,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
, qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane , qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
, qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane , qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
, qctest "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest , qctest "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
, qctest "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo
] ]
blackbox :: Test blackbox :: Test