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:
parent
e7b78c2eec
commit
a2f17146fa
5 changed files with 54 additions and 51 deletions
|
@ -29,6 +29,8 @@ import Data.Time.Clock.POSIX
|
||||||
import Data.Time
|
import Data.Time
|
||||||
import System.Locale
|
import System.Locale
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import Test.QuickCheck
|
||||||
|
import Utility.QuickCheck ()
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
|
@ -74,10 +76,6 @@ showLog = unlines . map genline
|
||||||
genstatus InfoPresent = "1"
|
genstatus InfoPresent = "1"
|
||||||
genstatus InfoMissing = "0"
|
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. -}
|
{- Generates a new LogLine with the current date. -}
|
||||||
logNow :: LogStatus -> String -> Annex LogLine
|
logNow :: LogStatus -> String -> Annex LogLine
|
||||||
logNow s i = do
|
logNow s i = do
|
||||||
|
@ -113,3 +111,13 @@ mapLog l m
|
||||||
better = maybe True newer $ M.lookup i m
|
better = maybe True newer $ M.lookup i m
|
||||||
newer l' = date l' <= date l
|
newer l' = date l' <= date l
|
||||||
i = info 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
|
||||||
|
|
||||||
|
|
|
@ -21,6 +21,8 @@ import Data.Time.Clock.POSIX
|
||||||
import Data.Time
|
import Data.Time
|
||||||
import System.Locale
|
import System.Locale
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
import Test.QuickCheck
|
||||||
|
import Utility.QuickCheck ()
|
||||||
|
|
||||||
{- Enough information to uniquely identify a transfer, used as the filename
|
{- Enough information to uniquely identify a transfer, used as the filename
|
||||||
- of the transfer information file. -}
|
- of the transfer information file. -}
|
||||||
|
@ -306,15 +308,6 @@ 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
|
|
||||||
| 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
|
||||||
|
@ -330,3 +323,23 @@ failedTransferDir u direction r = gitAnnexTransferDir r
|
||||||
</> "failed"
|
</> "failed"
|
||||||
</> showLcDirection direction
|
</> showLcDirection direction
|
||||||
</> filter (/= '/') (fromUUID u)
|
</> 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
34
Test.hs
|
@ -5,13 +5,10 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
||||||
|
|
||||||
module Test where
|
module Test where
|
||||||
|
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Test.HUnit.Tools
|
import Test.HUnit.Tools
|
||||||
import Test.QuickCheck
|
|
||||||
import Test.QuickCheck.Instances ()
|
import Test.QuickCheck.Instances ()
|
||||||
|
|
||||||
import System.Posix.Directory (changeWorkingDirectory)
|
import System.Posix.Directory (changeWorkingDirectory)
|
||||||
|
@ -58,37 +55,6 @@ import qualified Utility.Process
|
||||||
import qualified Utility.Misc
|
import qualified Utility.Misc
|
||||||
import qualified Utility.InodeCache
|
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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
prepare
|
prepare
|
||||||
|
|
|
@ -17,6 +17,8 @@ module Types.Key (
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
|
import Test.QuickCheck
|
||||||
|
import Utility.QuickCheck ()
|
||||||
|
|
||||||
import Common
|
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 'm' k v = Just k { keyMtime = readish v }
|
||||||
addfield _ _ _ = Nothing
|
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 :: Key -> Bool
|
||||||
prop_idempotent_key_encode k = Just k == (file2key . key2file) k
|
prop_idempotent_key_encode k = Just k == (file2key . key2file) k
|
||||||
|
|
|
@ -9,6 +9,8 @@ module Utility.InodeCache where
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
|
import Test.QuickCheck
|
||||||
|
import Utility.QuickCheck ()
|
||||||
|
|
||||||
data InodeCache = InodeCache FileID FileOffset EpochTime
|
data InodeCache = InodeCache FileID FileOffset EpochTime
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
@ -35,10 +37,6 @@ readInodeCache s = case words s of
|
||||||
<*> readish mtime
|
<*> readish mtime
|
||||||
_ -> Nothing
|
_ -> 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 :: FilePath -> IO (Maybe InodeCache)
|
||||||
genInodeCache f = catchDefaultIO Nothing $ toInodeCache <$> getFileStatus f
|
genInodeCache f = catchDefaultIO Nothing $ toInodeCache <$> getFileStatus f
|
||||||
|
|
||||||
|
@ -49,3 +47,12 @@ toInodeCache s
|
||||||
(fileSize s)
|
(fileSize s)
|
||||||
(modificationTime s)
|
(modificationTime s)
|
||||||
| otherwise = Nothing
|
| 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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue