diff --git a/Cabal.cabal b/Cabal.cabal --- a/Cabal.cabal +++ b/Cabal.cabal @@ -1,5 +1,5 @@ Name: Cabal -Version: 1.6.0.1 +Version: 1.6.0.2 Copyright: 2003-2006, Isaac Jones 2005-2008, Duncan Coutts License: BSD3 @@ -55,7 +55,7 @@ Build-Depends: filepath >= 1 && < 1.2 GHC-Options: -Wall - CPP-Options: "-DCABAL_VERSION=1,6,0,1" + CPP-Options: "-DCABAL_VERSION=1,6,0,2" nhc98-Options: -K4M Exposed-Modules: @@ -106,6 +106,7 @@ Other-Modules: Distribution.GetOpt, Distribution.Compat.Exception, + Distribution.Compat.CopyFile, Distribution.Compat.Permissions, Distribution.Compat.TempFile, Distribution.Simple.GHC.Makefile, diff --git a/Distribution/Compat/CopyFile.hs b/Distribution/Compat/CopyFile.hs new file mode 100644 --- /dev/null +++ b/Distribution/Compat/CopyFile.hs @@ -0,0 +1,105 @@ +{-# OPTIONS -cpp #-} +-- OPTIONS required for ghc-6.4.x compat, and must appear first +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -cpp #-} +{-# OPTIONS_NHC98 -cpp #-} +{-# OPTIONS_JHC -fcpp #-} +-- #hide +module Distribution.Compat.CopyFile ( + copyFile, + copyOrdinaryFile, + copyExecutableFile, + setFileOrdinary, + setFileExecutable, + ) where + +#ifdef __GLASGOW_HASKELL__ + +import Control.Monad + ( when ) +import Control.Exception + ( bracket ) +import Distribution.Compat.Exception + ( catchIO, bracketOnError ) +#if __GLASGOW_HASKELL__ >= 608 +import Distribution.Compat.Exception + ( throwIOIO ) +import System.IO.Error + ( ioeSetLocation ) +#endif +import System.Directory + ( renameFile, removeFile ) +import Distribution.Compat.TempFile + ( openBinaryTempFile ) +import System.FilePath + ( takeDirectory ) +import System.IO + ( openBinaryFile, IOMode(ReadMode), hClose, hGetBuf, hPutBuf ) +import Foreign + ( allocaBytes ) +#endif /* __GLASGOW_HASKELL__ */ + +#ifndef mingw32_HOST_OS +import System.Posix.Types + ( FileMode ) +import System.Posix.Internals + ( c_chmod ) +import Foreign.C + ( withCString ) +#if __GLASGOW_HASKELL__ >= 608 +import Foreign.C + ( throwErrnoPathIfMinus1_ ) +#else +import Foreign.C + ( throwErrnoIfMinus1_ ) +#endif +#endif /* mingw32_HOST_OS */ + +copyOrdinaryFile, copyExecutableFile :: FilePath -> FilePath -> IO () +copyOrdinaryFile src dest = copyFile src dest >> setFileOrdinary dest +copyExecutableFile src dest = copyFile src dest >> setFileExecutable dest + +setFileOrdinary, setFileExecutable :: FilePath -> IO () +#if defined(__GLASGOW_HASKELL__) && !defined(mingw32_HOST_OS) +setFileOrdinary path = setFileMode path 0o644 -- file perms -rw-r--r-- +setFileExecutable path = setFileMode path 0o755 -- file perms -rwxr-xr-x + +setFileMode :: FilePath -> FileMode -> IO () +setFileMode name m = + withCString name $ \s -> do +#if __GLASGOW_HASKELL__ >= 608 + throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m) +#else + throwErrnoIfMinus1_ name (c_chmod s m) +#endif +#else +setFileOrdinary _ = return () +setFileExecutable _ = return () +#endif + +copyFile :: FilePath -> FilePath -> IO () +#ifdef __GLASGOW_HASKELL__ +copyFile fromFPath toFPath = + copy +#if __GLASGOW_HASKELL__ >= 608 + `catchIO` (\ioe -> throwIOIO (ioeSetLocation ioe "copyFile")) +#endif + where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom -> + bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) -> + do allocaBytes bufferSize $ copyContents hFrom hTmp + hClose hTmp + renameFile tmpFPath toFPath + openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp" + cleanTmp (tmpFPath, hTmp) = do + hClose hTmp `catchIO` \_ -> return () + removeFile tmpFPath `catchIO` \_ -> return () + bufferSize = 4096 + + copyContents hFrom hTo buffer = do + count <- hGetBuf hFrom buffer bufferSize + when (count > 0) $ do + hPutBuf hTo buffer count + copyContents hFrom hTo buffer +#else +copyFile fromFPath toFPath = readFile fromFPath >>= writeFile toFPath +#endif diff --git a/Distribution/Compat/Exception.hs b/Distribution/Compat/Exception.hs --- a/Distribution/Compat/Exception.hs +++ b/Distribution/Compat/Exception.hs @@ -9,9 +9,14 @@ #define NEW_EXCEPTION #endif -module Distribution.Compat.Exception - (onException, catchIO, catchExit, throwIOIO) - where +module Distribution.Compat.Exception ( + onException, catchIO, catchExit, throwIOIO, +#if __GLASGOW_HASKELL__ <= 604 + bracketOnError +#else + Exception.bracketOnError +#endif + ) where import System.Exit import qualified Control.Exception as Exception @@ -49,3 +54,10 @@ handler' e = Exception.throw e #endif +#if __GLASGOW_HASKELL__ <= 604 +bracketOnError :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c +bracketOnError before after thing = + Exception.block $ do + a <- before + Exception.unblock (thing a) `onException` after a +#endif diff --git a/Distribution/Compat/TempFile.hs b/Distribution/Compat/TempFile.hs --- a/Distribution/Compat/TempFile.hs +++ b/Distribution/Compat/TempFile.hs @@ -116,6 +116,10 @@ h <- #if __GLASGOW_HASKELL__ >= 609 fdToHandle fd +#elif __GLASGOW_HASKELL__ <= 606 && defined(mingw32_HOST_OS) + -- fdToHandle is borked on Windows with ghc-6.6.x + openFd (fromIntegral fd) Nothing False filepath + ReadWriteMode True #else fdToHandle (fromIntegral fd) #endif diff --git a/Distribution/PackageDescription/Check.hs b/Distribution/PackageDescription/Check.hs --- a/Distribution/PackageDescription/Check.hs +++ b/Distribution/PackageDescription/Check.hs @@ -285,13 +285,16 @@ , check (null (category pkg)) $ PackageDistSuspicious "No 'category' field." - , check (null (description pkg)) $ - PackageDistSuspicious "No 'description' field." - , check (null (maintainer pkg)) $ PackageDistSuspicious "No 'maintainer' field." - , check (null (synopsis pkg)) $ + , check (null (synopsis pkg) && null (description pkg)) $ + PackageDistInexcusable $ "No 'synopsis' or 'description' field." + + , check (null (description pkg) && not (null (synopsis pkg))) $ + PackageDistSuspicious "No 'description' field." + + , check (null (synopsis pkg) && not (null (description pkg))) $ PackageDistSuspicious "No 'synopsis' field." , check (length (synopsis pkg) >= 80) $ @@ -414,12 +417,16 @@ PackageDistInexcusable $ "'ghc-options: -hide-package' is never needed. Cabal hides all packages." + , checkFlags ["--make"] $ + PackageDistInexcusable $ + "'ghc-options: --make' is never needed. Cabal uses this automatically." + , checkFlags ["-main-is"] $ PackageDistSuspicious $ "'ghc-options: -main-is' is not portable." , checkFlags ["-O0", "-Onot"] $ - PackageDistInexcusable $ + PackageDistSuspicious $ "'ghc-options: -O0' is not needed. Use the --disable-optimization configure flag." , checkFlags [ "-O", "-O1"] $ @@ -448,6 +455,11 @@ PackageDistSuspicious $ "Instead of 'ghc-options: -fglasgow-exts' it is preferable to use the 'extensions' field." + , check ("-threaded" `elem` lib_ghc_options) $ + PackageDistSuspicious $ + "'ghc-options: -threaded' has no effect for libraries. It should " + ++ "only be used for executables." + , checkAlternatives "ghc-options" "extensions" [ (flag, display extension) | flag <- all_ghc_options , Just extension <- [ghcExtension flag] ] @@ -484,6 +496,7 @@ ghc_options = [ strs | bi <- allBuildInfo pkg , (GHC, strs) <- options bi ] all_ghc_options = concat ghc_options + lib_ghc_options = maybe [] (hcOptions GHC . libBuildInfo) (library pkg) checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck checkFlags flags = check (any (`elem` flags) all_ghc_options) diff --git a/Distribution/ParseUtils.hs b/Distribution/ParseUtils.hs --- a/Distribution/ParseUtils.hs +++ b/Distribution/ParseUtils.hs @@ -143,7 +143,8 @@ runE line fieldname p s = case runReadE p s of Right a -> ParseOk (utf8Warnings line fieldname s) a - Left e -> syntaxError line ("Parse of field '"++fieldname++"' failed ("++e++"): " ) + Left e -> syntaxError line $ + "Parse of field '" ++ fieldname ++ "' failed (" ++ e ++ "): " ++ s utf8Warnings :: LineNo -> String -> String -> [PWarning] utf8Warnings line fieldname s = diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs --- a/Distribution/Simple.hs +++ b/Distribution/Simple.hs @@ -99,10 +99,10 @@ removeRegScripts ) -import Distribution.Simple.Configure(getPersistBuildConfig, - maybeGetPersistBuildConfig, - checkPersistBuildConfig, - configure, writePersistBuildConfig) +import Distribution.Simple.Configure + ( getPersistBuildConfig, maybeGetPersistBuildConfig + , writePersistBuildConfig, checkPersistBuildConfig + , configure, checkForeignDeps ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) ) import Distribution.Simple.BuildPaths ( srcPref) @@ -427,6 +427,7 @@ simpleUserHooks = emptyUserHooks { confHook = configure, + postConf = finalChecks, buildHook = defaultBuildHook, makefileHook = defaultMakefileHook, copyHook = \desc lbi _ f -> install desc lbi f, -- has correct 'copy' behavior with params @@ -438,6 +439,11 @@ regHook = defaultRegHook, unregHook = \p l _ f -> unregister p l f } + where + finalChecks _args flags pkg_descr lbi = + checkForeignDeps pkg_descr lbi verbosity + where + verbosity = fromFlag (configVerbosity flags) -- | Basic autoconf 'UserHooks': -- @@ -466,13 +472,18 @@ -- This is the annoying old version that only runs configure if it exists. -- It's here for compatibility with existing Setup.hs scripts. See: -- http://hackage.haskell.org/trac/hackage/ticket/165 - where oldCompatPostConf args flags _ _ + where oldCompatPostConf args flags pkg_descr lbi = do let verbosity = fromFlag (configVerbosity flags) noExtraFlags args confExists <- doesFileExist "configure" when confExists $ rawSystemExit verbosity "sh" $ "configure" : configureArgs backwardsCompatHack flags + + pbi <- getHookedBuildInfo verbosity + let pkg_descr' = updatePackageDescription pbi pkg_descr + postConf simpleUserHooks args flags pkg_descr' lbi + backwardsCompatHack = True autoconfUserHooks :: UserHooks @@ -491,7 +502,7 @@ preUnreg = readHook regVerbosity } where defaultPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () - defaultPostConf args flags _ _ + defaultPostConf args flags pkg_descr lbi = do let verbosity = fromFlag (configVerbosity flags) noExtraFlags args confExists <- doesFileExist "configure" @@ -500,18 +511,28 @@ "configure" : configureArgs backwardsCompatHack flags else die "configure script not found." + + pbi <- getHookedBuildInfo verbosity + let pkg_descr' = updatePackageDescription pbi pkg_descr + postConf simpleUserHooks args flags pkg_descr' lbi + backwardsCompatHack = False readHook :: (a -> Flag Verbosity) -> Args -> a -> IO HookedBuildInfo readHook get_verbosity a flags = do noExtraFlags a - maybe_infoFile <- defaultHookedPackageDesc - case maybe_infoFile of - Nothing -> return emptyHookedBuildInfo - Just infoFile -> do - let verbosity = fromFlag (get_verbosity flags) - info verbosity $ "Reading parameters from " ++ infoFile - readHookedBuildInfo verbosity infoFile + getHookedBuildInfo verbosity + where + verbosity = fromFlag (get_verbosity flags) + +getHookedBuildInfo :: Verbosity -> IO HookedBuildInfo +getHookedBuildInfo verbosity = do + maybe_infoFile <- defaultHookedPackageDesc + case maybe_infoFile of + Nothing -> return emptyHookedBuildInfo + Just infoFile -> do + info verbosity $ "Reading parameters from " ++ infoFile + readHookedBuildInfo verbosity infoFile defaultInstallHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO () diff --git a/Distribution/Simple/Build/PathsModule.hs b/Distribution/Simple/Build/PathsModule.hs --- a/Distribution/Simple/Build/PathsModule.hs +++ b/Distribution/Simple/Build/PathsModule.hs @@ -21,7 +21,7 @@ import Distribution.System ( OS(Windows), buildOS ) import Distribution.Simple.Compiler - ( CompilerFlavor(..), compilerFlavor ) + ( CompilerFlavor(..), compilerFlavor, compilerVersion ) import Distribution.Package ( packageName, packageVersion ) import Distribution.PackageDescription @@ -34,6 +34,8 @@ ( autogenModuleName ) import Distribution.Text ( display ) +import Distribution.Version + ( Version(..), orLaterVersion, withinRange ) import System.FilePath ( pathSeparator ) @@ -48,8 +50,9 @@ generate pkg_descr lbi = let pragmas | absolute || isHugs = "" + | supports_language_pragma = + "{-# LANGUAGE ForeignFunctionInterface #-}\n" | otherwise = - "{-# LANGUAGE ForeignFunctionInterface #-}\n" ++ "{-# OPTIONS_GHC -fffi #-}\n"++ "{-# OPTIONS_JHC -fffi #-}\n" @@ -166,6 +169,11 @@ | otherwise = get_prefix_win32 path_sep = show [pathSeparator] + + supports_language_pragma = + compilerFlavor (compiler lbi) == GHC && + (compilerVersion (compiler lbi) + `withinRange` orLaterVersion (Version [6,6,1] [])) get_prefix_win32 :: String get_prefix_win32 = diff --git a/Distribution/Simple/Command.hs b/Distribution/Simple/Command.hs --- a/Distribution/Simple/Command.hs +++ b/Distribution/Simple/Command.hs @@ -487,8 +487,11 @@ commandNames = [ name | Command name _ _ <- commands' ] globalCommand' = globalCommand { commandUsage = \pname -> - "Usage: " ++ pname ++ " [GLOBAL FLAGS]\n" - ++ " or: " ++ pname ++ " COMMAND [FLAGS]\n\n" + (case commandUsage globalCommand pname of + "" -> "" + original -> original ++ "\n") + ++ "Usage: " ++ pname ++ " COMMAND [FLAGS]\n" + ++ " or: " ++ pname ++ " [GLOBAL FLAGS]\n\n" ++ "Global flags:", commandDescription = Just $ \pname -> "Commands:\n" diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs --- a/Distribution/Simple/Configure.hs +++ b/Distribution/Simple/Configure.hs @@ -62,6 +62,7 @@ configCompiler, configCompilerAux, ccLdOptionsBuildInfo, tryGetConfigStateFile, + checkForeignDeps, ) where @@ -73,8 +74,8 @@ , packageVersion, Package(..), Dependency(Dependency) ) import Distribution.InstalledPackageInfo ( InstalledPackageInfo, emptyInstalledPackageInfo ) -import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo - ( InstalledPackageInfo_(package,depends) ) +import qualified Distribution.InstalledPackageInfo as Installed + ( InstalledPackageInfo_(..) ) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (PackageIndex) import Distribution.PackageDescription as PD @@ -90,9 +91,9 @@ import Distribution.Simple.Program ( Program(..), ProgramLocation(..), ConfiguredProgram(..) , ProgramConfiguration, defaultProgramConfiguration - , configureAllKnownPrograms, knownPrograms + , configureAllKnownPrograms, knownPrograms, lookupKnownProgram , userSpecifyArgss, userSpecifyPaths - , lookupKnownProgram, requireProgram, pkgConfigProgram + , lookupProgram, requireProgram, pkgConfigProgram, gccProgram , rawSystemProgramStdoutConf ) import Distribution.Simple.Setup ( ConfigFlags(..), CopyDest(..), fromFlag, fromFlagOrDefault, flagToMaybe ) @@ -104,7 +105,8 @@ import Distribution.Simple.Utils ( die, warn, info, setupMessage, createDirectoryIfMissingVerbose , intercalate, comparing, cabalVersion, cabalBootstrapping - , withFileContents, writeFileAtomic ) + , withFileContents, writeFileAtomic + , withTempFile ) import Distribution.Simple.Register ( removeInstalledConfig ) import Distribution.System @@ -120,15 +122,15 @@ import qualified Distribution.Simple.Hugs as Hugs import Control.Monad - ( when, unless, foldM ) + ( when, unless, foldM, filterM ) import Data.List - ( nub, partition, isPrefixOf, maximumBy ) + ( nub, partition, isPrefixOf, maximumBy, inits ) import Data.Maybe ( fromMaybe, isNothing ) import Data.Monoid ( Monoid(..) ) import System.Directory - ( doesFileExist, getModificationTime, createDirectoryIfMissing ) + ( doesFileExist, getModificationTime, createDirectoryIfMissing, getTemporaryDirectory ) import System.Exit ( ExitCode(..), exitWith ) import System.FilePath @@ -136,7 +138,7 @@ import qualified System.Info ( compilerName, compilerVersion ) import System.IO - ( hPutStrLn, stderr ) + ( hPutStrLn, stderr, hClose ) import Distribution.Text ( Text(disp), display, simpleParse ) import Text.PrettyPrint.HughesPJ @@ -333,7 +335,7 @@ bogusDependencies = map inventBogusPackageId (buildDepends pkg_descr) bogusPackageSet = PackageIndex.fromList [ emptyInstalledPackageInfo { - InstalledPackageInfo.package = bogusPackageId + Installed.package = bogusPackageId -- note that these bogus packages have no other dependencies } | bogusPackageId <- bogusDependencies ] @@ -356,8 +358,8 @@ | (pkg, deps) <- broken ] let pseudoTopPkg = emptyInstalledPackageInfo { - InstalledPackageInfo.package = packageId pkg_descr, - InstalledPackageInfo.depends = dep_pkgs + Installed.package = packageId pkg_descr, + Installed.depends = dep_pkgs } case PackageIndex.dependencyInconsistencies . PackageIndex.insert pseudoTopPkg @@ -583,6 +585,7 @@ return exe { buildInfo = buildInfo exe `mappend` bi } pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo + pkgconfigBuildInfo [] = return mempty pkgconfigBuildInfo pkgdeps = do let pkgs = nub [ display pkg | Dependency pkg _ <- pkgdeps ] ccflags <- pkgconfig ("--cflags" : pkgs) @@ -619,8 +622,12 @@ configCompilerAux cfg = configCompiler (flagToMaybe $ configHcFlavor cfg) (flagToMaybe $ configHcPath cfg) (flagToMaybe $ configHcPkg cfg) - defaultProgramConfiguration + programsConfig (fromFlag (configVerbosity cfg)) + where + programsConfig = userSpecifyArgss (configProgramArgs cfg) + . userSpecifyPaths (configProgramPaths cfg) + $ defaultProgramConfiguration configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath -> ProgramConfiguration -> Verbosity @@ -634,6 +641,140 @@ NHC -> NHC.configure verbosity hcPath hcPkg conf _ -> die "Unknown compiler" + +checkForeignDeps :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO () +checkForeignDeps pkg lbi verbosity = do + ifBuildsWith allHeaders (commonCcArgs ++ makeLdArgs allLibs) -- I'm feeling lucky + (return ()) + (do missingLibs <- findMissingLibs + missingHdr <- findOffendingHdr + explainErrors missingHdr missingLibs) + where + allHeaders = collectField PD.includes + allLibs = collectField PD.extraLibs + + ifBuildsWith headers args success failure = do + ok <- builds (makeProgram headers) args + if ok then success else failure + + -- NOTE: if some package-local header has errors, + -- we will report that this header is missing. + -- Maybe additional tests for local headers are needed + -- for better diagnostics + findOffendingHdr = + ifBuildsWith allHeaders cppArgs + (return Nothing) + (go . tail . inits $ allHeaders) + where + go [] = return Nothing -- cannot happen + go (hdrs:hdrsInits) = do + ifBuildsWith hdrs cppArgs + (go hdrsInits) + (return . Just . last $ hdrs) + + cppArgs = "-c":commonCcArgs -- don't try to link + + findMissingLibs = ifBuildsWith [] (makeLdArgs allLibs) + (return []) + (filterM (fmap not . libExists) allLibs) + + libExists lib = builds (makeProgram []) (makeLdArgs [lib]) + + commonCcArgs = programArgs gccProg + ++ hcDefines (compiler lbi) + ++ [ "-I" ++ dir | dir <- collectField PD.includeDirs ] + ++ ["-I."] + ++ collectField PD.cppOptions + ++ collectField PD.ccOptions + ++ [ "-I" ++ dir + | dep <- deps + , dir <- Installed.includeDirs dep ] + ++ [ opt + | dep <- deps + , opt <- Installed.ccOptions dep ] + + commonLdArgs = [ "-L" ++ dir | dir <- collectField PD.extraLibDirs ] + ++ collectField PD.ldOptions + --TODO: do we also need dependent packages' ld options? + makeLdArgs libs = [ "-l"++lib | lib <- libs ] ++ commonLdArgs + + makeProgram hdrs = unlines $ + [ "#include \"" ++ hdr ++ "\"" | hdr <- hdrs ] ++ + ["int main(int argc, char** argv) { return 0; }"] + + collectField f = concatMap f allBi + allBi = allBuildInfo pkg + Just gccProg = lookupProgram gccProgram (withPrograms lbi) + deps = PackageIndex.topologicalOrder (installedPkgs lbi) + + builds program args = do + tempDir <- getTemporaryDirectory + withTempFile tempDir ".c" $ \cName cHnd -> + withTempFile tempDir "" $ \oNname oHnd -> do + hPutStrLn cHnd program + hClose cHnd + hClose oHnd + rawSystemProgramStdoutConf verbosity + gccProgram (withPrograms lbi) (cName:"-o":oNname:args) + return True + `catchIO` (\_ -> return False) + `catchExit` (\_ -> return False) + + explainErrors Nothing [] = return () + explainErrors hdr libs = die $ unlines $ + (if plural then "Missing dependencies on foreign libraries:" + else "Missing dependency on a foreign library:") + : case hdr of + Nothing -> [] + Just h -> ["* Missing header file: " ++ h ] + ++ case libs of + [] -> [] + [lib] -> ["* Missing C library: " ++ lib] + _ -> ["* Missing C libraries: " ++ intercalate ", " libs] + ++ [if plural then messagePlural else messageSingular] + where + plural = length libs >= 2 + messageSingular = + "This problem can usually be solved by installing the system " + ++ "package that provides this library (you may need the " + ++ "\"-dev\" version). If the library is already installed " + ++ "but in a non-standard location then you can use the flags " + ++ "--extra-include-dirs= and --extra-lib-dirs= to specify " + ++ "where it is." + messagePlural = + "This problem can usually be solved by installing the system " + ++ "packages that provide these libraries (you may need the " + ++ "\"-dev\" versions). If the libraries are already installed " + ++ "but in a non-standard location then you can use the flags " + ++ "--extra-include-dirs= and --extra-lib-dirs= to specify " + ++ "where they are." + + --FIXME: share this with the PreProcessor module + hcDefines :: Compiler -> [String] + hcDefines comp = + case compilerFlavor comp of + GHC -> ["-D__GLASGOW_HASKELL__=" ++ versionInt version] + JHC -> ["-D__JHC__=" ++ versionInt version] + NHC -> ["-D__NHC__=" ++ versionInt version] + Hugs -> ["-D__HUGS__"] + _ -> [] + where + version = compilerVersion comp + -- TODO: move this into the compiler abstraction + -- FIXME: this forces GHC's crazy 4.8.2 -> 408 convention on all + -- the other compilers. Check if that's really what they want. + versionInt :: Version -> String + versionInt (Version { versionBranch = [] }) = "1" + versionInt (Version { versionBranch = [n] }) = show n + versionInt (Version { versionBranch = n1:n2:_ }) + = -- 6.8.x -> 608 + -- 6.10.x -> 610 + let s1 = show n1 + s2 = show n2 + middle = case s2 of + _ : _ : _ -> "" + _ -> "0" + in s1 ++ middle ++ s2 -- | Output package check warnings and errors. Exit if any errors. checkPackageProblems :: Verbosity diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs --- a/Distribution/Simple/GHC.hs +++ b/Distribution/Simple/GHC.hs @@ -126,6 +126,8 @@ import System.IO (openFile, IOMode(WriteMode), hClose, hPutStrLn) import Distribution.Compat.Exception (catchExit, catchIO) import Distribution.Compat.Permissions (copyPermissions) +import Distribution.Compat.CopyFile + ( copyExecutableFile ) -- ----------------------------------------------------------------------------- -- Configuring @@ -154,20 +156,7 @@ ++ programPath ghcProg ++ " is version " ++ display ghcVersion ++ " " ++ programPath ghcPkgProg ++ " is version " ++ display ghcPkgVersion - languageExtensions <- - if ghcVersion >= Version [6,7] [] - then do exts <- rawSystemStdout verbosity (programPath ghcProg) - ["--supported-languages"] - -- GHC has the annoying habit of inverting some of the extensions - -- so we have to try parsing ("No" ++ ghcExtensionName) first - let readExtension str = do - ext <- simpleParse ("No" ++ str) - case ext of - UnknownExtension _ -> simpleParse str - _ -> return ext - return [ (ext, "-X" ++ display ext) - | Just ext <- map readExtension (lines exts) ] - else return oldLanguageExtensions + languageExtensions <- getLanguageExtensions verbosity ghcProg let comp = Compiler { compilerId = CompilerId GHC ghcVersion, @@ -268,6 +257,36 @@ then return ["-x"] else return [] +getLanguageExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)] +getLanguageExtensions verbosity ghcProg + | ghcVersion >= Version [6,7] [] = do + + exts <- rawSystemStdout verbosity (programPath ghcProg) + ["--supported-languages"] + -- GHC has the annoying habit of inverting some of the extensions + -- so we have to try parsing ("No" ++ ghcExtensionName) first + let readExtension str = do + ext <- simpleParse ("No" ++ str) + case ext of + UnknownExtension _ -> simpleParse str + _ -> return ext + return $ extensionHacks + ++ [ (ext, "-X" ++ display ext) + | Just ext <- map readExtension (lines exts) ] + + | otherwise = return oldLanguageExtensions + + where + Just ghcVersion = programVersion ghcProg + + -- ghc-6.8 intorduced RecordPuns however it should have been + -- NamedFieldPuns. We now encourage packages to use NamedFieldPuns so for + -- compatability we fake support for it in ghc-6.8 by making it an alias + -- for the old RecordPuns extension. + extensionHacks = [ (NamedFieldPuns, "-XRecordPuns") + | ghcVersion >= Version [6,8] [] + && ghcVersion < Version [6,10] [] ] + -- | For GHC 6.6.x and earlier, the mapping from supported extensions to flags oldLanguageExtensions :: [(Extension, Flag)] oldLanguageExtensions = @@ -447,13 +466,16 @@ ifVanillaLib forceVanilla = when (forceVanilla || withVanillaLib lbi) ifProfLib = when (withProfLib lbi) ifSharedLib = when (withSharedLib lbi) - ifGHCiLib = when (withGHCiLib lbi) + ifGHCiLib = when (withGHCiLib lbi && withVanillaLib lbi) -- Build lib withLib pkg_descr () $ \lib -> do info verbosity "Building library..." - let libBi = libBuildInfo lib - libTargetDir = pref + + libBi <- hackThreadedFlag verbosity + (compiler lbi) (withProfLib lbi) (libBuildInfo lib) + + let libTargetDir = pref forceVanillaLib = TemplateHaskell `elem` extensions libBi -- TH always needs vanilla libs, even when building for profiling @@ -602,10 +624,12 @@ ifSharedLib $ runGhcProg ghcSharedLinkArgs -- build any executables - withExe pkg_descr $ \Executable { exeName = exeName', modulePath = modPath, - buildInfo = exeBi } -> do + withExe pkg_descr $ \exe@Executable { exeName = exeName', modulePath = modPath } -> do info verbosity $ "Building executable: " ++ exeName' ++ "..." + exeBi <- hackThreadedFlag verbosity + (compiler lbi) (withProfExe lbi) (buildInfo exe) + -- exeNameReal, the name that GHC really uses (with .exe on Windows) let exeNameReal = exeName' <.> (if null $ takeExtension exeName' then exeExtension else "") @@ -636,7 +660,7 @@ ++ constructGHCCmdLine lbi exeBi exeDir verbosity ++ [exeDir x | x <- cObjs] ++ [srcMainFile] - ++ PD.ldOptions exeBi + ++ ["-optl" ++ opt | opt <- PD.ldOptions exeBi] ++ ["-l"++lib | lib <- extraLibs exeBi] ++ ["-L"++libDir | libDir <- extraLibDirs exeBi] ++ concat [["-framework", f] | f <- PD.frameworks exeBi] @@ -657,6 +681,21 @@ runGhcProg (binArgs True (withProfExe lbi)) +-- | Filter the "-threaded" flag when profiling as it does not +-- work with ghc-6.8 and older. +hackThreadedFlag :: Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfo +hackThreadedFlag verbosity comp prof bi + | not mustFilterThreaded = return bi + | otherwise = do + warn verbosity $ "The ghc flag '-threaded' is not compatible with " + ++ "profiling in ghc-6.8 and older. It will be disabled." + return bi { options = filterHcOptions (/= "-threaded") (options bi) } + where + mustFilterThreaded = prof && compilerVersion comp < Version [6, 10] [] + && "-threaded" `elem` hcOptions GHC bi + filterHcOptions p hcoptss = + [ (hc, if hc == GHC then filter p opts else opts) + | (hc, opts) <- hcoptss ] -- when using -split-objs, we need to search for object files in the -- Module_split directory for each module. @@ -897,7 +936,7 @@ exeDynFileName = e <.> "dyn" <.> exeExtension fixedExeBaseName = progprefix ++ e ++ progsuffix installBinary dest = do - copyFileVerbose verbosity + copyExe verbosity (buildPref e exeFileName) (dest <.> exeExtension) exists <- doesFileExist (buildPref e exeDynFileName) if exists then @@ -934,6 +973,11 @@ else do installBinary (binDir fixedExeBaseName) +copyExe :: Verbosity -> FilePath -> FilePath -> IO () +copyExe verbosity src dest = do + info verbosity ("copy " ++ src ++ " to " ++ dest) + copyExecutableFile src dest + stripExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> IO () stripExe verbosity lbi name path = when (stripExes lbi) $ case lookupProgram stripProgram (withPrograms lbi) of @@ -963,7 +1007,9 @@ unless (fromFlag $ copyInPlace flags) $ do -- copy .hi files over: let verbosity = fromFlag (copyVerbosity flags) - copy src dst n = copyFileVerbose verbosity (src n) (dst n) + copy src dst n = do + createDirectoryIfMissingVerbose verbosity True dst + copyFileVerbose verbosity (src n) (dst n) copyModuleFiles ext = smartCopySources verbosity [builtDir] targetDir (libModules pkg) [ext] diff --git a/Distribution/Simple/Haddock.hs b/Distribution/Simple/Haddock.hs --- a/Distribution/Simple/Haddock.hs +++ b/Distribution/Simple/Haddock.hs @@ -94,8 +94,9 @@ import Language.Haskell.Extension -- Base import System.Directory(removeFile, doesFileExist, - removeDirectoryRecursive, copyFile) - + removeDirectoryRecursive) +import Distribution.Compat.CopyFile + ( copyFile ) import Control.Monad ( when, unless ) import Data.Maybe ( isJust, fromJust, listToMaybe ) import Data.Char (isSpace) @@ -115,8 +116,7 @@ && not (fromFlag $ haddockExecutables haddockFlags) = warn (fromFlag $ haddockVerbosity haddockFlags) $ "No documentation was generated as this package does not contain " - ++ "a library. Perhaps you want to use the haddock command with the " - ++ "--executables." + ++ "a library. Perhaps you want to use the --executables flag." haddock pkg_descr lbi suffixes flags = do let distPref = fromFlag (haddockDistPref flags) @@ -135,7 +135,7 @@ createDirectoryIfMissingVerbose verbosity True tmpDir createDirectoryIfMissingVerbose verbosity True $ haddockPref distPref pkg_descr - preprocessSources pkg_descr lbi False verbosity suffixes + initialBuildSteps distPref pkg_descr lbi verbosity suffixes setupMessage verbosity "Running Haddock for" (packageId pkg_descr) @@ -196,9 +196,6 @@ then ("-B" ++ ghcLibDir) : map ("--optghc=" ++) (ghcSimpleOptions lbi bi preprocessDir) else [] - when isVersion2 $ - initialBuildSteps distPref pkg_descr lbi verbosity suffixes - withLib pkg_descr () $ \lib -> do let bi = libBuildInfo lib modules = PD.exposedModules lib ++ otherModules bi @@ -419,7 +416,7 @@ getLibSourceFiles :: LocalBuildInfo -> Library -> IO [FilePath] getLibSourceFiles lbi lib = sequence - [ findFileWithExtension ["hs", "lhs"] (preprocessDir : hsSourceDirs bi) + [ findFileWithExtension ["hs", "lhs"] (autogenModulesDir lbi: preprocessDir : hsSourceDirs bi) (ModuleName.toFilePath module_) >>= maybe (notFound module_) (return . normalise) | module_ <- modules ] where @@ -432,7 +429,7 @@ getExeSourceFiles lbi exe = do srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) moduleFiles <- sequence - [ findFileWithExtension ["hs", "lhs"] (preprocessDir : hsSourceDirs bi) + [ findFileWithExtension ["hs", "lhs"] (autogenModulesDir lbi : preprocessDir : hsSourceDirs bi) (ModuleName.toFilePath module_) >>= maybe (notFound module_) (return . normalise) | module_ <- modules ] return (srcMainPath : moduleFiles) diff --git a/Distribution/Simple/Install.hs b/Distribution/Simple/Install.hs --- a/Distribution/Simple/Install.hs +++ b/Distribution/Simple/Install.hs @@ -173,21 +173,25 @@ -- register step should be performed by caller. -- | Install the files listed in install-includes +-- installIncludeFiles :: Verbosity -> PackageDescription -> FilePath -> IO () -installIncludeFiles verbosity PackageDescription{library=Just l} incdir - = do - incs <- mapM (findInc relincdirs) (installIncludes lbi) - unless (null incs) $ do - createDirectoryIfMissingVerbose verbosity True incdir - sequence_ [ copyFileVerbose verbosity path (incdir f) - | (f,path) <- incs ] +installIncludeFiles verbosity + PackageDescription { library = Just lib } destIncludeDir = do + + incs <- mapM (findInc relincdirs) (installIncludes lbi) + sequence_ + [ do createDirectoryIfMissingVerbose verbosity True destDir + copyFileVerbose verbosity srcFile destFile + | (relFile, srcFile) <- incs + , let destFile = destIncludeDir relFile + destDir = takeDirectory destFile ] where relincdirs = "." : filter (not.isAbsolute) (includeDirs lbi) - lbi = libBuildInfo l + lbi = libBuildInfo lib - findInc [] f = die ("can't find include file " ++ f) - findInc (d:ds) f = do - let path = (d f) - b <- doesFileExist path - if b then return (f,path) else findInc ds f + findInc [] file = die ("can't find include file " ++ file) + findInc (dir:dirs) file = do + let path = dir file + exists <- doesFileExist path + if exists then return (file, path) else findInc dirs file installIncludeFiles _ _ _ = die "installIncludeFiles: Can't happen?" diff --git a/Distribution/Simple/InstallDirs.hs b/Distribution/Simple/InstallDirs.hs --- a/Distribution/Simple/InstallDirs.hs +++ b/Distribution/Simple/InstallDirs.hs @@ -283,7 +283,7 @@ datadir = subst datadir prefixBinLibVars, datasubdir = subst datasubdir [], docdir = subst docdir prefixBinLibDataVars, - mandir = subst docdir (prefixBinLibDataVars ++ [docdirVar]), + mandir = subst mandir (prefixBinLibDataVars ++ [docdirVar]), htmldir = subst htmldir (prefixBinLibDataVars ++ [docdirVar]), haddockdir = subst haddockdir (prefixBinLibDataVars ++ [docdirVar, htmldirVar]) diff --git a/Distribution/Simple/Setup.hs b/Distribution/Simple/Setup.hs --- a/Distribution/Simple/Setup.hs +++ b/Distribution/Simple/Setup.hs @@ -205,19 +205,20 @@ } globalCommand :: CommandUI GlobalFlags -globalCommand = makeCommand name shortDesc longDesc defaultGlobalFlags options - where - name = "" - shortDesc = "" - longDesc = Just $ \pname -> - "Typical steps for installing Cabal packages:\n" - ++ unlines [ " " ++ pname ++ " " ++ x - | x <- ["configure", "build", "install"]] - ++ "\nFor more information about a command, try '" - ++ pname ++ " COMMAND --help'." - ++ "\nThis Setup program uses the Haskell Cabal Infrastructure." - ++ "\nSee http://www.haskell.org/cabal/ for more information.\n" - options _ = +globalCommand = CommandUI { + commandName = "", + commandSynopsis = "", + commandUsage = \_ -> + "This Setup program uses the Haskell Cabal Infrastructure.\n" + ++ "See http://www.haskell.org/cabal/ for more information.\n", + commandDescription = Just $ \pname -> + "For more information about a command use\n" + ++ " " ++ pname ++ " COMMAND --help\n\n" + ++ "Typical steps for installing Cabal packages:\n" + ++ concat [ " " ++ pname ++ " " ++ x ++ "\n" + | x <- ["configure", "build", "install"]], + commandDefaultFlags = defaultGlobalFlags, + commandOptions = \_ -> [option ['V'] ["version"] "Print version information" globalVersion (\v flags -> flags { globalVersion = v }) @@ -227,6 +228,7 @@ globalNumericVersion (\v flags -> flags { globalNumericVersion = v }) trueArg ] + } emptyGlobalFlags :: GlobalFlags emptyGlobalFlags = mempty diff --git a/Distribution/Simple/SrcDist.hs b/Distribution/Simple/SrcDist.hs --- a/Distribution/Simple/SrcDist.hs +++ b/Distribution/Simple/SrcDist.hs @@ -78,10 +78,10 @@ ( Version(versionBranch), VersionRange(AnyVersion) ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File - , copyFiles, copyFileVerbose + , copyFiles , findFile, findFileWithExtension, matchFileGlob , withTempDirectory, defaultPackageDesc - , die, warn, notice, setupMessage ) + , die, warn, notice, setupMessage, info ) import Distribution.Simple.Setup (SDistFlags(..), fromFlag) import Distribution.Simple.PreProcess (PPSuffixHandler, ppSuffixes, preprocessSources) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) ) @@ -96,7 +96,7 @@ import Data.List (partition, isPrefixOf) import Data.Maybe (isNothing, catMaybes) import System.Time (getClockTime, toCalendarTime, CalendarTime(..)) -import System.Directory (doesFileExist, doesDirectoryExist) +import System.Directory (doesFileExist, doesDirectoryExist, copyFile) import Distribution.Verbosity (Verbosity) import System.FilePath ( (), (<.>), takeDirectory, dropExtension, isAbsolute ) @@ -341,6 +341,14 @@ let targetFile = dir file createDirectoryIfMissingVerbose verbosity True (takeDirectory targetFile) copyFileVerbose verbosity file targetFile + +copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO () +copyFileVerbose verbosity src dest = do + info verbosity ("copy " ++ src ++ " to " ++ dest) + --Note: This is the standard copyFile that *does* copy file permissions. + -- In particular it will copy executable permissions which we need + -- eg to copy ./configure scripts into the tarball src tree. + copyFile src dest printPackageProblems :: Verbosity -> PackageDescription -> IO () printPackageProblems verbosity pkg_descr = do diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs --- a/Distribution/Simple/Utils.hs +++ b/Distribution/Simple/Utils.hs @@ -127,7 +127,8 @@ ( Bits((.|.), (.&.), shiftL, shiftR) ) import System.Directory - ( getDirectoryContents, doesDirectoryExist, doesFileExist, removeFile ) + ( getDirectoryContents, doesDirectoryExist, doesFileExist, removeFile + , copyFile ) import System.Environment ( getProgName ) import System.Cmd @@ -138,7 +139,7 @@ ( normalise, (), (<.>), takeDirectory, splitFileName , splitExtension, splitExtensions ) import System.Directory - ( copyFile, createDirectoryIfMissing, renameFile, removeDirectoryRecursive ) + ( createDirectoryIfMissing, renameFile, removeDirectoryRecursive ) import System.IO ( Handle, openFile, openBinaryFile, IOMode(ReadMode), hSetBinaryMode , hGetContents, stderr, stdout, hPutStr, hFlush, hClose ) @@ -165,6 +166,8 @@ import System.Directory (getTemporaryDirectory) #endif +import Distribution.Compat.CopyFile + ( copyOrdinaryFile ) import Distribution.Compat.TempFile (openTempFile, openNewBinaryFile) import Distribution.Compat.Exception (catchIO, onException) @@ -452,7 +455,7 @@ matchDirFileGlob :: FilePath -> FilePath -> IO [FilePath] matchDirFileGlob dir filepath = case parseFileGlob filepath of - Nothing -> die $ "invalid filepath '" ++ filepath + Nothing -> die $ "invalid file glob '" ++ filepath ++ "'. Wildcards '*' are only allowed in place of the file" ++ " name, not in the directory name or file extension." ++ " If a wildcard is used it must be with an file extension." @@ -496,7 +499,7 @@ copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO () copyFileVerbose verbosity src dest = do info verbosity ("copy " ++ src ++ " to " ++ dest) - copyFile src dest + copyOrdinaryFile src dest -- | Copies a bunch of files to a target directory, preserving the directory -- structure in the target location. The target directories are created if they @@ -529,7 +532,8 @@ -- Copy all the files sequence_ [ let src = srcBase srcFile dest = targetDir srcFile - in copyFileVerbose verbosity src dest + in info verbosity ("copy " ++ src ++ " to " ++ dest) + >> copyFile src dest | (srcBase, srcFile) <- srcFiles ] -- adaptation of removeDirectoryRecursive diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2003-2007, Isaac Jones, Simon Marlow, Martin Sjögren, +Copyright (c) 2003-2008, Isaac Jones, Simon Marlow, Martin Sjögren, Bjorn Bringert, Krasimir Angelov, Malcolm Wallace, Ross Patterson, Ian Lynagh, Duncan Coutts, Thomas Schilling diff --git a/Language/Haskell/Extension.hs b/Language/Haskell/Extension.hs --- a/Language/Haskell/Extension.hs +++ b/Language/Haskell/Extension.hs @@ -60,8 +60,8 @@ -- -- * also to the 'knownExtensions' list below. -- --- * If the first character of the new extension is outside the range 'A' - 'U' --- (ie 'V'-'Z' or any non-uppercase-alphabetical char) then update the bounds +-- * If the first character of the new extension is outside the range 'A' - 'V' +-- (ie 'W'-'Z' or any non-uppercase-alphabetical char) then update the bounds -- of the 'extensionTable' below. -- |This represents language extensions beyond Haskell 98 that are @@ -130,6 +130,13 @@ -- > import "network" Network.Socket | PackageImports + | ImpredicativeTypes + | NewQualifiedOperators + | PostfixOperators + | QuasiQuotes + | TransformListComp + | ViewPatterns + | UnknownExtension String deriving (Show, Read, Eq) @@ -191,6 +198,12 @@ , DeriveDataTypeable , ConstrainedClassMethods , PackageImports + , ImpredicativeTypes + , NewQualifiedOperators + , PostfixOperators + , QuasiQuotes + , TransformListComp + , ViewPatterns ] instance Text Extension where @@ -220,7 +233,7 @@ extensionTable :: Array Char [(String, Extension)] extensionTable = - accumArray (flip (:)) [] ('A', 'U') + accumArray (flip (:)) [] ('A', 'V') [ (head str, (str, extension)) | extension <- knownExtensions , let str = show extension ] diff --git a/README b/README --- a/README +++ b/README @@ -77,11 +77,11 @@ Unpack Cabal and filepath into separate directories. For example: tar -xzf filepath-1.1.0.0.tar.gz - tar -xzf Cabal-1.6.0.0.tar.gz + tar -xzf Cabal-1.6.0.2.tar.gz # rename to make the following instructions simpler: mv filepath-1.1.0.0/ filepath/ - mv Cabal-1.6.0.0/ Cabal/ + mv Cabal-1.6.0.2/ Cabal/ cd Cabal ghc -i../filepath -cpp --make Setup.hs -o ../filepath/setup diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,5 +1,22 @@ -*-change-log-*- +1.6.0.2 Duncan Coutts February 2009 + * New configure-time check for C headers and libraries + * Added language extensions present in ghc-6.10 + * Added support for NamedFieldPuns extension in ghc-6.8 + * Fix in configure step for ghc-6.6 on Windows + * Fix warnings in Path_pkgname.hs module on Windows + * Fix for exotic flags in ld-options field + * Fix for using pkg-config in a package with a lib and an executable + * Fix for building haddock docs for exes that use the Paths module + * Fix for installing header files in subdirectories + * Fix for the case of building profiling libs but not ordinary libs + * Fix read-only attribute of installed files on Windows + * Ignore ghc -threaded flag when profiling in ghc-6.8 and older + +1.6.0.1 Duncan Coutts October 2008 + * Export a compat function to help alex and happy + 1.6.0.0 Duncan Coutts October 2008 * Support for ghc-6.10 * Source control repositories can now be specified in .cabal files