quickcheck test for transfer info read/write code
Fixed a bug the quickcheck turned up.
This commit is contained in:
parent
987db10116
commit
bf71d42681
2 changed files with 37 additions and 3 deletions
|
@ -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
26
test.hs
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue