From b00d2150b3f2d216aa7458606c9c018f9beb75a2 Mon Sep 17 00:00:00 2001 From: Alexis Williams 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 ++++ .../PackageTests/NewSdist/ManyDataFiles/cabal.project | 1 + .../NewSdist/ManyDataFiles/many-data-files.cabal | 9 +++++++++ .../NewSdist/ManyDataFiles/many-data-files.out | 2 ++ .../NewSdist/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 545cacfcb..335c6937b 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 000000000..ed19e6004 --- /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 000000000..f95e96bf5 --- /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 000000000..4bc31217b --- /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 000000000..b4285f11b --- /dev/null +++ b/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out @@ -0,0 +1,2 @@ +# cabal new-sdist +Wrote tarball sdist to /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 000000000..7414918c5 --- /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 5f955d927..c9a5deb4d 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 -- 2.11.4.GIT