Cabal 1.10.1.0 → 1.10.2.0
raw patch · 9 files changed
+151/−39 lines, 9 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Cabal.cabal +1/−1
- Distribution/Compat/CopyFile.hs +4/−1
- Distribution/Compat/Exception.hs +1/−1
- Distribution/PackageDescription/Parse.hs +44/−8
- Distribution/Simple/InstallDirs.hs +15/−13
- Distribution/Simple/SrcDist.hs +21/−1
- Distribution/Simple/Test.hs +9/−4
- Distribution/Simple/Utils.hs +50/−10
- changelog +6/−0
Cabal.cabal view
@@ -1,5 +1,5 @@ Name: Cabal-Version: 1.10.1.0+Version: 1.10.2.0 Copyright: 2003-2006, Isaac Jones 2005-2011, Duncan Coutts License: BSD3
Distribution/Compat/CopyFile.hs view
@@ -11,6 +11,7 @@ copyExecutableFile, setFileOrdinary, setFileExecutable,+ setDirOrdinary, ) where #ifdef __GLASGOW_HASKELL__@@ -59,7 +60,7 @@ copyOrdinaryFile src dest = copyFile src dest >> setFileOrdinary dest copyExecutableFile src dest = copyFile src dest >> setFileExecutable dest -setFileOrdinary, setFileExecutable :: FilePath -> IO ()+setFileOrdinary, setFileExecutable, setDirOrdinary :: FilePath -> IO () #ifndef mingw32_HOST_OS setFileOrdinary path = setFileMode path 0o644 -- file perms -rw-r--r-- setFileExecutable path = setFileMode path 0o755 -- file perms -rwxr-xr-x@@ -76,6 +77,8 @@ setFileOrdinary _ = return () setFileExecutable _ = return () #endif+-- This happens to be true on Unix and currently on Windows too:+setDirOrdinary = setFileExecutable copyFile :: FilePath -> FilePath -> IO () #ifdef __GLASGOW_HASKELL__
Distribution/Compat/Exception.hs view
@@ -10,7 +10,7 @@ #endif module Distribution.Compat.Exception- (onException, catchIO, catchExit, throwIOIO)+ (Exception.IOException, onException, catchIO, catchExit, throwIOIO) where import System.Exit
Distribution/PackageDescription/Parse.hs view
@@ -250,11 +250,8 @@ validateTestSuite :: LineNo -> TestSuiteStanza -> ParseResult TestSuite validateTestSuite line stanza = case testStanzaTestType stanza of- Nothing ->- syntaxError line $- "The 'type' field is required for test suites. "- ++ "The available test types are: "- ++ intercalate ", " (map display knownTestTypes)+ Nothing -> return $+ emptyTestSuite { testBuildInfo = testStanzaBuildInfo stanza } Just tt@(TestTypeUnknown _ _) -> return emptyTestSuite {@@ -748,9 +745,48 @@ "'test-suite' needs one argument (the test suite's name)" testname <- lift $ runP line_no "test" parseTokenQ sec_label flds <- collectFields (parseTestFields line_no) sec_fields- skipField- (repos, flags, lib, exes, tests) <- getBody- return (repos, flags, lib, exes, tests ++ [(testname, flds)])++ -- Check that a valid test suite type has been chosen. A type+ -- field may be given inside a conditional block, so we must+ -- check for that before complaining that a type field has not+ -- been given. The test suite must always have a valid type, so+ -- we need to check both the 'then' and 'else' blocks, though+ -- the blocks need not have the same type.+ let checkTestType ts ct =+ let ts' = mappend ts $ condTreeData ct+ -- If a conditional has only a 'then' block and no+ -- 'else' block, then it cannot have a valid type+ -- in every branch, unless the type is specified at+ -- a higher level in the tree.+ checkComponent (_, _, Nothing) = False+ -- If a conditional has a 'then' block and an 'else'+ -- block, both must specify a test type, unless the+ -- type is specified higher in the tree.+ checkComponent (_, t, Just e) =+ checkTestType ts' t && checkTestType ts' e+ -- Does the current node specify a test type?+ hasTestType = testInterface ts'+ /= testInterface emptyTestSuite+ components = condTreeComponents ct+ -- If the current level of the tree specifies a type,+ -- then we are done. If not, then one of the conditional+ -- branches below the current node must specify a type.+ -- Each node may have multiple immediate children; we+ -- only need one to specify a type because the+ -- configure step uses 'mappend' to join together the+ -- results of flag resolution.+ in hasTestType || (any checkComponent components)+ if checkTestType emptyTestSuite flds+ then do+ skipField+ (repos, flags, lib, exes, tests) <- getBody+ return (repos, flags, lib, exes, (testname, flds) : tests)+ else lift $ syntaxError line_no $+ "Test suite \"" ++ testname+ ++ "\" is missing required field \"type\" or the field "+ ++ "is not present in all conditional branches. The "+ ++ "available test types are: "+ ++ intercalate ", " (map display knownTestTypes) | sec_type == "library" -> do when (not (null sec_label)) $ lift $
Distribution/Simple/InstallDirs.hs view
@@ -217,21 +217,23 @@ defaultInstallDirs :: CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates defaultInstallDirs comp userInstall _hasLibs = do- windowsProgramFilesDir <- getWindowsProgramFilesDir- userInstallPrefix <- getAppUserDataDirectory "cabal"- lhcPrefix <- getAppUserDataDirectory "lhc"+ installPrefix <-+ if userInstall+ then getAppUserDataDirectory "cabal"+ else case buildOS of+ Windows -> do windowsProgramFilesDir <- getWindowsProgramFilesDir+ return (windowsProgramFilesDir </> "Haskell")+ _ -> return "/usr/local"+ installLibDir <-+ case buildOS of+ Windows -> return "$prefix"+ _ -> case comp of+ LHC | userInstall -> getAppUserDataDirectory "lhc"+ _ -> return ("$prefix" </> "lib") return $ fmap toPathTemplate $ InstallDirs {- prefix = if userInstall- then userInstallPrefix- else case buildOS of- Windows -> windowsProgramFilesDir </> "Haskell"- _other -> "/usr/local",+ prefix = installPrefix, bindir = "$prefix" </> "bin",- libdir = case buildOS of- Windows -> "$prefix"- _other -> case comp of- LHC | userInstall -> lhcPrefix- _ -> "$prefix" </> "lib",+ libdir = installLibDir, libsubdir = case comp of Hugs -> "hugs" </> "packages" </> "$pkg" JHC -> "$compiler"
Distribution/Simple/SrcDist.hs view
@@ -67,7 +67,8 @@ ) where import Distribution.PackageDescription- ( PackageDescription(..), BuildInfo(..), Executable(..), Library(..) )+ ( PackageDescription(..), BuildInfo(..), Executable(..), Library(..)+ , TestSuite(..), TestSuiteInterface(..) ) import Distribution.PackageDescription.Check ( PackageCheck(..), checkConfiguredPackage, checkPackageFiles ) import Distribution.Package@@ -165,6 +166,24 @@ Nothing -> findFile (hsSourceDirs exeBi) mainPath Just pp -> return pp copyFileTo verbosity targetDir srcMainFile+ -- move the test suites into place+ withTest $ \t -> do+ let bi = testBuildInfo t+ prep = prepareDir verbosity pkg_descr distPref targetDir pps+ case testInterface t of+ TestSuiteExeV10 _ mainPath -> do+ prep [] bi+ srcMainFile <- do+ ppFile <- findFileWithExtension (ppSuffixes pps)+ (hsSourceDirs bi)+ (dropExtension mainPath)+ case ppFile of+ Nothing -> findFile (hsSourceDirs bi) mainPath+ Just pp -> return pp+ copyFileTo verbosity targetDir srcMainFile+ TestSuiteLibV09 _ m -> do+ prep [m] bi+ TestSuiteUnsupported tp -> die $ "Unsupported test suite type: " ++ show tp flip mapM_ (dataFiles pkg_descr) $ \ filename -> do files <- matchFileGlob (dataDir pkg_descr </> filename) let dir = takeDirectory (dataDir pkg_descr </> filename)@@ -230,6 +249,7 @@ -- versions of these functions that ignore the 'buildable' attribute: withLib action = maybe (return ()) action (library pkg_descr) withExe action = mapM_ action (executables pkg_descr)+ withTest action = mapM_ action (testSuites pkg_descr) -- | Prepare a directory tree of source files for a snapshot version. -- It is expected that the appropriate snapshot version has already been set
Distribution/Simple/Test.hs view
@@ -76,14 +76,14 @@ import Distribution.System ( buildPlatform, Platform ) import Control.Exception ( bracket )-import Control.Monad ( when, liftM, unless )+import Control.Monad ( when, liftM, unless, filterM ) import Data.Char ( toUpper ) import Data.Monoid ( mempty ) import System.Directory ( createDirectoryIfMissing, doesFileExist, getCurrentDirectory- , removeFile )+ , removeFile, getDirectoryContents ) import System.Environment ( getEnvironment )-import System.Exit ( ExitCode(..), exitFailure, exitSuccess, exitWith )+import System.Exit ( ExitCode(..), exitFailure, exitWith ) import System.FilePath ( (</>), (<.>) ) import System.IO ( hClose, IOMode(..), openFile ) import System.Process ( runProcess, waitForProcess )@@ -294,7 +294,7 @@ when (not $ PD.hasTests pkg_descr) $ do notice verbosity "Package has no test suites."- exitSuccess+ exitWith ExitSuccess when (PD.hasTests pkg_descr && null enabledTests) $ die $ "No test suites enabled. Did you remember to configure with "@@ -314,6 +314,11 @@ | otherwise -> die $ "no such test: " ++ tName createDirectoryIfMissing True testLogDir++ -- Delete ordinary files from test log directory.+ getDirectoryContents testLogDir+ >>= filterM doesFileExist . map (testLogDir </>)+ >>= mapM_ removeFile let totalSuites = length testsToRun notice verbosity $ "Running " ++ show totalSuites ++ " test suites..."
Distribution/Simple/Utils.hs view
@@ -153,14 +153,15 @@ ( exitWith, ExitCode(..) ) import System.FilePath ( normalise, (</>), (<.>), takeDirectory, splitFileName- , splitExtension, splitExtensions )+ , splitExtension, splitExtensions, splitDirectories ) import System.Directory- ( createDirectoryIfMissing, renameFile, removeDirectoryRecursive )+ ( createDirectory, renameFile, removeDirectoryRecursive ) import System.IO ( Handle, openFile, openBinaryFile, IOMode(ReadMode), hSetBinaryMode , hGetContents, stderr, stdout, hPutStr, hFlush, hClose ) import System.IO.Error as IO.Error- ( isDoesNotExistError, ioeSetFileName, ioeGetFileName, ioeGetErrorString )+ ( try, isDoesNotExistError, isAlreadyExistsError+ , ioeSetFileName, ioeGetFileName, ioeGetErrorString ) #if !(defined(__HUGS__) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 608)) import System.IO.Error ( ioeSetLocation, ioeGetLocation )@@ -190,11 +191,12 @@ #endif import Distribution.Compat.CopyFile- ( copyFile, copyOrdinaryFile, copyExecutableFile )+ ( copyFile, copyOrdinaryFile, copyExecutableFile+ , setDirOrdinary ) import Distribution.Compat.TempFile ( openTempFile, openNewBinaryFile, createTempDirectory ) import Distribution.Compat.Exception- ( catchIO, catchExit, onException )+ ( IOException, throwIOIO, catchIO, catchExit, onException ) import Distribution.Verbosity #ifdef VERSION_base@@ -700,11 +702,49 @@ -- | Same as 'createDirectoryIfMissing' but logs at higher verbosity levels. ---createDirectoryIfMissingVerbose :: Verbosity -> Bool -> FilePath -> IO ()-createDirectoryIfMissingVerbose verbosity parentsToo dir = do- let msgParents = if parentsToo then " (and its parents)" else ""- info verbosity ("Creating " ++ dir ++ msgParents)- createDirectoryIfMissing parentsToo dir+createDirectoryIfMissingVerbose :: Verbosity+ -> Bool -- ^ Create its parents too?+ -> FilePath+ -> IO ()+createDirectoryIfMissingVerbose verbosity create_parents path0+ | create_parents = createDirs (parents path0)+ | otherwise = createDirs (take 1 (parents path0))+ where+ parents = reverse . scanl1 (</>) . splitDirectories . normalise++ createDirs [] = return ()+ createDirs (dir:[]) = createDir dir throwIOIO+ createDirs (dir:dirs) =+ createDir dir $ \_ -> do+ createDirs dirs+ createDir dir throwIOIO++ createDir :: FilePath -> (IOException -> IO ()) -> IO ()+ createDir dir notExistHandler = do+ r <- try $ createDirectoryVerbose verbosity dir+ case (r :: Either IOException ()) of+ Right () -> return ()+ Left e+ | isDoesNotExistError e -> notExistHandler e+ -- createDirectory (and indeed POSIX mkdir) does not distinguish+ -- between a dir already existing and a file already existing. So we+ -- check for it here. Unfortunately there is a slight race condition+ -- here, but we think it is benign. It could report an exeption in+ -- the case that the dir did exist but another process deletes the+ -- directory and creates a file in its place before we can check+ -- that the directory did indeed exist.+ | isAlreadyExistsError e -> (do+ isDir <- doesDirectoryExist dir+ if isDir then return ()+ else throwIOIO e+ ) `catch` ((\_ -> return ()) :: IOException -> IO ())+ | otherwise -> throwIOIO e++createDirectoryVerbose :: Verbosity -> FilePath -> IO ()+createDirectoryVerbose verbosity dir = do+ info verbosity $ "creating " ++ dir+ createDirectory dir+ setDirOrdinary dir -- | Copies a file without copying file permissions. The target file is created -- with default permissions. Any existing target file is replaced.
changelog view
@@ -4,6 +4,12 @@ 1.10.0.x (next stable release version) +1.10.2.0 Duncan Coutts <duncan@community.haskell.org> June 2011+ * Include test suites in cabal sdist+ * Fix for conditionals in test suite stanzas in .cabal files+ * Fix permissions of directories created during install+ * Fix for global builds when $HOME env var is not set+ 1.10.1.0 Duncan Coutts <duncan@community.haskell.org> February 2011 * Improved error messages when test suites are not enabled * Template parameters allowed in test --test-option(s) flag