From e8553a5d90ed7ead50318dfc362f65414580701c Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 11 Sep 2009 09:31:03 +0000 Subject: [PATCH] Work around bug in old bytestring versions by reading the package DB strictly --- utils/ghc-pkg/Main.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 411dc56..114ce24 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -48,6 +48,10 @@ import System.IO.Error (try) import Data.List import Control.Concurrent +import qualified Data.ByteString.Lazy as B +import qualified Data.Binary as Bin +import qualified Data.Binary.Get as Bin + import Foreign import Foreign.C #ifdef mingw32_HOST_OS @@ -551,7 +555,7 @@ readParseDatabase verbosity mb_user_conf use_cache path | tcache >= tdir -> do when (verbosity > Normal) $ putStrLn ("using cache: " ++ cache) - pkgs <- readBinPackageDB cache + pkgs <- myReadBinPackageDB cache let pkgs' = map convertPackageInfoIn pkgs return PackageDB { location = path, packages = pkgs' } | otherwise -> do @@ -566,6 +570,17 @@ readParseDatabase verbosity mb_user_conf use_cache path map (path ) confs return PackageDB { location = path, packages = pkgs } +-- read the package.cache file strictly, to work around a problem with +-- bytestring 0.9.0.x (fixed in 0.9.1.x) where the file wasn't closed +-- after it has been completely read, leading to a sharing violation +-- later. +myReadBinPackageDB :: FilePath -> IO [InstalledPackageInfoString] +myReadBinPackageDB filepath = do + h <- openBinaryFile filepath ReadMode + sz <- hFileSize h + b <- B.hGet h (fromIntegral sz) + hClose h + return $ Bin.runGet Bin.get b parseMultiPackageConf :: Verbosity -> FilePath -> IO [InstalledPackageInfo] parseMultiPackageConf verbosity file = do -- 1.7.10.4