diff options
| -rw-r--r-- | Logs/Presence.hs | 16 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 31 | ||||
| -rw-r--r-- | Test.hs | 34 | ||||
| -rw-r--r-- | Types/Key.hs | 9 | ||||
| -rw-r--r-- | Utility/InodeCache.hs | 15 |
5 files changed, 54 insertions, 51 deletions
diff --git a/Logs/Presence.hs b/Logs/Presence.hs index 49573df69..83cbe0684 100644 --- a/Logs/Presence.hs +++ b/Logs/Presence.hs @@ -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 + diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index e92dce2c0..018e1d4ff 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -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) + @@ -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 diff --git a/Types/Key.hs b/Types/Key.hs index ecdf7b842..e955725c7 100644 --- a/Types/Key.hs +++ b/Types/Key.hs @@ -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 diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs index 321125bf4..fdcbf3ef2 100644 --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -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 |