From b00d2150b3f2d216aa7458606c9c018f9beb75a2 Mon Sep 17 00:00:00 2001
From: Alexis Williams <alexis@typedr.at>
Date: Sat, 1 Sep 2018 15:54:26 -0700
Subject: [PATCH] Merge pull request #5558 from typedrat/fix-sdist-fd-leak
Fix #5541.
---
cabal-install/Distribution/Client/CmdSdist.hs | 3 ++-
.../PackageTests/NewSdist/ManyDataFiles/Main.hs | 4 ++++
.../NewSdist/ManyDataFiles/cabal.project | 1 +
.../ManyDataFiles/many-data-files.cabal | 9 +++++++++
.../NewSdist/ManyDataFiles/many-data-files.out | 2 ++
.../ManyDataFiles/many-data-files.test.hs | 17 +++++++++++++++++
cabal-testsuite/Test/Cabal/Prelude.hs | 15 +++++++++++++++
7 files changed, 50 insertions(+), 1 deletion(-)
create mode 100644 cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/Main.hs
create mode 100644 cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/cabal.project
create mode 100644 cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.cabal
create mode 100644 cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out
create mode 100644 cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs
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/Main.hs b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/Main.hs
new file mode 100644
index 0000000000..ed19e6004c
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/Main.hs
@@ -0,0 +1,4 @@
+module Main (main) where
+
+main :: IO ()
+main = putStrLn "Hello, World!"
diff --git a/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/cabal.project b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/cabal.project
new file mode 100644
index 0000000000..f95e96bf5b
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.cabal b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.cabal
new file mode 100644
index 0000000000..4bc31217b9
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.cabal
@@ -0,0 +1,9 @@
+cabal-version: 2.2
+name: many-data-files
+version: 0
+
+data-files: data/*.txt
+
+executable dummy
+ default-language: Haskell2010
+ main-is: Main.hs
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
new file mode 100644
index 0000000000..7414918c5e
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs
@@ -0,0 +1,17 @@
+import Test.Cabal.Prelude
+
+import Control.Applicative ((<$>))
+import System.Directory ( createDirectoryIfMissing )
+import qualified Data.ByteString.Char8 as BS
+
+main = cabalTest . withSourceCopy $ do
+ limit <- getOpenFilesLimit
+ cwd <- testCurrentDir <$> getTestEnv
+
+ case limit of
+ Just n -> 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")
+ cabal "new-sdist" ["many-data-files"]
+ Nothing -> skip
diff --git a/cabal-testsuite/Test/Cabal/Prelude.hs b/cabal-testsuite/Test/Cabal/Prelude.hs
index 5f955d9279..c9a5deb4d6 100644
--- a/cabal-testsuite/Test/Cabal/Prelude.hs
+++ b/cabal-testsuite/Test/Cabal/Prelude.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
@@ -61,6 +62,7 @@ import System.Directory
#ifndef mingw32_HOST_OS
import Control.Monad.Catch ( bracket_ )
import System.Posix.Files ( createSymbolicLink )
+import System.Posix.Resource
#endif
------------------------------------------------------------------------
@@ -804,6 +806,19 @@ isOSX = return (buildOS == OSX)
isLinux :: TestM Bool
isLinux = return (buildOS == Linux)
+getOpenFilesLimit :: TestM (Maybe Integer)
+#ifdef mingw32_HOST_OS
+-- No MS-specified limit, was determined experimentally on Windows 10 Pro x64,
+-- matches other online reports from other versions of Windows.
+getOpenFilesLimit = return (Just 2048)
+#else
+getOpenFilesLimit = liftIO $ do
+ ResourceLimits { softLimit } <- getResourceLimit ResourceOpenFiles
+ case softLimit of
+ ResourceLimit n -> return (Just n)
+ _ -> return Nothing
+#endif
+
hasCabalForGhc :: TestM Bool
hasCabalForGhc = do
env <- getTestEnv
--
GitLab