diff --git a/test/Codec/Archive/Tar/Index/IntTrie/Tests.hs b/test/Codec/Archive/Tar/Index/IntTrie/Tests.hs index 56f049e..e7e2cbb 100644 --- a/test/Codec/Archive/Tar/Index/IntTrie/Tests.hs +++ b/test/Codec/Archive/Tar/Index/IntTrie/Tests.hs @@ -125,7 +125,7 @@ example2''' = mktrie [ mknode 0 t3 ] -- We convert from the 'Paths' to the 'IntTrieBuilder' using 'inserts': -- -test1 = example2 == inserts example1 empty +test1 = example2 === inserts example1 empty -- So the overall array form of the above trie is: -- @@ -145,7 +145,7 @@ example3 = -- We get the array form by using flattenTrie: -test2 = example3 == flattenTrie example2 +test2 = example3 === flattenTrie example2 example4 :: IntTrie Int Int example4 = IntTrie (mkArray example3) @@ -157,25 +157,24 @@ test3 = case lookup example4 [1] of Just (Completions [(2,_),(3,_),(4,_)]) -> True _ -> False -test1, test2, test3 :: Bool +test1 :: Property prop_lookup :: (Ord k, Enum k, Eq v, Enum v, Show k, Show v) - => [([k], v)] -> Bool + => [([k], v)] -> Property prop_lookup paths = - flip all paths $ \(key, value) -> + conjoin $ flip map paths $ \(key, value) -> case lookup trie key of - Just (Entry value') | value' == value -> True - Just (Entry value') -> error $ "IntTrie: " ++ show (key, value, value') + Just (Entry value') -> value' === value Nothing -> error $ "IntTrie: didn't find " ++ show key Just (Completions xs) -> error $ "IntTrie: " ++ show xs where trie = construct paths -prop_completions :: forall k v. (Ord k, Enum k, Eq v, Enum v) => [([k], v)] -> Bool +prop_completions :: forall k v. (Ord k, Enum k, Eq v, Enum v) => [([k], v)] -> Property prop_completions paths = inserts paths empty - == convertCompletions (completionsFrom (construct paths) 0) + === convertCompletions (completionsFrom (construct paths) 0) where convertCompletions :: Ord k => Completions k v -> IntTrieBuilder k v convertCompletions kls = @@ -187,37 +186,37 @@ prop_completions paths = | (k, l) <- sortBy (compare `on` fst) kls ] -prop_lookup_mono :: ValidPaths -> Bool +prop_lookup_mono :: ValidPaths -> Property prop_lookup_mono (ValidPaths paths) = prop_lookup paths -prop_completions_mono :: ValidPaths -> Bool +prop_completions_mono :: ValidPaths -> Property prop_completions_mono (ValidPaths paths) = prop_completions paths -prop_construct_toList :: ValidPaths -> Bool +prop_construct_toList :: ValidPaths -> Property prop_construct_toList (ValidPaths paths) = sortBy (compare `on` fst) (toList (construct paths)) - == sortBy (compare `on` fst) paths + === sortBy (compare `on` fst) paths -prop_finalise_unfinalise :: ValidPaths -> Bool +prop_finalise_unfinalise :: ValidPaths -> Property prop_finalise_unfinalise (ValidPaths paths) = - builder == unfinalise (finalise builder) + builder === unfinalise (finalise builder) where builder :: IntTrieBuilder Char Char builder = inserts paths empty -prop_serialise_deserialise :: ValidPaths -> Bool +prop_serialise_deserialise :: ValidPaths -> Property prop_serialise_deserialise (ValidPaths paths) = - Just (trie, BS.empty) == (deserialise + Just (trie, BS.empty) === (deserialise . LBS.toStrict . BS.toLazyByteString . serialise) trie where trie :: IntTrie Char Char trie = construct paths -prop_serialiseSize :: ValidPaths -> Bool +prop_serialiseSize :: ValidPaths -> Property prop_serialiseSize (ValidPaths paths) = (fromIntegral . LBS.length . BS.toLazyByteString . serialise) trie - == serialiseSize trie + === serialiseSize trie where trie :: IntTrie Char Char trie = construct paths diff --git a/test/Codec/Archive/Tar/Index/StringTable/Tests.hs b/test/Codec/Archive/Tar/Index/StringTable/Tests.hs index 48ffc09..353b06b 100644 --- a/test/Codec/Archive/Tar/Index/StringTable/Tests.hs +++ b/test/Codec/Archive/Tar/Index/StringTable/Tests.hs @@ -10,6 +10,7 @@ module Codec.Archive.Tar.Index.StringTable.Tests ( import Prelude hiding (lookup) import Codec.Archive.Tar.Index.StringTable +import Test.Tasty.QuickCheck import Data.List hiding (lookup, insert) import qualified Data.Array.Unboxed as A @@ -23,24 +24,26 @@ import Data.ByteString.Lazy.Builder as BS import Data.ByteString.Lazy.Builder.Extras as BS (byteStringCopy) #endif -prop_valid :: [BS.ByteString] -> Bool +prop_valid :: [BS.ByteString] -> Property prop_valid strs = - all lookupIndex (enumStrings tbl) - && all indexLookup (enumIds tbl) + conjoin (map lookupIndex (enumStrings tbl)) + .&&. conjoin (map indexLookup (enumIds tbl)) where tbl :: StringTable Int tbl = construct strs - lookupIndex str = index tbl ident == str + lookupIndex :: BS.ByteString -> Property + lookupIndex str = index tbl ident === str where Just ident = lookup tbl str - indexLookup ident = lookup tbl str == Just ident + indexLookup :: Int -> Property + indexLookup ident = lookup tbl str === Just ident where str = index tbl ident -- this is important so we can use Map.fromAscList -prop_sorted :: [BS.ByteString] -> Bool -prop_sorted strings = +prop_sorted :: [BS.ByteString] -> Property +prop_sorted strings = property $ isSorted [ index' strs offsets ix | ix <- A.range (A.bounds ids) ] where @@ -48,26 +51,26 @@ prop_sorted strings = _tbl@(StringTable strs offsets ids _ixs) = construct strings isSorted xs = and (zipWith (<) xs (tail xs)) -prop_finalise_unfinalise :: [BS.ByteString] -> Bool +prop_finalise_unfinalise :: [BS.ByteString] -> Property prop_finalise_unfinalise strs = - builder == unfinalise (finalise builder) + builder === unfinalise (finalise builder) where builder :: StringTableBuilder Int builder = foldl' (\tbl s -> fst (insert s tbl)) empty strs -prop_serialise_deserialise :: [BS.ByteString] -> Bool +prop_serialise_deserialise :: [BS.ByteString] -> Property prop_serialise_deserialise strs = - Just (strtable, BS.empty) == (deserialiseV2 + Just (strtable, BS.empty) === (deserialiseV2 . LBS.toStrict . BS.toLazyByteString . serialise) strtable where strtable :: StringTable Int strtable = construct strs -prop_serialiseSize :: [BS.ByteString] -> Bool +prop_serialiseSize :: [BS.ByteString] -> Property prop_serialiseSize strs = (fromIntegral . LBS.length . BS.toLazyByteString . serialise) strtable - == serialiseSize strtable + === serialiseSize strtable where strtable :: StringTable Int strtable = construct strs diff --git a/test/Codec/Archive/Tar/Index/Tests.hs b/test/Codec/Archive/Tar/Index/Tests.hs index e862e80..a940a24 100644 --- a/test/Codec/Archive/Tar/Index/Tests.hs +++ b/test/Codec/Archive/Tar/Index/Tests.hs @@ -58,34 +58,33 @@ import qualified Data.ByteString.Handle as HBS -- Not quite the properties of a finite mapping because we also have lookups -- that result in completions. -prop_lookup :: ValidPaths -> NonEmptyFilePath -> Bool +prop_lookup :: ValidPaths -> NonEmptyFilePath -> Property prop_lookup (ValidPaths paths) (NonEmptyFilePath p) = case (lookup index p, Prelude.lookup p paths) of - (Nothing, Nothing) -> True - (Just (TarFileEntry offset), Just (_,offset')) -> offset == offset' + (Nothing, Nothing) -> property True + (Just (TarFileEntry offset), Just (_,offset')) -> offset === offset' (Just (TarDir entries), Nothing) -> sort (nub (map fst entries)) - == sort (nub completions) - _ -> False + === sort (nub completions) + _ -> property False where index = construct paths completions = [ head (FilePath.splitDirectories completion) | (path,_) <- paths , completion <- maybeToList $ stripPrefix (p ++ "/") path ] -prop_toList :: ValidPaths -> Bool +prop_toList :: ValidPaths -> Property prop_toList (ValidPaths paths) = sort (toList index) - == sort [ (path, off) | (path, (_sz, off)) <- paths ] + === sort [ (path, off) | (path, (_sz, off)) <- paths ] where index = construct paths -prop_valid :: ValidPaths -> Bool -prop_valid (ValidPaths paths) - | not $ StringTable.prop_valid pathbits = error "TarIndex: bad string table" - | not $ IntTrie.prop_lookup intpaths = error "TarIndex: bad int trie" - | not $ IntTrie.prop_completions intpaths = error "TarIndex: bad int trie" - | not $ prop' = error "TarIndex: bad prop" - | otherwise = True +prop_valid :: ValidPaths -> Property +prop_valid (ValidPaths paths) = + StringTable.prop_valid pathbits .&&. + IntTrie.prop_lookup intpaths .&&. + IntTrie.prop_completions intpaths .&&. + prop' where index@(TarIndex pathTable _ _) = construct paths @@ -95,22 +94,22 @@ prop_valid (ValidPaths paths) intpaths = [ (cids, offset) | (path, (_size, offset)) <- paths , let Just cids = toComponentIds pathTable path ] - prop' = flip all paths $ \(file, (_size, offset)) -> + prop' = conjoin $ flip map paths $ \(file, (_size, offset)) -> case lookup index file of - Just (TarFileEntry offset') -> offset' == offset - _ -> False + Just (TarFileEntry offset') -> offset' === offset + _ -> property False -prop_serialise_deserialise :: ValidPaths -> Bool +prop_serialise_deserialise :: ValidPaths -> Property prop_serialise_deserialise (ValidPaths paths) = - Just (index, BS.empty) == (deserialise . serialise) index + Just (index, BS.empty) === (deserialise . serialise) index where index = construct paths -prop_serialiseSize :: ValidPaths -> Bool +prop_serialiseSize :: ValidPaths -> Property prop_serialiseSize (ValidPaths paths) = case (LBS.toChunks . serialiseLBS) index of - [c1] -> BS.length c1 == serialiseSize index - _ -> False + [c1] -> BS.length c1 === serialiseSize index + _ -> property False where index = construct paths @@ -145,7 +144,7 @@ instance Arbitrary ValidPaths where -- Helper for bulk construction. construct :: [(FilePath, (Int64, TarEntryOffset))] -> TarIndex construct = - either (\_ -> undefined) id + either (const undefined) id . build . foldr (\(path, (size, _off)) es -> Next (testEntry path size) es) Done @@ -261,9 +260,9 @@ instance Arbitrary SimpleIndexBuilder where go !builder Done = builder go !_ (Fail err) = error (show err) -prop_finalise_unfinalise :: SimpleIndexBuilder -> Bool +prop_finalise_unfinalise :: SimpleIndexBuilder -> Property prop_finalise_unfinalise (SimpleIndexBuilder index) = - unfinalise (finalise index) == index + unfinalise (finalise index) === index #if !(MIN_VERSION_base(4,5,0)) (<>) :: Monoid m => m -> m -> m diff --git a/test/Codec/Archive/Tar/Tests.hs b/test/Codec/Archive/Tar/Tests.hs index a8f7c9a..971f8de 100644 --- a/test/Codec/Archive/Tar/Tests.hs +++ b/test/Codec/Archive/Tar/Tests.hs @@ -21,22 +21,23 @@ import Codec.Archive.Tar import Codec.Archive.Tar.Types import Codec.Archive.Tar.Types.Tests import Prelude hiding (read) +import Test.Tasty.QuickCheck -prop_write_read_ustar :: [Entry] -> Bool +prop_write_read_ustar :: [Entry] -> Property prop_write_read_ustar entries = - foldr Next Done entries' == read (write entries') + foldr Next Done entries' === read (write entries') where entries' = [ e { entryFormat = UstarFormat } | e <- entries ] -prop_write_read_gnu :: [Entry] -> Bool +prop_write_read_gnu :: [Entry] -> Property prop_write_read_gnu entries = - foldr Next Done entries' == read (write entries') + foldr Next Done entries' === read (write entries') where entries' = [ e { entryFormat = GnuFormat } | e <- entries ] -prop_write_read_v7 :: [Entry] -> Bool +prop_write_read_v7 :: [Entry] -> Property prop_write_read_v7 entries = - foldr Next Done entries' == read (write entries') + foldr Next Done entries' === read (write entries') where entries' = [ limitToV7FormatCompat e { entryFormat = V7Format } | e <- entries ]