diff --git a/Cabal.cabal b/Cabal.cabal --- a/Cabal.cabal +++ b/Cabal.cabal @@ -1,11 +1,11 @@ Name: Cabal -Version: 1.10.0.0 +Version: 1.10.1.0 Copyright: 2003-2006, Isaac Jones - 2005-2009, Duncan Coutts + 2005-2011, Duncan Coutts License: BSD3 License-File: LICENSE Author: Isaac Jones - Duncan Coutts + Duncan Coutts Maintainer: cabal-devel@haskell.org Homepage: http://www.haskell.org/cabal/ bug-reports: http://hackage.haskell.org/trac/hackage/ diff --git a/Distribution/PackageDescription.hs b/Distribution/PackageDescription.hs --- a/Distribution/PackageDescription.hs +++ b/Distribution/PackageDescription.hs @@ -83,6 +83,7 @@ hasTests, withTest, testModules, + enabledTests, -- * Build information BuildInfo(..), @@ -375,7 +376,13 @@ data TestSuite = TestSuite { testName :: String, testInterface :: TestSuiteInterface, - testBuildInfo :: BuildInfo + testBuildInfo :: BuildInfo, + testEnabled :: Bool + -- TODO: By having a 'testEnabled' field in the PackageDescription, we + -- are mixing build status information (i.e., arguments to 'configure') + -- with static package description information. This is undesirable, but + -- a better solution is waiting on the next overhaul to the + -- GenericPackageDescription -> PackageDescription resolution process. } deriving (Show, Read, Eq) @@ -409,13 +416,15 @@ mempty = TestSuite { testName = mempty, testInterface = mempty, - testBuildInfo = mempty + testBuildInfo = mempty, + testEnabled = False } mappend a b = TestSuite { testName = combine' testName, testInterface = combine testInterface, - testBuildInfo = combine testBuildInfo + testBuildInfo = combine testBuildInfo, + testEnabled = if testEnabled a then True else testEnabled b } where combine field = field a `mappend` field b combine' f = case (f a, f b) of @@ -436,11 +445,14 @@ hasTests :: PackageDescription -> Bool hasTests = any (buildable . testBuildInfo) . testSuites +-- | Get all the enabled test suites from a package. +enabledTests :: PackageDescription -> [TestSuite] +enabledTests = filter testEnabled . testSuites + -- | Perform an action on each buildable 'TestSuite' in a package. withTest :: PackageDescription -> (TestSuite -> IO ()) -> IO () withTest pkg_descr f = - mapM_ f $ filter (buildable . testBuildInfo) $ - testSuites pkg_descr + mapM_ f $ filter (buildable . testBuildInfo) $ enabledTests pkg_descr -- | Get all the module names from a test suite. testModules :: TestSuite -> [ModuleName] diff --git a/Distribution/PackageDescription/Check.hs b/Distribution/PackageDescription/Check.hs --- a/Distribution/PackageDescription/Check.hs +++ b/Distribution/PackageDescription/Check.hs @@ -803,11 +803,13 @@ ++ "range syntax rather than a simple version number. Use " ++ "'cabal-version: >= " ++ display (specVersion pkg) ++ "'." - -- check use of test suite stanzas - , checkVersion [1,10] (not (null $ testSuites pkg)) $ + -- check use of test suite sections + , checkVersion [1,8] (not (null $ testSuites pkg)) $ PackageDistInexcusable $ - "The package uses test suite stanzas. To use this new syntax, " - ++ "the package needs to specify at least 'cabal-version: >= 1.10'." + "The 'test-suite' section is new in Cabal 1.10. " + ++ "Unfortunately it messes up the parser in older Cabal versions " + ++ "so you must specify at least 'cabal-version: >= 1.8', but note" + ++ "that only Cabal 1.10 and later can actually run such test suites." -- check use of default-language field -- note that we do not need to do an equivalent check for the diff --git a/Distribution/PackageDescription/Configuration.hs b/Distribution/PackageDescription/Configuration.hs --- a/Distribution/PackageDescription/Configuration.hs +++ b/Distribution/PackageDescription/Configuration.hs @@ -56,6 +56,10 @@ -- Utils parseCondition, freeVars, + mapCondTree, + mapTreeData, + mapTreeConds, + mapTreeConstrs, ) where import Distribution.Package @@ -235,16 +239,16 @@ -- This would require some sort of SAT solving, though, thus it's not -- implemented unless we really need it. -- -resolveWithFlags :: Monoid a => +resolveWithFlags :: [(FlagName,[Bool])] -- ^ Domain for each flag name, will be tested in order. -> OS -- ^ OS as returned by Distribution.System.buildOS -> Arch -- ^ Arch as returned by Distribution.System.buildArch -> CompilerId -- ^ Compiler flavour + version -> [Dependency] -- ^ Additional constraints - -> [CondTree ConfVar [Dependency] a] + -> [CondTree ConfVar [Dependency] PDTagged] -> ([Dependency] -> DepTestRslt [Dependency]) -- ^ Dependency test function. - -> Either [Dependency] (TargetSet a, FlagAssignment) + -> Either [Dependency] (TargetSet PDTagged, FlagAssignment) -- ^ Either the missing dependencies (error case), or a pair of -- (set of build targets with dependencies, chosen flag assignments) resolveWithFlags dom os arch impl constrs trees checkDeps = @@ -392,10 +396,15 @@ -- | Combine the target-specific dependencies in a TargetSet to give the -- dependencies for the package as a whole. -overallDependencies :: Monoid a => TargetSet a -> DependencyMap +overallDependencies :: TargetSet PDTagged -> DependencyMap overallDependencies (TargetSet targets) = mconcat depss where - (depss, _) = unzip targets + (depss, _) = unzip $ filter (removeDisabledTests . snd) targets + removeDisabledTests :: PDTagged -> Bool + removeDisabledTests (Lib _) = True + removeDisabledTests (Exe _ _) = True + removeDisabledTests (Test _ t) = testEnabled t + removeDisabledTests PDNull = True -- Apply extra constraints to a dependency map. -- Combines dependencies where the result will only contain keys from the left diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs --- a/Distribution/Simple.hs +++ b/Distribution/Simple.hs @@ -119,7 +119,7 @@ import Distribution.Simple.Utils (die, notice, info, warn, setupMessage, chattyTry, defaultPackageDesc, defaultHookedPackageDesc, - rawSystemExit, cabalVersion, topHandler ) + rawSystemExitWithEnv, cabalVersion, topHandler ) import Distribution.System ( OS(..), buildOS ) import Distribution.Verbosity @@ -130,7 +130,7 @@ ( display ) -- Base -import System.Environment(getArgs,getProgName) +import System.Environment(getArgs, getProgName, getEnvironment) import System.Directory(removeFile, doesFileExist, doesDirectoryExist, removeDirectoryRecursive) import System.Exit @@ -521,7 +521,7 @@ confExists <- doesFileExist "configure" when confExists $ runConfigureScript verbosity - backwardsCompatHack flags + backwardsCompatHack flags lbi pbi <- getHookedBuildInfo verbosity let pkg_descr' = updatePackageDescription pbi pkg_descr @@ -550,7 +550,7 @@ confExists <- doesFileExist "configure" if confExists then runConfigureScript verbosity - backwardsCompatHack flags + backwardsCompatHack flags lbi else die "configure script not found." pbi <- getHookedBuildInfo verbosity @@ -566,14 +566,32 @@ where verbosity = fromFlag (get_verbosity flags) -runConfigureScript :: Verbosity -> Bool -> ConfigFlags -> IO () -runConfigureScript verbosity backwardsCompatHack flags = +runConfigureScript :: Verbosity -> Bool -> ConfigFlags -> LocalBuildInfo + -> IO () +runConfigureScript verbosity backwardsCompatHack flags lbi = do + env <- getEnvironment + let programConfig = withPrograms lbi + (ccProg, ccFlags) <- configureCCompiler verbosity programConfig + -- The C compiler's compilation and linker flags (e.g. + -- "C compiler flags" and "Gcc Linker flags" from GHC) have already + -- been merged into ccFlags, so we set both CFLAGS and LDFLAGS + -- to ccFlags + -- We don't try and tell configure which ld to use, as we don't have + -- a way to pass its flags too + let env' = appendToEnvironment ("CFLAGS", unwords ccFlags) + env + args' = args ++ ["--with-gcc=" ++ ccProg] handleNoWindowsSH $ - rawSystemExit verbosity "sh" args + rawSystemExitWithEnv verbosity "sh" args' env' where args = "configure" : configureArgs backwardsCompatHack flags + + appendToEnvironment (key, val) [] = [(key, val)] + appendToEnvironment (key, val) (kv@(k, v) : rest) + | key == k = (key, v ++ " " ++ val) : rest + | otherwise = kv : appendToEnvironment (key, val) rest handleNoWindowsSH action | buildOS /= Windows diff --git a/Distribution/Simple/Command.hs b/Distribution/Simple/Command.hs --- a/Distribution/Simple/Command.hs +++ b/Distribution/Simple/Command.hs @@ -49,6 +49,8 @@ -- * Command interface CommandUI(..), commandShowOptions, + CommandParse(..), + commandParseArgs, -- ** Constructing commands ShowOrParseArgs(..), @@ -60,7 +62,6 @@ noExtraFlags, -- ** Running commands - CommandParse(..), commandsRun, -- * Option Fields @@ -403,8 +404,11 @@ fmapArgDesc f (GetOpt.ReqArg s d) = GetOpt.ReqArg (f . s) d fmapArgDesc f (GetOpt.OptArg s d) = GetOpt.OptArg (f . s) d - -commandParseArgs :: CommandUI flags -> Bool -> [String] +-- | Parse a bunch of command line arguments +-- +commandParseArgs :: CommandUI flags + -> Bool -- ^ Is the command a global or subcommand? + -> [String] -> CommandParse (flags -> flags, [String]) commandParseArgs command global args = let options = addCommonFlags ParseArgs diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs --- a/Distribution/Simple/Configure.hs +++ b/Distribution/Simple/Configure.hs @@ -84,7 +84,7 @@ , HookedBuildInfo, updatePackageDescription, allBuildInfo , FlagName(..), TestSuite(..) ) import Distribution.PackageDescription.Configuration - ( finalizePackageDescription, flattenPackageDescription ) + ( finalizePackageDescription, mapTreeData ) import Distribution.PackageDescription.Check ( PackageCheck(..), checkPackage, checkPackageFiles ) import Distribution.Simple.Program @@ -318,12 +318,10 @@ not . null . PackageIndex.lookupDependency pkgs' where pkgs' = PackageIndex.insert internalPackage installedPackageSet - pkg_descr0'' = - --TODO: avoid disabling tests entirely, we otherwise cannot - -- perform semantic checks, see also checkPackageProblems - if fromFlag (configTests cfg) - then pkg_descr0 - else pkg_descr0 { condTestSuites = [] } + enableTest t = t { testEnabled = fromFlag (configTests cfg) } + flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t)) + (condTestSuites pkg_descr0) + pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests } (pkg_descr0', flags) <- case finalizePackageDescription @@ -480,7 +478,7 @@ (configScratchDir cfg), libraryConfig = configLib `fmap` library pkg_descr', executableConfigs = configExe `fmap` executables pkg_descr', - testSuiteConfigs = configTest `fmap` testSuites pkg_descr', + testSuiteConfigs = configTest `fmap` filter testEnabled (testSuites pkg_descr'), installedPkgs = packageDependsIndex, pkgDescrFile = Nothing, localPkgDescr = pkg_descr', @@ -970,7 +968,7 @@ -> GenericPackageDescription -> PackageDescription -> IO () -checkPackageProblems verbosity gpkg pkg0 = do +checkPackageProblems verbosity gpkg pkg = do ioChecks <- checkPackageFiles pkg "." let pureChecks = checkPackage gpkg (Just pkg) errors = [ e | PackageBuildImpossible e <- pureChecks ++ ioChecks ] @@ -979,16 +977,3 @@ then mapM_ (warn verbosity) warnings else do mapM_ (hPutStrLn stderr . ("Error: " ++)) errors exitWith (ExitFailure 1) - where - -- TODO: Sigh, this is a fairly unpleasent hack. The issue is that - -- we want to check test-suite sections even when tests are disabled. - -- When tests are disabled we have to exclude the test-suite sections - -- when resolving the conditionals. But the checks we do are done - -- on the post-resolved form! Ug. A better solution would be either - -- 1) to do the checks on the pre-resolved form - -- 2) to resolve in two steps: find a flag assignment, then apply it - -- that'd allow us to find the flag assingment ignoring tests - -- but then to apply it anyway. - -- In the meantime we stick the tests back in before checking by - -- flattening the pre-resovled form. - pkg = pkg0 { testSuites = testSuites (flattenPackageDescription gpkg) } diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs --- a/Distribution/Simple/GHC.hs +++ b/Distribution/Simple/GHC.hs @@ -96,9 +96,10 @@ ( Program(..), ConfiguredProgram(..), ProgramConfiguration, ProgArg , ProgramLocation(..), rawSystemProgram, rawSystemProgramConf , rawSystemProgramStdout, rawSystemProgramStdoutConf - , requireProgramVersion, requireProgram + , requireProgramVersion, requireProgram, getProgramOutput , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram - , ghcProgram, ghcPkgProgram, arProgram, ranlibProgram, ldProgram + , ghcProgram, ghcPkgProgram, hsc2hsProgram + , arProgram, ranlibProgram, ldProgram , gccProgram, stripProgram ) import qualified Distribution.Simple.Program.HcPkg as HcPkg import qualified Distribution.Simple.Program.Ar as Ar @@ -116,7 +117,7 @@ ( display, simpleParse ) import Language.Haskell.Extension (Language(..), Extension(..)) -import Control.Monad ( unless, when ) +import Control.Monad ( unless, when, liftM ) import Data.Char ( isSpace ) import Data.List import Data.Maybe ( catMaybes ) @@ -134,60 +135,81 @@ configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramConfiguration -> IO (Compiler, ProgramConfiguration) -configure verbosity hcPath hcPkgPath conf = do +configure verbosity hcPath hcPkgPath conf0 = do - (ghcProg, ghcVersion, conf') <- + (ghcProg, ghcVersion, conf1) <- requireProgramVersion verbosity ghcProgram (orLaterVersion (Version [6,4] [])) - (userMaybeSpecifyPath "ghc" hcPath conf) + (userMaybeSpecifyPath "ghc" hcPath conf0) -- This is slightly tricky, we have to configure ghc first, then we use the -- location of ghc to help find ghc-pkg in the case that the user did not -- specify the location of ghc-pkg directly: - (ghcPkgProg, ghcPkgVersion, conf'') <- + (ghcPkgProg, ghcPkgVersion, conf2) <- requireProgramVersion verbosity ghcPkgProgram { programFindLocation = guessGhcPkgFromGhcPath ghcProg } - anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath conf') + anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath conf1) when (ghcVersion /= ghcPkgVersion) $ die $ "Version mismatch between ghc and ghc-pkg: " ++ programPath ghcProg ++ " is version " ++ display ghcVersion ++ " " ++ programPath ghcPkgProg ++ " is version " ++ display ghcPkgVersion + -- Likewise we try to find the matching hsc2hs program. + let hsc2hsProgram' = hsc2hsProgram { + programFindLocation = guessHsc2hsFromGhcPath ghcProg + } + conf3 = addKnownProgram hsc2hsProgram' conf2 + languages <- getLanguages verbosity ghcProg extensions <- getExtensions verbosity ghcProg + ghcInfo <- if ghcVersion >= Version [6,7] [] + then do xs <- getProgramOutput verbosity ghcProg ["--info"] + case reads xs of + [(i, ss)] + | all isSpace ss -> + return i + _ -> + die "Can't parse --info output of GHC" + else return [] + let comp = Compiler { compilerId = CompilerId GHC ghcVersion, compilerLanguages = languages, compilerExtensions = extensions } - conf''' = configureToolchain ghcProg conf'' -- configure gcc and ld - return (comp, conf''') + conf4 = configureToolchain ghcProg ghcInfo conf3 -- configure gcc and ld + return (comp, conf4) --- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a --- corresponding ghc-pkg, we try looking for both a versioned and unversioned --- ghc-pkg in the same dir, that is: +-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find +-- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking +-- for a versioned or unversioned ghc-pkg in the same dir, that is: -- +-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe) -- > /usr/local/bin/ghc-pkg-6.6.1(.exe) -- > /usr/local/bin/ghc-pkg(.exe) -- -guessGhcPkgFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath) -guessGhcPkgFromGhcPath ghcProg verbosity - = do let path = programPath ghcProg - dir = takeDirectory path - versionSuffix = takeVersionSuffix (dropExeExtension path) - guessNormal = dir "ghc-pkg" <.> exeExtension - guessVersioned = dir ("ghc-pkg" ++ versionSuffix) <.> exeExtension +guessToolFromGhcPath :: FilePath -> ConfiguredProgram -> Verbosity + -> IO (Maybe FilePath) +guessToolFromGhcPath tool ghcProg verbosity + = do let path = programPath ghcProg + dir = takeDirectory path + versionSuffix = takeVersionSuffix (dropExeExtension path) + guessNormal = dir tool <.> exeExtension + guessGhcVersioned = dir (tool ++ "-ghc" ++ versionSuffix) <.> exeExtension + guessVersioned = dir (tool ++ versionSuffix) <.> exeExtension guesses | null versionSuffix = [guessNormal] - | otherwise = [guessVersioned, guessNormal] - info verbosity $ "looking for package tool: ghc-pkg near compiler in " ++ dir + | otherwise = [guessGhcVersioned, + guessVersioned, + guessNormal] + info verbosity $ "looking for tool " ++ show tool ++ " near compiler in " ++ dir exists <- mapM doesFileExist guesses case [ file | (file, True) <- zip guesses exists ] of [] -> return Nothing - (pkgtool:_) -> do info verbosity $ "found package tool in " ++ pkgtool - return (Just pkgtool) + (fp:_) -> do info verbosity $ "found " ++ tool ++ " in " ++ fp + return (Just fp) where takeVersionSuffix :: FilePath -> String takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") . reverse @@ -198,11 +220,34 @@ (filepath', extension) | extension == exeExtension -> filepath' | otherwise -> filepath +-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a +-- corresponding ghc-pkg, we try looking for both a versioned and unversioned +-- ghc-pkg in the same dir, that is: +-- +-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe) +-- > /usr/local/bin/ghc-pkg-6.6.1(.exe) +-- > /usr/local/bin/ghc-pkg(.exe) +-- +guessGhcPkgFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath) +guessGhcPkgFromGhcPath = guessToolFromGhcPath "ghc-pkg" + +-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a +-- corresponding hsc2hs, we try looking for both a versioned and unversioned +-- hsc2hs in the same dir, that is: +-- +-- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe) +-- > /usr/local/bin/hsc2hs-6.6.1(.exe) +-- > /usr/local/bin/hsc2hs(.exe) +-- +guessHsc2hsFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath) +guessHsc2hsFromGhcPath = guessToolFromGhcPath "hsc2hs" + -- | Adjust the way we find and configure gcc and ld -- -configureToolchain :: ConfiguredProgram -> ProgramConfiguration +configureToolchain :: ConfiguredProgram -> [(String, String)] -> ProgramConfiguration -configureToolchain ghcProg = + -> ProgramConfiguration +configureToolchain ghcProg ghcInfo = addKnownProgram gccProgram { programFindLocation = findProg gccProgram [ if ghcVersion >= Version [6,12] [] @@ -246,8 +291,23 @@ if exists then return (Just f) else look fs verbosity + ccFlags = getFlags "C compiler flags" + gccLinkerFlags = getFlags "Gcc Linker flags" + ldLinkerFlags = getFlags "Ld Linker flags" + + getFlags key = case lookup key ghcInfo of + Nothing -> [] + Just flags -> + case reads flags of + [(args, "")] -> args + _ -> [] -- XXX Should should be an error really + configureGcc :: Verbosity -> ConfiguredProgram -> IO [ProgArg] - configureGcc + configureGcc v cp = liftM (++ (ccFlags ++ gccLinkerFlags)) + $ configureGcc' v cp + + configureGcc' :: Verbosity -> ConfiguredProgram -> IO [ProgArg] + configureGcc' | isWindows = \_ gccProg -> case programLocation gccProg of -- if it's found on system then it means we're using the result -- of programFindLocation above rather than a user-supplied path @@ -260,9 +320,12 @@ _ -> return [] | otherwise = \_ _ -> return [] - -- we need to find out if ld supports the -x flag configureLd :: Verbosity -> ConfiguredProgram -> IO [ProgArg] - configureLd verbosity ldProg = do + configureLd v cp = liftM (++ ldLinkerFlags) $ configureLd' v cp + + -- we need to find out if ld supports the -x flag + configureLd' :: Verbosity -> ConfiguredProgram -> IO [ProgArg] + configureLd' verbosity ldProg = do tempDir <- getTemporaryDirectory ldx <- withTempFile tempDir ".c" $ \testcfile testchnd -> withTempFile tempDir ".o" $ \testofile testohnd -> do diff --git a/Distribution/Simple/Haddock.hs b/Distribution/Simple/Haddock.hs --- a/Distribution/Simple/Haddock.hs +++ b/Distribution/Simple/Haddock.hs @@ -123,7 +123,7 @@ argLinkSource :: Flag (Template,Template), -- ^ (template for modules, template for symbols) argCssFile :: Flag FilePath, -- ^ optinal custom css file. argVerbose :: Any, - argOutput :: Flag Output, -- ^ Html or Hoogle doc? required. + argOutput :: Flag [Output], -- ^ Html or Hoogle doc or both? required. argInterfaces :: [(FilePath, Maybe FilePath)], -- ^ [(interface file, path to the html docs for links)] argOutputDir :: Directory, -- ^ where to generate the documentation. argTitle :: Flag String, -- ^ page's title, required. @@ -273,7 +273,11 @@ else NoFlag, argCssFile = haddockCss flags, argVerbose = maybe mempty (Any . (>= deafening)) . flagToMaybe $ haddockVerbosity flags, - argOutput = fmap (\b -> if b then Hoogle else Html) $ haddockHoogle flags, + argOutput = + Flag $ case [ Html | Flag True <- [haddockHtml flags] ] ++ + [ Hoogle | Flag True <- [haddockHoogle flags] ] + of [] -> [ Html ] + os -> os, argOutputDir = maybe mempty Dir . flagToMaybe $ haddockDistPref flags } @@ -383,11 +387,16 @@ where isVersion2 = version >= Version [2,0] [] outputDir = (unDir $ argOutputDir args) - result = outputDir - case arg argOutput of - Html -> "index.html" - Hoogle -> (if isVersion2 then display $ packageName pkgid else display pkgid) <.> "txt" - where pkgid = arg argPackageName + result = intercalate ", " + . map (\o -> outputDir + case o of + Html -> "index.html" + Hoogle -> pkgstr <.> "txt") + $ arg argOutput + where + pkgstr | isVersion2 = display $ packageName pkgid + | otherwise = display pkgid + pkgid = arg argPackageName arg f = fromFlag $ f args renderPureArgs :: Version -> HaddockArgs -> [[Char]] @@ -404,7 +413,7 @@ ,"--source-entity=" ++ e]) . flagToMaybe . argLinkSource $ args, maybe [] ((:[]).("--css="++)) . flagToMaybe . argCssFile $ args, bool [] [verbosityFlag] . getAny . argVerbose $ args, - (\o -> case o of Hoogle -> ["--hoogle"]; Html -> ["--html"]) . fromFlag . argOutput $ args, + map (\o -> case o of Hoogle -> "--hoogle"; Html -> "--html") . fromFlag . argOutput $ args, renderInterfaces . argInterfaces $ args, (:[]).("--odir="++) . unDir . argOutputDir $ args, (:[]).("--title="++) . (bool (++" (internal documentation)") id (getAny $ argIgnoreExports args)) diff --git a/Distribution/Simple/LocalBuildInfo.hs b/Distribution/Simple/LocalBuildInfo.hs --- a/Distribution/Simple/LocalBuildInfo.hs +++ b/Distribution/Simple/LocalBuildInfo.hs @@ -106,7 +106,8 @@ executableConfigs :: [(String, ComponentLocalBuildInfo)], testSuiteConfigs :: [(String, ComponentLocalBuildInfo)], installedPkgs :: PackageIndex, - -- ^ All the info about all installed packages. + -- ^ All the info about the installed packages that the + -- current package depends on (directly or indirectly). pkgDescrFile :: Maybe FilePath, -- ^ the filename containing the .cabal file, if available localPkgDescr :: PackageDescription, diff --git a/Distribution/Simple/Program/Db.hs b/Distribution/Simple/Program/Db.hs --- a/Distribution/Simple/Program/Db.hs +++ b/Distribution/Simple/Program/Db.hs @@ -360,7 +360,7 @@ Nothing -> die notFound Just configuredProg -> return (configuredProg, conf') - where notFound = programName prog + where notFound = "The program " ++ programName prog ++ " is required but it could not be found." @@ -393,12 +393,15 @@ | otherwise -> die (badVersion version location) Nothing -> die (noVersion location) - where notFound = programName prog ++ versionRequirement + where notFound = "The program " + ++ programName prog ++ versionRequirement ++ " is required but it could not be found." - badVersion v l = programName prog ++ versionRequirement + badVersion v l = "The program " + ++ programName prog ++ versionRequirement ++ " is required but the version found at " ++ locationPath l ++ " is version " ++ display v - noVersion l = programName prog ++ versionRequirement + noVersion l = "The program " + ++ programName prog ++ versionRequirement ++ " is required but the version of " ++ locationPath l ++ " could not be determined." versionRequirement diff --git a/Distribution/Simple/Program/HcPkg.hs b/Distribution/Simple/Program/HcPkg.hs --- a/Distribution/Simple/Program/HcPkg.hs +++ b/Distribution/Simple/Program/HcPkg.hs @@ -51,6 +51,8 @@ import Distribution.Compat.Exception ( catchExit ) +import Data.Char + ( isSpace ) import Control.Monad ( liftM ) @@ -135,8 +137,12 @@ --TODO: this could be a lot faster. We're doing normaliseLineEndings twice -- and converting back and forth with lines/unlines. splitPkgs :: String -> [String] - splitPkgs = map unlines . splitWith ("---" ==) . lines + splitPkgs = checkEmpty . map unlines . splitWith ("---" ==) . lines where + -- Handle the case of there being no packages at all. + checkEmpty [s] | all isSpace s = [] + checkEmpty ss = ss + splitWith :: (a -> Bool) -> [a] -> [[a]] splitWith p xs = ys : case zs of [] -> [] diff --git a/Distribution/Simple/Setup.hs b/Distribution/Simple/Setup.hs --- a/Distribution/Simple/Setup.hs +++ b/Distribution/Simple/Setup.hs @@ -73,7 +73,7 @@ TestFlags(..), emptyTestFlags, defaultTestFlags, testCommand, TestShowDetails(..), CopyDest(..), - configureArgs, configureOptions, + configureArgs, configureOptions, configureCCompiler, configureLinker, installDirsOptions, defaultDistPref, @@ -103,9 +103,11 @@ import Distribution.Simple.Utils ( wrapLine, lowercase, intercalate ) import Distribution.Simple.Program (Program(..), ProgramConfiguration, + requireProgram, + programInvocation, progInvokePath, progInvokeArgs, knownPrograms, addKnownProgram, emptyProgramConfiguration, - haddockProgram, ghcProgram) + haddockProgram, ghcProgram, gccProgram, ldProgram) import Distribution.Simple.InstallDirs ( InstallDirs(..), CopyDest(..), PathTemplate, toPathTemplate, fromPathTemplate ) @@ -966,6 +968,7 @@ haddockProgramPaths :: [(String, FilePath)], haddockProgramArgs :: [(String, [String])], haddockHoogle :: Flag Bool, + haddockHtml :: Flag Bool, haddockHtmlLocation :: Flag String, haddockExecutables :: Flag Bool, haddockInternal :: Flag Bool, @@ -982,6 +985,7 @@ haddockProgramPaths = mempty, haddockProgramArgs = [], haddockHoogle = Flag False, + haddockHtml = Flag False, haddockHtmlLocation = NoFlag, haddockExecutables = Flag False, haddockInternal = Flag False, @@ -1009,6 +1013,11 @@ haddockHoogle (\v flags -> flags { haddockHoogle = v }) trueArg + ,option "" ["html"] + "Generate HTML documentation (the default)" + haddockHtml (\v flags -> flags { haddockHtml = v }) + trueArg + ,option "" ["html-location"] "Location of HTML documentation for pre-requisite packages" haddockHtmlLocation (\v flags -> flags { haddockHtmlLocation = v }) @@ -1055,6 +1064,7 @@ haddockProgramPaths = mempty, haddockProgramArgs = mempty, haddockHoogle = mempty, + haddockHtml = mempty, haddockHtmlLocation = mempty, haddockExecutables = mempty, haddockInternal = mempty, @@ -1068,6 +1078,7 @@ haddockProgramPaths = combine haddockProgramPaths, haddockProgramArgs = combine haddockProgramArgs, haddockHoogle = combine haddockHoogle, + haddockHtml = combine haddockHoogle, haddockHtmlLocation = combine haddockHtmlLocation, haddockExecutables = combine haddockExecutables, haddockInternal = combine haddockInternal, @@ -1226,7 +1237,7 @@ --TODO: eliminate the test list and pass it directly as positional args to the testHook testList :: Flag [String], -- TODO: think about if/how options are passed to test exes - testOptions :: Flag [String] + testOptions :: Flag [PathTemplate] } defaultTestFlags :: TestFlags @@ -1277,14 +1288,20 @@ (fmap toFlag parse)) (flagToList . fmap display)) , option [] ["test-options"] - "give extra options to test executables" + ("give extra options to test executables " + ++ "(name templates can use $pkgid, $compiler, " + ++ "$os, $arch, $test-suite)") testOptions (\v flags -> flags { testOptions = v }) - (reqArg' "OPTS" (toFlag . splitArgs) (fromFlagOrDefault [])) + (reqArg' "TEMPLATES" (toFlag . map toPathTemplate . splitArgs) + (map fromPathTemplate . fromFlagOrDefault [])) , option [] ["test-option"] ("give extra option to test executables " - ++ "(no need to quote options containing spaces)") + ++ "(no need to quote options containing spaces, " + ++ "name template can use $pkgid, $compiler, " + ++ "$os, $arch, $test-suite)") testOptions (\v flags -> flags { testOptions = v }) - (reqArg' "OPT" (\x -> toFlag [x]) (fromFlagOrDefault [])) + (reqArg' "TEMPLATE" (\x -> toFlag [toPathTemplate x]) + (map fromPathTemplate . fromFlagOrDefault [])) ] emptyTestFlags :: TestFlags @@ -1445,6 +1462,18 @@ optFlag' name config_field = optFlag name (fmap fromPathTemplate . config_field . configInstallDirs) + +configureCCompiler :: Verbosity -> ProgramConfiguration -> IO (FilePath, [String]) +configureCCompiler verbosity lbi = configureProg verbosity lbi gccProgram + +configureLinker :: Verbosity -> ProgramConfiguration -> IO (FilePath, [String]) +configureLinker verbosity lbi = configureProg verbosity lbi ldProgram + +configureProg :: Verbosity -> ProgramConfiguration -> Program -> IO (FilePath, [String]) +configureProg verbosity programConfig prog = do + (p, _) <- requireProgram verbosity prog programConfig + let pInv = programInvocation p [] + return (progInvokePath pInv, progInvokeArgs pInv) -- | Helper function to split a string into a list of arguments. -- It's supposed to handle quoted things sensibly, eg: diff --git a/Distribution/Simple/SrcDist.hs b/Distribution/Simple/SrcDist.hs --- a/Distribution/Simple/SrcDist.hs +++ b/Distribution/Simple/SrcDist.hs @@ -78,7 +78,7 @@ ( Version(versionBranch) ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File - , copyFiles, copyFileVerbose + , installOrdinaryFile, installOrdinaryFiles , findFile, findFileWithExtension, matchFileGlob , withTempDirectory, defaultPackageDesc , die, warn, notice, setupMessage ) @@ -96,7 +96,9 @@ import Data.List (partition, isPrefixOf) import Data.Maybe (isNothing, catMaybes) import System.Time (getClockTime, toCalendarTime, CalendarTime(..)) -import System.Directory (doesFileExist) +import System.Directory + ( doesFileExist, Permissions(executable), getPermissions ) +import Distribution.Compat.CopyFile (setFileExecutable) import Distribution.Verbosity (Verbosity) import System.FilePath ( (), (<.>), takeDirectory, dropExtension, isAbsolute ) @@ -167,14 +169,20 @@ files <- matchFileGlob (dataDir pkg_descr filename) let dir = takeDirectory (dataDir pkg_descr filename) createDirectoryIfMissingVerbose verbosity True (targetDir dir) - sequence_ [ copyFileVerbose verbosity file (targetDir file) + sequence_ [ installOrdinaryFile verbosity file (targetDir file) | file <- files ] when (not (null (licenseFile pkg_descr))) $ copyFileTo verbosity targetDir (licenseFile pkg_descr) flip mapM_ (extraSrcFiles pkg_descr) $ \ fpath -> do files <- matchFileGlob fpath - sequence_ [ copyFileTo verbosity targetDir file | file <- files ] + sequence_ + [ do copyFileTo verbosity targetDir file + -- preserve executable bit on extra-src-files like ./configure + perms <- getPermissions file + when (executable perms) --only checks user x bit + (setFileExecutable (targetDir file)) + | file <- files ] -- copy the install-include files withLib $ \ l -> do @@ -202,7 +210,7 @@ "main = defaultMain"] -- the description file itself descFile <- defaultPackageDesc verbosity - copyFileVerbose verbosity descFile (targetDir descFile) + installOrdinaryFile verbosity descFile (targetDir descFile) return targetDir where @@ -329,7 +337,7 @@ | module_ <- modules ++ otherModules bi ] let allSources = sources ++ catMaybes bootFiles ++ cSources bi - copyFiles verbosity inPref (zip (repeat []) allSources) + installOrdinaryFiles verbosity inPref (zip (repeat []) allSources) where suffixes = ppSuffixes pps ++ ["hs", "lhs"] notFound m = die $ "Error: Could not find module: " ++ display m @@ -339,7 +347,7 @@ copyFileTo verbosity dir file = do let targetFile = dir file createDirectoryIfMissingVerbose verbosity True (takeDirectory targetFile) - copyFileVerbose verbosity file targetFile + installOrdinaryFile verbosity file targetFile printPackageProblems :: Verbosity -> PackageDescription -> IO () printPackageProblems verbosity pkg_descr = do diff --git a/Distribution/Simple/Test.hs b/Distribution/Simple/Test.hs --- a/Distribution/Simple/Test.hs +++ b/Distribution/Simple/Test.hs @@ -58,7 +58,7 @@ ( PackageId ) import qualified Distribution.PackageDescription as PD ( PackageDescription(..), TestSuite(..) - , TestSuiteInterface(..), testType ) + , TestSuiteInterface(..), testType, hasTests ) import Distribution.Simple.Build.PathsModule ( pkgPathEnvVar ) import Distribution.Simple.BuildPaths ( exeExtension ) import Distribution.Simple.Compiler ( Compiler(..), CompilerId ) @@ -83,7 +83,7 @@ ( createDirectoryIfMissing, doesFileExist, getCurrentDirectory , removeFile ) import System.Environment ( getEnvironment ) -import System.Exit ( ExitCode(..), exitFailure, exitWith ) +import System.Exit ( ExitCode(..), exitFailure, exitSuccess, exitWith ) import System.FilePath ( (), (<.>) ) import System.IO ( hClose, IOMode(..), openFile ) import System.Process ( runProcess, waitForProcess ) @@ -150,6 +150,8 @@ -- ^ flags Cabal was invoked with -> PD.PackageDescription -- ^ description of package the test suite belongs to + -> LBI.LocalBuildInfo + -- ^ information from the configure step -> PD.TestSuite -- ^ TestSuite being tested -> (FilePath -> String) @@ -160,11 +162,12 @@ -> (TestSuiteLog -> FilePath) -- ^ generator for final human-readable log filename -> IO TestSuiteLog -testController flags pkg_descr suite preTest cmd postTest logNamer = do +testController flags pkg_descr lbi suite preTest cmd postTest logNamer = do let distPref = fromFlag $ testDistPref flags verbosity = fromFlag $ testVerbosity flags testLogDir = distPref "test" - options = fromFlag $ testOptions flags + optionTemplates = fromFlag $ testOptions flags + options = map (testOption pkg_descr lbi suite) optionTemplates pwd <- getCurrentDirectory existingEnv <- getEnvironment @@ -242,11 +245,12 @@ testLogDir = distPref "test" testNames = fromFlag $ testList flags pkgTests = PD.testSuites pkg_descr + enabledTests = filter PD.testEnabled pkgTests doTest :: (PD.TestSuite, Maybe TestSuiteLog) -> IO TestSuiteLog doTest (suite, mLog) = do let testLogPath = testSuiteLogPath humanTemplate pkg_descr lbi - go pre cmd post = testController flags pkg_descr suite + go pre cmd post = testController flags pkg_descr lbi suite pre cmd post testLogPath case PD.testInterface suite of PD.TestSuiteExeV10 _ _ -> do @@ -288,13 +292,26 @@ , logFile = "" } + when (not $ PD.hasTests pkg_descr) $ do + notice verbosity "Package has no test suites." + exitSuccess + + when (PD.hasTests pkg_descr && null enabledTests) $ + die $ "No test suites enabled. Did you remember to configure with " + ++ "\'--enable-tests\'?" + testsToRun <- case testNames of - [] -> return $ zip pkgTests $ repeat Nothing + [] -> return $ zip enabledTests $ repeat Nothing names -> flip mapM names $ \tName -> - let testMap = map (\x -> (PD.testName x, x)) pkgTests + let testMap = zip enabledNames enabledTests + enabledNames = map PD.testName enabledTests + allNames = map PD.testName pkgTests in case lookup tName testMap of Just t -> return (t, Nothing) - _ -> die $ "no such test: " ++ tName + _ | tName `elem` allNames -> + die $ "Package configured with test suite " + ++ tName ++ " disabled." + | otherwise -> die $ "no such test: " ++ tName createDirectoryIfMissing True testLogDir @@ -363,6 +380,20 @@ , (TestSuiteResultVar, result) ] result = toPathTemplate $ resultString testLog + +-- TODO: This is abusing the notion of a 'PathTemplate'. The result +-- isn't neccesarily a path. +testOption :: PD.PackageDescription + -> LBI.LocalBuildInfo + -> PD.TestSuite + -> PathTemplate + -> String +testOption pkg_descr lbi suite template = + fromPathTemplate $ substPathTemplate env template + where + env = initialPathTemplateEnv + (PD.package pkg_descr) (compilerId $ LBI.compiler lbi) ++ + [(TestSuiteNameVar, toPathTemplate $ PD.testName suite)] packageLogPath :: PathTemplate -> PD.PackageDescription diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs --- a/Distribution/Simple/Utils.hs +++ b/Distribution/Simple/Utils.hs @@ -58,6 +58,7 @@ -- * running programs rawSystemExit, + rawSystemExitWithEnv, rawSystemStdout, rawSystemStdInOut, maybeExit, @@ -178,6 +179,7 @@ (Version(..)) import Control.Exception (evaluate) +import System.Process (runProcess) #ifdef __GLASGOW_HASKELL__ import Control.Concurrent (forkIO) @@ -201,8 +203,10 @@ -- We only get our own version number when we're building with ourselves cabalVersion :: Version -#ifdef VERSION_base +#if defined(VERSION_base) cabalVersion = Paths_Cabal.version +#elif defined(CABAL_VERSION) +cabalVersion = Version [CABAL_VERSION] [] #else cabalVersion = Version [1,9999] [] --used when bootstrapping #endif @@ -342,6 +346,17 @@ | verbosity >= verbose = putStrLn $ unwords (path : args) | otherwise = return () +printRawCommandAndArgsAndEnv :: Verbosity + -> FilePath + -> [String] + -> [(String, String)] + -> IO () +printRawCommandAndArgsAndEnv verbosity path args env + | verbosity >= deafening = do putStrLn ("Environment: " ++ show env) + print (path, args) + | verbosity >= verbose = putStrLn $ unwords (path : args) + | otherwise = return () + -- Exit with the same exitcode if the subcommand fails rawSystemExit :: Verbosity -> FilePath -> [String] -> IO () rawSystemExit verbosity path args = do @@ -351,6 +366,20 @@ unless (exitcode == ExitSuccess) $ do debug verbosity $ path ++ " returned " ++ show exitcode exitWith exitcode + +rawSystemExitWithEnv :: Verbosity + -> FilePath + -> [String] + -> [(String, String)] + -> IO () +rawSystemExitWithEnv verbosity path args env = do + printRawCommandAndArgsAndEnv verbosity path args env + hFlush stdout + ph <- runProcess path args Nothing (Just env) Nothing Nothing Nothing + exitcode <- waitForProcess ph + unless (exitcode == ExitSuccess) $ do + debug verbosity $ path ++ " returned " ++ show exitcode + exitWith exitcode -- | Run a command and return its output. -- diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,8 +1,59 @@ -*-change-log-*- -1.9.x (current development version) +1.11.x (current development version) -1.8.0.x (next stable release version) +1.10.0.x (next stable release version) + +1.10.1.0 Duncan Coutts February 2011 + * Improved error messages when test suites are not enabled + * Template parameters allowed in test --test-option(s) flag + * Improved documentation of the test feature + * Relaxed QA check on cabal-version when using test-suite sections + * haddock command now allows both --hoogle and --html at the same time + * Find ghc-version-specific instances of the hsc2hs program + * Preserve file executable permissions in sdist tarballs + * Pass gcc location and flags to ./configure scripts + * Get default gcc flags from ghc + +1.10.0.0 Duncan Coutts November 2010 + * New cabal test feature + * Initial support for UHC + * New default-language and other-languages fields (e.g. Haskell98/2010) + * New default-extensions and other-extensions fields + * Deprecated extensions field (for packages using cabal-version >=1.10) + * Cabal-version field must now only be of the form ">= x.y" + * Removed deprecated --copy-prefix= feature + * Auto-reconfigure when .cabal file changes + * Workaround for haddock overwriting .hi and .o files when using TH + * Extra cpp flags used with hsc2hs and c2hs (-D${os}_BUILD_OS etc) + * New cpp define VERSION_ gives string version of dependencies + * User guide source now in markdown format for easier editing + * Improved checks and error messages for C libraries and headers + * Removed BSD4 from the list of suggested licenses + * Updated list of known language extensions + * Fix for include paths to allow C code to import FFI stub.h files + * Fix for intra-package dependencies on OSX + * Stricter checks on various bits of .cabal file syntax + * Minor fixes for c2hs + +1.8.0.6 Duncan Coutts June 2010 + * Fix 'register --global/--user' + +1.8.0.4 Duncan Coutts March 2010 + * Set dylib-install-name for dynalic libs on OSX + * Stricter configure check that compiler supports a package's extensions + * More configure-time warnings + * Hugs can compile Cabal lib again + * Default datadir now follows prefix on Windows + * Support for finding installed packages for hugs + * Cabal version macros now have proper parenthesis + * Reverted change to filter out deps of non-buildable components + * Fix for registering implace when using a specific package db + * Fix mismatch between $os and $arch path template variables + * Fix for finding ar.exe on Windows, always pick ghc's version + * Fix for intra-package dependencies with ghc-6.12 + +1.8.0.2 Duncan Coutts December 2009 * Support for GHC-6.12 * New unique installed package IDs which use a package hash * Allow executables to depend on the lib within the same package