From 31a54a0eaeafe024084b46740597a4c872ab2fa7 Mon Sep 17 00:00:00 2001
From: Alexis Williams <alexis@typedr.at>
Date: Sat, 1 Sep 2018 14:55:51 -0700
Subject: [PATCH] Fix `new-sdist` file handle leak
Lazy I/O strikes again.
---
cabal-install/Distribution/Client/CmdSdist.hs | 3 ++-
.../PackageTests/NewSdist/ManyDataFiles/many-data-files.out | 2 ++
.../NewSdist/ManyDataFiles/many-data-files.test.hs | 2 +-
3 files changed, 5 insertions(+), 2 deletions(-)
create mode 100644 cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out
diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs
index 545cacfcb7..335c6937b9 100644
--- a/cabal-install/Distribution/Client/CmdSdist.hs
+++ b/cabal-install/Distribution/Client/CmdSdist.hs
@@ -72,6 +72,7 @@ import Control.Monad.Writer.Lazy
( WriterT, tell, execWriterT )
import Data.Bits
( shiftL )
+import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Either
( partitionEithers )
@@ -259,7 +260,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do
Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)
Right path -> tell [Tar.directoryEntry path]
- contents <- liftIO $ BSL.readFile file
+ contents <- liftIO . fmap BSL.fromStrict . BS.readFile $ file
case Tar.toTarPath False (prefix </> file) of
Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)
Right path -> tell [(Tar.fileEntry path contents) { Tar.entryPermissions = perm' }]
diff --git a/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out
new file mode 100644
index 0000000000..b4285f11bf
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out
@@ -0,0 +1,2 @@
+# cabal new-sdist
+Wrote tarball sdist to <ROOT>/many-data-files.dist/source/dist-newstyle/sdist/many-data-files-0.tar.gz
diff --git a/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs
index 497507c159..915f0c218c 100644
--- a/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs
+++ b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs
@@ -11,5 +11,5 @@ main = cabalTest . withSourceCopy $ do
liftIO $ createDirectoryIfMissing False (cwd </> "data")
forM_ [1 .. n + 100] $ \i ->
liftIO $ BS.writeFile (cwd </> "data" </> ("data-file-" ++ show i) <.> "txt") (BS.pack "a data file\n")
- expectBroken 5541 $ cabal "new-sdist" ["many-data-files"]
+ cabal "new-sdist" ["many-data-files"]
Nothing -> skip
--
GitLab