Write a property test for large file sizes

Author: Bodigrim

test/Codec/Archive/Tar/Pack/Tests.hs

@@ -16,8 +16,9 @@ import qualified Data.ByteString.Lazy as BL
 import Data.FileEmbed
 import qualified Codec.Archive.Tar as Tar
 import qualified Codec.Archive.Tar.Pack as Pack
-import Codec.Archive.Tar.Types (GenEntries(..), Entries)
+import Codec.Archive.Tar.Types (GenEntries(..), Entries, simpleEntry, toTarPath)
 import qualified Codec.Archive.Tar.Unpack as Unpack
+import qualified Codec.Archive.Tar.Write as Write
 import Control.Exception
 import Data.List.NonEmpty (NonEmpty(..))
 import System.Directory

test/Codec/Archive/Tar/Tests.hs

@@ -15,11 +15,13 @@ module Codec.Archive.Tar.Tests (
   prop_write_read_ustar,
   prop_write_read_gnu,
   prop_write_read_v7,
+  prop_large_filesize,
   ) where
 
 import Codec.Archive.Tar
 import Codec.Archive.Tar.Types
 import Codec.Archive.Tar.Types.Tests
+import qualified Data.ByteString.Lazy as BL
 import Prelude hiding (read)
 import Test.Tasty.QuickCheck
 
@@ -40,3 +42,14 @@ prop_write_read_v7 entries =
     foldr Next Done entries' === read (write entries')
   where
     entries' = map limitToV7FormatCompat $ filter ((== V7Format) . entryFormat) entries
+
+prop_large_filesize :: Word -> Property
+prop_large_filesize n = sz === sz'
+  where
+    sz = fromIntegral $ n * 1024 * 1024 * 128
+    Right fn = toTarPath False "Large.file"
+    entry = simpleEntry fn (NormalFile (BL.replicate sz 42) sz)
+    -- Trim the tail so it does not blow up RAM
+    tar = BL.take 2048 $ write [entry]
+    Next entry' _ = read tar
+    NormalFile _ sz' = entryContent entry'

test/Properties.hs

@@ -27,7 +27,8 @@ main =
     , testGroup "write/read" [
         testProperty "ustar format" Tar.prop_write_read_ustar,
         testProperty "gnu format"   Tar.prop_write_read_gnu,
-        testProperty "v7 format"    Tar.prop_write_read_v7
+        testProperty "v7 format"    Tar.prop_write_read_v7,
+        testProperty "large filesize" Tar.prop_large_filesize
       ]
 
     , testGroup "string table" [
@@ -73,4 +74,3 @@ main =
       testProperty "modtime 1970-01-01" Unpack.case_modtime_1970
       ]
     ]
-