diff --git a/tar.cabal b/tar.cabal index 5ffc458..abfc6af 100644 --- a/tar.cabal +++ b/tar.cabal @@ -92,6 +92,7 @@ test-suite properties tar-internal, tasty >= 0.10 && <1.6, tasty-quickcheck >= 0.8 && <0.11, + temporary < 1.4, time if impl(ghc < 9.0) build-depends: bytestring-handle < 0.2 @@ -105,6 +106,7 @@ test-suite properties Codec.Archive.Tar.Index.Tests Codec.Archive.Tar.Index.IntTrie.Tests Codec.Archive.Tar.Index.StringTable.Tests + Codec.Archive.Tar.Pack.Tests Codec.Archive.Tar.Types.Tests other-extensions: diff --git a/test/Codec/Archive/Tar/Pack/Tests.hs b/test/Codec/Archive/Tar/Pack/Tests.hs new file mode 100644 index 0000000..8c7d875 --- /dev/null +++ b/test/Codec/Archive/Tar/Pack/Tests.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE BangPatterns #-} + +module Codec.Archive.Tar.Pack.Tests + ( prop_roundtrip + ) where + +import qualified Codec.Archive.Tar.Pack as Pack +import Codec.Archive.Tar.Types (Entries(..)) +import qualified Codec.Archive.Tar.Unpack as Unpack +import Control.Exception +import System.Directory +import System.FilePath +import System.IO.Temp +import Test.Tasty.QuickCheck + +-- | Write a single file, deeply buried within nested folders; +-- pack and unpack; read back and compare results. +prop_roundtrip :: [ASCIIString] -> String -> Property +prop_roundtrip xss cnt + | file : dirs <- filter (not . null) $ map mkFilePath xss + -- Filenames longer than 1024 characters throw + -- "withFile: invalid argument (File name too long)", + -- at least on Mac OS + , length (joinPath dirs file) < 900 + = ioProperty $ withSystemTempDirectory "tar-test" $ \baseDir -> do + let relDir = joinPath dirs + absDir = baseDir relDir + relFile = relDir file + absFile = absDir file + createDirectoryIfMissing True absDir + writeFile absFile cnt + -- Forcing the result, otherwise lazy IO misbehaves. + !entries <- Pack.pack baseDir [relFile] + + -- Try hard to clean up + removeFile absFile + writeFile absFile "" + case dirs of + [] -> pure () + d : _ -> removeDirectoryRecursive (baseDir d) + + -- Unpack back + Unpack.unpack baseDir (foldr Next Done entries :: Entries IOException) + cnt' <- readFile absFile + pure $ cnt === cnt' + + | otherwise = discard + +mkFilePath :: ASCIIString -> FilePath +mkFilePath (ASCIIString xs) = makeValid $ filter (not . isPathSeparator) xs diff --git a/test/Properties.hs b/test/Properties.hs index 04c0a85..b5869ff 100644 --- a/test/Properties.hs +++ b/test/Properties.hs @@ -5,6 +5,7 @@ module Main where import qualified Codec.Archive.Tar.Index.Tests as Index import qualified Codec.Archive.Tar.Index.IntTrie.Tests as IntTrie import qualified Codec.Archive.Tar.Index.StringTable.Tests as StringTable +import qualified Codec.Archive.Tar.Pack.Tests as Pack import qualified Codec.Archive.Tar.Tests as Tar import Test.Tasty @@ -52,5 +53,9 @@ main = #endif testProperty "unfinalise" Index.prop_finalise_unfinalise ] + + , testGroup "pack" [ + testProperty "roundtrip" Pack.prop_roundtrip + ] ]