From 435fd96e264503d05656a470f49a5dd16d00b920 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 29 Apr 2017 22:47:08 +0800 Subject: [PATCH 01/10] =?UTF-8?q?Add=20`doctest=E2=80=99=20command.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This adds the `doctest` command to cabal. It does however not yet work as the driver is baiscally a stub. This is therfore only the first step towards #2327. --- Cabal/Cabal.cabal | 1 + Cabal/Distribution/Simple.hs | 18 ++++++ Cabal/Distribution/Simple/Doctest.hs | 55 +++++++++++++++++++ Cabal/Distribution/Simple/Program.hs | 1 + Cabal/Distribution/Simple/Program/Builtin.hs | 12 ++++ Cabal/Distribution/Simple/Setup.hs | 58 ++++++++++++++++++++ Cabal/Distribution/Simple/UserHooks.hs | 10 ++++ cabal-install/Distribution/Client/Setup.hs | 2 + cabal-install/main/Main.hs | 10 ++++ 9 files changed, 167 insertions(+) create mode 100644 Cabal/Distribution/Simple/Doctest.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 702facc32f7..faf042e7078 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -170,6 +170,7 @@ library Distribution.Simple.GHC Distribution.Simple.GHCJS Distribution.Simple.Haddock + Distribution.Simple.Doctest Distribution.Simple.HaskellSuite Distribution.Simple.Hpc Distribution.Simple.Install diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index cf33a6617d0..98be83ce551 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -85,6 +85,7 @@ import Distribution.Simple.BuildPaths import Distribution.Simple.Test import Distribution.Simple.Install import Distribution.Simple.Haddock +import Distribution.Simple.Doctest import Distribution.Simple.Utils import Distribution.Utils.NubList import Distribution.Verbosity @@ -175,6 +176,7 @@ defaultMainHelper hooks args = topHandler $ ,replCommand progs `commandAddAction` replAction hooks ,installCommand `commandAddAction` installAction hooks ,copyCommand `commandAddAction` copyAction hooks + ,doctestCommand `commandAddAction` doctestAcion hooks ,haddockCommand `commandAddAction` haddockAction hooks ,cleanCommand `commandAddAction` cleanAction hooks ,sdistCommand `commandAddAction` sdistAction hooks @@ -290,6 +292,21 @@ hscolourAction hooks flags args = do (getBuildConfig hooks verbosity distPref) hooks flags' args +doctestAcion :: UserHooks -> DoctestFlags -> Args -> IO () +doctestAcion hooks flags args = do + distPref <- findDistPrefOrDefault (doctestDistPref flags) + let verbosity = fromFlag $ doctestVerbosity flags + + lbi <- getBuildConfig hooks verbosity distPref + progs <- reconfigurePrograms verbosity + (doctestProgramPaths flags) + (doctestProgramArgs flags) + (withPrograms lbi) + + hookedAction preDoctest doctestHook postDoctest + (return lbi { withPrograms = progs }) + hooks flags args + haddockAction :: UserHooks -> HaddockFlags -> Args -> IO () haddockAction hooks flags args = do distPref <- findDistPrefOrDefault (haddockDistPref flags) @@ -562,6 +579,7 @@ simpleUserHooks = cleanHook = \p _ _ f -> clean p f, hscolourHook = \p l h f -> hscolour p l (allSuffixHandlers h) f, haddockHook = \p l h f -> haddock p l (allSuffixHandlers h) f, + doctestHook = \p l h f -> doctest p l (allSuffixHandlers h) f, regHook = defaultRegHook, unregHook = \p l _ f -> unregister p l f } diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs new file mode 100644 index 00000000000..d4bf5935663 --- /dev/null +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RankNTypes #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Haddock +-- Copyright : Isaac Jones 2003-2005 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- This module deals with the @doctest@ command. + +module Distribution.Simple.Doctest ( + doctest + ) where + +import Prelude () +import Distribution.Compat.Prelude + + +-- local +import Distribution.PackageDescription as PD hiding (Flag) +import Distribution.Simple.PreProcess +import Distribution.Simple.Setup +import Distribution.Simple.Build +import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate) + +import Distribution.Compat.Semigroup (Any (..)) + +-- ----------------------------------------------------------------------------- +-- Types + +-- | A record that represents the arguments to the doctest executable. +data DoctestArgs = DoctestArgs { + argHelp :: Any, + argVersion :: Any, + argNoMagic :: Any +} deriving Generic + +-- ----------------------------------------------------------------------------- +-- Doctest support + +doctest :: PackageDescription + -> LocalBuildInfo + -> [PPSuffixHandler] + -> DoctestFlags + -> IO () +doctest pkg_descr lbi suffixes doctestFlags = do + let verbosity = flag doctestVerbosity + flag f = fromFlag $ f doctestFlags + + withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do + componentInitialBuildSteps (flag doctestDistPref) pkg_descr lbi clbi verbosity + preprocessComponent pkg_descr component lbi clbi False verbosity suffixes diff --git a/Cabal/Distribution/Simple/Program.hs b/Cabal/Distribution/Simple/Program.hs index ce10570e130..57bd64e169d 100644 --- a/Cabal/Distribution/Simple/Program.hs +++ b/Cabal/Distribution/Simple/Program.hs @@ -112,6 +112,7 @@ module Distribution.Simple.Program ( , c2hsProgram , cpphsProgram , hscolourProgram + , doctestProgram , haddockProgram , greencardProgram , ldProgram diff --git a/Cabal/Distribution/Simple/Program/Builtin.hs b/Cabal/Distribution/Simple/Program/Builtin.hs index 4b52c53b5b1..4bd79013a3e 100644 --- a/Cabal/Distribution/Simple/Program/Builtin.hs +++ b/Cabal/Distribution/Simple/Program/Builtin.hs @@ -37,6 +37,7 @@ module Distribution.Simple.Program.Builtin ( c2hsProgram, cpphsProgram, hscolourProgram, + doctestProgram, haddockProgram, greencardProgram, ldProgram, @@ -85,6 +86,7 @@ builtinPrograms = , hpcProgram -- preprocessors , hscolourProgram + , doctestProgram , haddockProgram , happyProgram , alexProgram @@ -309,6 +311,16 @@ hscolourProgram = (simpleProgram "hscolour") { _ -> "" } +doctestProgram :: Program +doctestProgram = (simpleProgram "doctest") { + programFindLocation = \v p -> findProgramOnSearchPath v p "doctest" + , programFindVersion = findProgramVersion "--version" $ \str -> + -- "doctest version 0.11.2" + case words str of + (_:_:ver:_) -> ver + _ -> "" + } + haddockProgram :: Program haddockProgram = (simpleProgram "haddock") { programFindVersion = findProgramVersion "--version" $ \str -> diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 60f104eb0cb..e52211d21c2 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -42,6 +42,7 @@ module Distribution.Simple.Setup ( configAbsolutePaths, readPackageDbList, showPackageDbList, CopyFlags(..), emptyCopyFlags, defaultCopyFlags, copyCommand, InstallFlags(..), emptyInstallFlags, defaultInstallFlags, installCommand, + DoctestFlags(..), emptyDoctestFlags, defaultDoctestFlags, doctestCommand, HaddockTarget(..), HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand, HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand, @@ -1387,6 +1388,63 @@ hscolourCommand = CommandUI ] } +-- ------------------------------------------------------------ +-- * Doctest flags +-- ------------------------------------------------------------ + +data DoctestFlags = DoctestFlags { + doctestProgramPaths :: [(String, FilePath)], + doctestProgramArgs :: [(String, [String])], + doctestDistPref :: Flag FilePath, + doctestVerbosity :: Flag Verbosity + } + deriving (Show, Generic) + +defaultDoctestFlags :: DoctestFlags +defaultDoctestFlags = DoctestFlags { + doctestProgramPaths = mempty, + doctestProgramArgs = [], + doctestDistPref = NoFlag, + doctestVerbosity = Flag normal + } + +doctestCommand :: CommandUI DoctestFlags +doctestCommand = CommandUI + { commandName = "doctest" + , commandSynopsis = "Run doctest tests." + , commandDescription = Just $ \_ -> + "Requires the program doctest, version 0.12.\n" + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " doctest [FLAGS]\n" + , commandDefaultFlags = defaultDoctestFlags + , commandOptions = \showOrParseArgs -> + doctestOptions showOrParseArgs + ++ programDbPaths progDb ParseArgs + doctestProgramPaths (\v flags -> flags { doctestProgramPaths = v }) + ++ programDbOption progDb showOrParseArgs + doctestProgramArgs (\v fs -> fs { doctestProgramArgs = v }) + ++ programDbOptions progDb ParseArgs + doctestProgramArgs (\v flags -> flags { doctestProgramArgs = v }) + } + where + progDb = addKnownProgram doctestProgram + $ addKnownProgram ghcProgram + $ emptyProgramDb + +doctestOptions :: ShowOrParseArgs -> [OptionField DoctestFlags] +doctestOptions showOrParseArgs = [] + +emptyDoctestFlags :: DoctestFlags +emptyDoctestFlags = mempty + +instance Monoid DoctestFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup DoctestFlags where + (<>) = gmappend + -- ------------------------------------------------------------ -- * Haddock flags -- ------------------------------------------------------------ diff --git a/Cabal/Distribution/Simple/UserHooks.hs b/Cabal/Distribution/Simple/UserHooks.hs index 28457b66be9..31e9cd66aea 100644 --- a/Cabal/Distribution/Simple/UserHooks.hs +++ b/Cabal/Distribution/Simple/UserHooks.hs @@ -135,6 +135,13 @@ data UserHooks = UserHooks { -- |Hook to run after hscolour command. Second arg indicates verbosity level. postHscolour :: Args -> HscolourFlags -> PackageDescription -> LocalBuildInfo -> IO (), + -- |Hook to run before doctest command. Second arg indicates verbosity level. + preDoctest :: Args -> DoctestFlags -> IO HookedBuildInfo, + -- |Over-ride this hook to get different behavior during doctest. + doctestHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> DoctestFlags -> IO (), + -- |Hook to run after doctest command. Second arg indicates verbosity level. + postDoctest :: Args -> DoctestFlags -> PackageDescription -> LocalBuildInfo -> IO (), + -- |Hook to run before haddock command. Second arg indicates verbosity level. preHaddock :: Args -> HaddockFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during haddock. @@ -197,6 +204,9 @@ emptyUserHooks preHscolour = rn, hscolourHook = ru, postHscolour = ru, + preDoctest = rn, + doctestHook = ru, + postDoctest = ru, preHaddock = rn, haddockHook = ru, postHaddock = ru, diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index edaffc8bc5e..ed08589c668 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -172,6 +172,7 @@ globalCommand commands = CommandUI { , "freeze" , "gen-bounds" , "outdated" + , "doctest" , "haddock" , "hscolour" , "copy" @@ -232,6 +233,7 @@ globalCommand commands = CommandUI { , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" + , addCmd "doctest" , addCmd "haddock" , addCmd "hscolour" , addCmd "copy" diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 2e8ad60d539..a4a9465df57 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -50,6 +50,7 @@ import Distribution.Client.Setup ) import Distribution.Simple.Setup ( HaddockTarget(..) + , DoctestFlags(..), doctestCommand, defaultDoctestFlags , HaddockFlags(..), haddockCommand, defaultHaddockFlags , HscolourFlags(..), hscolourCommand , ReplFlags(..) @@ -270,6 +271,7 @@ mainWorker args = topHandler $ , regularCmd buildCommand buildAction , regularCmd replCommand replAction , regularCmd sandboxCommand sandboxAction + , regularCmd doctestCommand doctestAcion , regularCmd haddockCommand haddockAction , regularCmd execCommand execAction , regularCmd userConfigCommand userConfigAction @@ -761,6 +763,14 @@ haddockAction haddockFlags extraArgs globalFlags = do createTarGzFile dest docDir name notice verbosity $ "Documentation tarball created: " ++ dest +doctestAcion :: DoctestFlags -> [String] -> Action +doctestAcion doctestFlags extraArgs globalFlags = do + let verbosity = fromFlag (doctestVerbosity doctestFlags) + (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + + setupWrapper verbosity defaultSetupScriptOptions Nothing + doctestCommand (const doctestFlags) extraArgs + cleanAction :: CleanFlags -> [String] -> Action cleanAction cleanFlags extraArgs globalFlags = do load <- try (loadConfigOrSandboxConfig verbosity globalFlags) From b31d20bb440e784f9a29d8aad003681528d00edf Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 30 Apr 2017 18:31:47 +0800 Subject: [PATCH 02/10] Adds doctest execution logic This is a rather rough cut. But it allows to run `cabal doctest` already. --- Cabal/Distribution/Simple/Doctest.hs | 113 ++++++++++++++++++++- Cabal/Distribution/Simple/Program/Types.hs | 2 + Cabal/Distribution/Simple/Setup.hs | 8 +- 3 files changed, 117 insertions(+), 6 deletions(-) diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs index d4bf5935663..8de1f52303c 100644 --- a/Cabal/Distribution/Simple/Doctest.hs +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -20,23 +20,33 @@ import Distribution.Compat.Prelude -- local +import Distribution.Backpack.DescribeUnitId (setupMessage') +import Distribution.Types.UnqualComponentName +import Distribution.Types.ComponentLocalBuildInfo +import Distribution.Package +import qualified Distribution.ModuleName as ModuleName import Distribution.PackageDescription as PD hiding (Flag) +import Distribution.Simple.Program import Distribution.Simple.PreProcess import Distribution.Simple.Setup import Distribution.Simple.Build import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate) +import Distribution.Simple.BuildPaths +import Distribution.Simple.Utils +import Distribution.Text +import Distribution.Version +import Distribution.Verbosity -import Distribution.Compat.Semigroup (Any (..)) +import System.FilePath ( (), normalise ) -- ----------------------------------------------------------------------------- -- Types -- | A record that represents the arguments to the doctest executable. data DoctestArgs = DoctestArgs { - argHelp :: Any, - argVersion :: Any, - argNoMagic :: Any -} deriving Generic + argTargets :: [FilePath] + -- ^ Modules to process +} deriving (Show, Generic) -- ----------------------------------------------------------------------------- -- Doctest support @@ -49,7 +59,100 @@ doctest :: PackageDescription doctest pkg_descr lbi suffixes doctestFlags = do let verbosity = flag doctestVerbosity flag f = fromFlag $ f doctestFlags + (doctestProg, version, _) <- + requireProgramVersion verbosity doctestProgram + (orLaterVersion (mkVersion [0,11])) (withPrograms lbi) withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do componentInitialBuildSteps (flag doctestDistPref) pkg_descr lbi clbi verbosity preprocessComponent pkg_descr component lbi clbi False verbosity suffixes + let + smsg :: IO () + smsg = setupMessage' verbosity "Running Doctest on" (packageId pkg_descr) + (componentLocalName clbi) (maybeComponentInstantiatedWith clbi) + + case component of + CLib lib -> do + args <- DoctestArgs . map snd <$> getLibSourceFiles verbosity lbi lib clbi + runDoctest verbosity doctestProg args + CExe exe -> do + args <- DoctestArgs . map snd <$> getExeSourceFiles verbosity lbi exe clbi + runDoctest verbosity doctestProg args + CFLib _ -> return () -- do not doctest foreign libs + CTest _ -> return () -- do not doctest tests + CBench _ -> return () -- do not doctest benchmarks + +-- ----------------------------------------------------------------------------- +-- Call doctest with the specified arguments. +runDoctest :: Verbosity + -> ConfiguredProgram + -> DoctestArgs + -> IO () +runDoctest verbosity doctestProg args = do + renderArgs verbosity args $ + \(flags, files) -> do + runProgram verbosity doctestProg (flags <> files) + +renderArgs :: Verbosity + -> DoctestArgs + -> (([String],[FilePath]) -> IO a) + -> IO a +renderArgs verbosity args k = do + -- inject the "--no-magic" flag, to have a rather bare + -- doctest invocation, and disable doctests automagic discovery heuristics. + k (["--no-magic"], argTargets args) + +-- ----------------------------------------------------------------------------- +-- TODO: move somewhere else (this is copied from Haddock.hs!) +getLibSourceFiles :: Verbosity + -> LocalBuildInfo + -> Library + -> ComponentLocalBuildInfo + -> IO [(ModuleName.ModuleName, FilePath)] +getLibSourceFiles verbosity lbi lib clbi = getSourceFiles verbosity searchpaths modules + where + bi = libBuildInfo lib + modules = allLibModules lib clbi + searchpaths = componentBuildDir lbi clbi : hsSourceDirs bi ++ + [ autogenComponentModulesDir lbi clbi + , autogenPackageModulesDir lbi ] + +getExeSourceFiles :: Verbosity + -> LocalBuildInfo + -> Executable + -> ComponentLocalBuildInfo + -> IO [(ModuleName.ModuleName, FilePath)] +getExeSourceFiles verbosity lbi exe clbi = do + moduleFiles <- getSourceFiles verbosity searchpaths modules + srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) + return ((ModuleName.main, srcMainPath) : moduleFiles) + where + bi = buildInfo exe + modules = otherModules bi + searchpaths = autogenComponentModulesDir lbi clbi + : autogenPackageModulesDir lbi + : exeBuildDir lbi exe : hsSourceDirs bi + +getSourceFiles :: Verbosity -> [FilePath] + -> [ModuleName.ModuleName] + -> IO [(ModuleName.ModuleName, FilePath)] +getSourceFiles verbosity dirs modules = flip traverse modules $ \m -> fmap ((,) m) $ + findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m) + >>= maybe (notFound m) (return . normalise) + where + notFound module_ = die' verbosity $ "doctest: can't find source for module " ++ display module_ + +-- | The directory where we put build results for an executable +exeBuildDir :: LocalBuildInfo -> Executable -> FilePath +exeBuildDir lbi exe = buildDir lbi nm nm ++ "-tmp" + where + nm = unUnqualComponentName $ exeName exe + +-- ------------------------------------------------------------------------------ +-- Boilerplate Monoid instance. +instance Monoid DoctestArgs where + mempty = gmempty + mappend = (<>) + +instance Semigroup DoctestArgs where + (<>) = gmappend diff --git a/Cabal/Distribution/Simple/Program/Types.hs b/Cabal/Distribution/Simple/Program/Types.hs index b4249a2482c..6eb0695017b 100644 --- a/Cabal/Distribution/Simple/Program/Types.hs +++ b/Cabal/Distribution/Simple/Program/Types.hs @@ -76,6 +76,8 @@ data Program = Program { -- it could add args, or environment vars. programPostConf :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram } +instance Show Program where + show (Program name _ _ _) = "Program: " ++ name type ProgArg = String diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index e52211d21c2..9c18112e51e 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -1433,7 +1433,13 @@ doctestCommand = CommandUI $ emptyProgramDb doctestOptions :: ShowOrParseArgs -> [OptionField DoctestFlags] -doctestOptions showOrParseArgs = [] +doctestOptions showOrParseArgs = + [optionVerbosity doctestVerbosity + (\v flags -> flags { doctestVerbosity = v }) + ,optionDistPref + doctestDistPref (\d flags -> flags { doctestDistPref = d }) + showOrParseArgs + ] emptyDoctestFlags :: DoctestFlags emptyDoctestFlags = mempty From d34af518bb1b525daac1fe74aa0c0757992e40fc Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 30 Apr 2017 22:30:00 +0800 Subject: [PATCH 03/10] Happy CI; Added comment. This hopefully makes the CI happy. Also added the comment regarding the need to have doctest and haddock be built against the same ghc. --- Cabal/Distribution/Simple/Doctest.hs | 16 ++++++++-------- Cabal/Distribution/Simple/Program/Builtin.hs | 2 ++ 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs index 8de1f52303c..940c7f55362 100644 --- a/Cabal/Distribution/Simple/Doctest.hs +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -20,10 +20,10 @@ import Distribution.Compat.Prelude -- local -import Distribution.Backpack.DescribeUnitId (setupMessage') +-- import Distribution.Backpack.DescribeUnitId (setupMessage') import Distribution.Types.UnqualComponentName import Distribution.Types.ComponentLocalBuildInfo -import Distribution.Package +-- import Distribution.Package import qualified Distribution.ModuleName as ModuleName import Distribution.PackageDescription as PD hiding (Flag) import Distribution.Simple.Program @@ -59,17 +59,17 @@ doctest :: PackageDescription doctest pkg_descr lbi suffixes doctestFlags = do let verbosity = flag doctestVerbosity flag f = fromFlag $ f doctestFlags - (doctestProg, version, _) <- + (doctestProg, _version, _) <- requireProgramVersion verbosity doctestProgram (orLaterVersion (mkVersion [0,11])) (withPrograms lbi) withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do componentInitialBuildSteps (flag doctestDistPref) pkg_descr lbi clbi verbosity preprocessComponent pkg_descr component lbi clbi False verbosity suffixes - let - smsg :: IO () - smsg = setupMessage' verbosity "Running Doctest on" (packageId pkg_descr) - (componentLocalName clbi) (maybeComponentInstantiatedWith clbi) + -- let + -- smsg :: IO () + -- smsg = setupMessage' verbosity "Running Doctest on" (packageId pkg_descr) + -- (componentLocalName clbi) (maybeComponentInstantiatedWith clbi) case component of CLib lib -> do @@ -97,7 +97,7 @@ renderArgs :: Verbosity -> DoctestArgs -> (([String],[FilePath]) -> IO a) -> IO a -renderArgs verbosity args k = do +renderArgs _verbosity args k = do -- inject the "--no-magic" flag, to have a rather bare -- doctest invocation, and disable doctests automagic discovery heuristics. k (["--no-magic"], argTargets args) diff --git a/Cabal/Distribution/Simple/Program/Builtin.hs b/Cabal/Distribution/Simple/Program/Builtin.hs index 4bd79013a3e..0a740b4339d 100644 --- a/Cabal/Distribution/Simple/Program/Builtin.hs +++ b/Cabal/Distribution/Simple/Program/Builtin.hs @@ -311,6 +311,8 @@ hscolourProgram = (simpleProgram "hscolour") { _ -> "" } +-- TODO: Ensure that doctest is built against the same GHC as the one +-- that's being used. Same for haddock. @phadej pointed this out. doctestProgram :: Program doctestProgram = (simpleProgram "doctest") { programFindLocation = \v p -> findProgramOnSearchPath v p "doctest" From 85d2cf37b297b3881b7ad87c5261a61ce199e173 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 1 May 2017 12:13:50 +0800 Subject: [PATCH 04/10] Cleanup --- Cabal/Distribution/Simple.hs | 6 +- Cabal/Distribution/Simple/BuildPaths.hs | 76 ++++++++++++++++++++- Cabal/Distribution/Simple/Doctest.hs | 55 --------------- Cabal/Distribution/Simple/Haddock.hs | 65 ------------------ Cabal/Distribution/Simple/LocalBuildInfo.hs | 3 +- cabal-install/main/Main.hs | 9 ++- 6 files changed, 84 insertions(+), 130 deletions(-) diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index 98be83ce551..ef510f09638 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -176,7 +176,7 @@ defaultMainHelper hooks args = topHandler $ ,replCommand progs `commandAddAction` replAction hooks ,installCommand `commandAddAction` installAction hooks ,copyCommand `commandAddAction` copyAction hooks - ,doctestCommand `commandAddAction` doctestAcion hooks + ,doctestCommand `commandAddAction` doctestAction hooks ,haddockCommand `commandAddAction` haddockAction hooks ,cleanCommand `commandAddAction` cleanAction hooks ,sdistCommand `commandAddAction` sdistAction hooks @@ -292,8 +292,8 @@ hscolourAction hooks flags args = do (getBuildConfig hooks verbosity distPref) hooks flags' args -doctestAcion :: UserHooks -> DoctestFlags -> Args -> IO () -doctestAcion hooks flags args = do +doctestAction :: UserHooks -> DoctestFlags -> Args -> IO () +doctestAction hooks flags args = do distPref <- findDistPrefOrDefault (doctestDistPref flags) let verbosity = fromFlag $ doctestVerbosity flags diff --git a/Cabal/Distribution/Simple/BuildPaths.hs b/Cabal/Distribution/Simple/BuildPaths.hs index 753872635ad..61c8e736f8d 100644 --- a/Cabal/Distribution/Simple/BuildPaths.hs +++ b/Cabal/Distribution/Simple/BuildPaths.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.BuildPaths @@ -31,11 +32,16 @@ module Distribution.Simple.BuildPaths ( objExtension, dllExtension, staticLibExtension, + -- * Source files & build directories + getSourceFiles, getLibSourceFiles, getExeSourceFiles, + getFLibSourceFiles, exeBuildDir, flibBuildDir, ) where import Prelude () import Distribution.Compat.Prelude +import Distribution.Types.ForeignLib +import Distribution.Types.UnqualComponentName (unUnqualComponentName) import Distribution.Package import Distribution.ModuleName as ModuleName import Distribution.Compiler @@ -44,8 +50,10 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Setup import Distribution.Text import Distribution.System +import Distribution.Verbosity +import Distribution.Simple.Utils -import System.FilePath ((), (<.>)) +import System.FilePath ((), (<.>), normalise) -- --------------------------------------------------------------------------- -- Build directories and files @@ -104,6 +112,72 @@ autogenPathsModuleName pkg_descr = haddockName :: PackageDescription -> FilePath haddockName pkg_descr = display (packageName pkg_descr) <.> "haddock" +-- ----------------------------------------------------------------------------- +-- Source File helper + +getLibSourceFiles :: Verbosity + -> LocalBuildInfo + -> Library + -> ComponentLocalBuildInfo + -> IO [(ModuleName.ModuleName, FilePath)] +getLibSourceFiles verbosity lbi lib clbi = getSourceFiles verbosity searchpaths modules + where + bi = libBuildInfo lib + modules = allLibModules lib clbi + searchpaths = componentBuildDir lbi clbi : hsSourceDirs bi ++ + [ autogenComponentModulesDir lbi clbi + , autogenPackageModulesDir lbi ] + +getExeSourceFiles :: Verbosity + -> LocalBuildInfo + -> Executable + -> ComponentLocalBuildInfo + -> IO [(ModuleName.ModuleName, FilePath)] +getExeSourceFiles verbosity lbi exe clbi = do + moduleFiles <- getSourceFiles verbosity searchpaths modules + srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) + return ((ModuleName.main, srcMainPath) : moduleFiles) + where + bi = buildInfo exe + modules = otherModules bi + searchpaths = autogenComponentModulesDir lbi clbi + : autogenPackageModulesDir lbi + : exeBuildDir lbi exe : hsSourceDirs bi + +getFLibSourceFiles :: Verbosity + -> LocalBuildInfo + -> ForeignLib + -> ComponentLocalBuildInfo + -> IO [(ModuleName.ModuleName, FilePath)] +getFLibSourceFiles verbosity lbi flib clbi = getSourceFiles verbosity searchpaths modules + where + bi = foreignLibBuildInfo flib + modules = otherModules bi + searchpaths = autogenComponentModulesDir lbi clbi + : autogenPackageModulesDir lbi + : flibBuildDir lbi flib : hsSourceDirs bi + +getSourceFiles :: Verbosity -> [FilePath] + -> [ModuleName.ModuleName] + -> IO [(ModuleName.ModuleName, FilePath)] +getSourceFiles verbosity dirs modules = flip traverse modules $ \m -> fmap ((,) m) $ + findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m) + >>= maybe (notFound m) (return . normalise) + where + notFound module_ = die' verbosity $ "can't find source for module " ++ display module_ + +-- | The directory where we put build results for an executable +exeBuildDir :: LocalBuildInfo -> Executable -> FilePath +exeBuildDir lbi exe = buildDir lbi nm nm ++ "-tmp" + where + nm = unUnqualComponentName $ exeName exe + +-- | The directory where we put build results for a foreign library +flibBuildDir :: LocalBuildInfo -> ForeignLib -> FilePath +flibBuildDir lbi flib = buildDir lbi nm nm ++ "-tmp" + where + nm = unUnqualComponentName $ foreignLibName flib + -- --------------------------------------------------------------------------- -- Library file names diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs index 940c7f55362..26d35f06799 100644 --- a/Cabal/Distribution/Simple/Doctest.hs +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -20,11 +20,6 @@ import Distribution.Compat.Prelude -- local --- import Distribution.Backpack.DescribeUnitId (setupMessage') -import Distribution.Types.UnqualComponentName -import Distribution.Types.ComponentLocalBuildInfo --- import Distribution.Package -import qualified Distribution.ModuleName as ModuleName import Distribution.PackageDescription as PD hiding (Flag) import Distribution.Simple.Program import Distribution.Simple.PreProcess @@ -32,13 +27,9 @@ import Distribution.Simple.Setup import Distribution.Simple.Build import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate) import Distribution.Simple.BuildPaths -import Distribution.Simple.Utils -import Distribution.Text import Distribution.Version import Distribution.Verbosity -import System.FilePath ( (), normalise ) - -- ----------------------------------------------------------------------------- -- Types @@ -102,52 +93,6 @@ renderArgs _verbosity args k = do -- doctest invocation, and disable doctests automagic discovery heuristics. k (["--no-magic"], argTargets args) --- ----------------------------------------------------------------------------- --- TODO: move somewhere else (this is copied from Haddock.hs!) -getLibSourceFiles :: Verbosity - -> LocalBuildInfo - -> Library - -> ComponentLocalBuildInfo - -> IO [(ModuleName.ModuleName, FilePath)] -getLibSourceFiles verbosity lbi lib clbi = getSourceFiles verbosity searchpaths modules - where - bi = libBuildInfo lib - modules = allLibModules lib clbi - searchpaths = componentBuildDir lbi clbi : hsSourceDirs bi ++ - [ autogenComponentModulesDir lbi clbi - , autogenPackageModulesDir lbi ] - -getExeSourceFiles :: Verbosity - -> LocalBuildInfo - -> Executable - -> ComponentLocalBuildInfo - -> IO [(ModuleName.ModuleName, FilePath)] -getExeSourceFiles verbosity lbi exe clbi = do - moduleFiles <- getSourceFiles verbosity searchpaths modules - srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) - return ((ModuleName.main, srcMainPath) : moduleFiles) - where - bi = buildInfo exe - modules = otherModules bi - searchpaths = autogenComponentModulesDir lbi clbi - : autogenPackageModulesDir lbi - : exeBuildDir lbi exe : hsSourceDirs bi - -getSourceFiles :: Verbosity -> [FilePath] - -> [ModuleName.ModuleName] - -> IO [(ModuleName.ModuleName, FilePath)] -getSourceFiles verbosity dirs modules = flip traverse modules $ \m -> fmap ((,) m) $ - findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m) - >>= maybe (notFound m) (return . normalise) - where - notFound module_ = die' verbosity $ "doctest: can't find source for module " ++ display module_ - --- | The directory where we put build results for an executable -exeBuildDir :: LocalBuildInfo -> Executable -> FilePath -exeBuildDir lbi exe = buildDir lbi nm nm ++ "-tmp" - where - nm = unUnqualComponentName $ exeName exe - -- ------------------------------------------------------------------------------ -- Boilerplate Monoid instance. instance Monoid DoctestArgs where diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index 38ba1a445c2..99d625bb796 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -751,71 +751,6 @@ haddockToHscolour flags = hscolourVerbosity = haddockVerbosity flags, hscolourDistPref = haddockDistPref flags } ---------------------------------------------------------------------------------- --- TODO these should be moved elsewhere. - -getLibSourceFiles :: Verbosity - -> LocalBuildInfo - -> Library - -> ComponentLocalBuildInfo - -> IO [(ModuleName.ModuleName, FilePath)] -getLibSourceFiles verbosity lbi lib clbi = getSourceFiles verbosity searchpaths modules - where - bi = libBuildInfo lib - modules = allLibModules lib clbi - searchpaths = componentBuildDir lbi clbi : hsSourceDirs bi ++ - [ autogenComponentModulesDir lbi clbi - , autogenPackageModulesDir lbi ] - -getExeSourceFiles :: Verbosity - -> LocalBuildInfo - -> Executable - -> ComponentLocalBuildInfo - -> IO [(ModuleName.ModuleName, FilePath)] -getExeSourceFiles verbosity lbi exe clbi = do - moduleFiles <- getSourceFiles verbosity searchpaths modules - srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) - return ((ModuleName.main, srcMainPath) : moduleFiles) - where - bi = buildInfo exe - modules = otherModules bi - searchpaths = autogenComponentModulesDir lbi clbi - : autogenPackageModulesDir lbi - : exeBuildDir lbi exe : hsSourceDirs bi - -getFLibSourceFiles :: Verbosity - -> LocalBuildInfo - -> ForeignLib - -> ComponentLocalBuildInfo - -> IO [(ModuleName.ModuleName, FilePath)] -getFLibSourceFiles verbosity lbi flib clbi = getSourceFiles verbosity searchpaths modules - where - bi = foreignLibBuildInfo flib - modules = otherModules bi - searchpaths = autogenComponentModulesDir lbi clbi - : autogenPackageModulesDir lbi - : flibBuildDir lbi flib : hsSourceDirs bi - -getSourceFiles :: Verbosity -> [FilePath] - -> [ModuleName.ModuleName] - -> IO [(ModuleName.ModuleName, FilePath)] -getSourceFiles verbosity dirs modules = flip traverse modules $ \m -> fmap ((,) m) $ - findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m) - >>= maybe (notFound m) (return . normalise) - where - notFound module_ = die' verbosity $ "haddock: can't find source for module " ++ display module_ - --- | The directory where we put build results for an executable -exeBuildDir :: LocalBuildInfo -> Executable -> FilePath -exeBuildDir lbi exe = buildDir lbi nm nm ++ "-tmp" - where - nm = unUnqualComponentName $ exeName exe - --- | The directory where we put build results for a foreign library -flibBuildDir :: LocalBuildInfo -> ForeignLib -> FilePath -flibBuildDir lbi flib = buildDir lbi nm nm ++ "-tmp" - where - nm = unUnqualComponentName $ foreignLibName flib -- ------------------------------------------------------------------------------ -- Boilerplate Monoid instance. diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index a40e5363865..6454ca6b590 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -62,7 +62,7 @@ module Distribution.Simple.LocalBuildInfo ( module Distribution.Simple.InstallDirs, absoluteInstallDirs, prefixRelativeInstallDirs, absoluteComponentInstallDirs, prefixRelativeComponentInstallDirs, - substPathTemplate + substPathTemplate, ) where import Prelude () @@ -383,3 +383,4 @@ substPathTemplate pkgid lbi uid = fromPathTemplate uid (compilerInfo (compiler lbi)) (hostPlatform lbi) + diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index a4a9465df57..617788ebb33 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -50,7 +50,7 @@ import Distribution.Client.Setup ) import Distribution.Simple.Setup ( HaddockTarget(..) - , DoctestFlags(..), doctestCommand, defaultDoctestFlags + , DoctestFlags(..), doctestCommand , HaddockFlags(..), haddockCommand, defaultHaddockFlags , HscolourFlags(..), hscolourCommand , ReplFlags(..) @@ -271,7 +271,7 @@ mainWorker args = topHandler $ , regularCmd buildCommand buildAction , regularCmd replCommand replAction , regularCmd sandboxCommand sandboxAction - , regularCmd doctestCommand doctestAcion + , regularCmd doctestCommand doctestAction , regularCmd haddockCommand haddockAction , regularCmd execCommand execAction , regularCmd userConfigCommand userConfigAction @@ -763,10 +763,9 @@ haddockAction haddockFlags extraArgs globalFlags = do createTarGzFile dest docDir name notice verbosity $ "Documentation tarball created: " ++ dest -doctestAcion :: DoctestFlags -> [String] -> Action -doctestAcion doctestFlags extraArgs globalFlags = do +doctestAction :: DoctestFlags -> [String] -> Action +doctestAction doctestFlags extraArgs _globalFlags = do let verbosity = fromFlag (doctestVerbosity doctestFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags setupWrapper verbosity defaultSetupScriptOptions Nothing doctestCommand (const doctestFlags) extraArgs From 87753f2842aca597e2c335e03566df1dffde2589 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 1 May 2017 15:09:01 +0800 Subject: [PATCH 05/10] Adds FlexibleContext --- Cabal/Distribution/Simple/BuildPaths.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Cabal/Distribution/Simple/BuildPaths.hs b/Cabal/Distribution/Simple/BuildPaths.hs index 61c8e736f8d..1629e72ba69 100644 --- a/Cabal/Distribution/Simple/BuildPaths.hs +++ b/Cabal/Distribution/Simple/BuildPaths.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- | From bee8003ade15f5f1996785e36da7d2ac99d95c0d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 1 May 2017 18:47:29 +0800 Subject: [PATCH 06/10] Adds package discovery and flags This basically reuses cabals logic for computing the command line arguments. --- Cabal/Distribution/Simple/Doctest.hs | 110 ++++++++++++++++++++++----- 1 file changed, 93 insertions(+), 17 deletions(-) diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs index 26d35f06799..7756f1265ce 100644 --- a/Cabal/Distribution/Simple/Doctest.hs +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -18,15 +18,22 @@ module Distribution.Simple.Doctest ( import Prelude () import Distribution.Compat.Prelude +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.GHCJS as GHCJS -- local import Distribution.PackageDescription as PD hiding (Flag) +import Distribution.Simple.Compiler hiding (Flag) +import Distribution.Simple.Program.GHC import Distribution.Simple.Program import Distribution.Simple.PreProcess import Distribution.Simple.Setup import Distribution.Simple.Build import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate) import Distribution.Simple.BuildPaths +import Distribution.Simple.Utils +import Distribution.System +import Distribution.Utils.NubList import Distribution.Version import Distribution.Verbosity @@ -35,8 +42,9 @@ import Distribution.Verbosity -- | A record that represents the arguments to the doctest executable. data DoctestArgs = DoctestArgs { - argTargets :: [FilePath] - -- ^ Modules to process + argTargets :: [FilePath] + -- ^ Modules to process + , argGhcOptions :: Flag (GhcOptions, Version) } deriving (Show, Generic) -- ----------------------------------------------------------------------------- @@ -48,8 +56,10 @@ doctest :: PackageDescription -> DoctestFlags -> IO () doctest pkg_descr lbi suffixes doctestFlags = do - let verbosity = flag doctestVerbosity - flag f = fromFlag $ f doctestFlags + let verbosity = flag doctestVerbosity + flag f = fromFlag $ f doctestFlags + tmpFileOpts = defaultTempFileOptions + (doctestProg, _version, _) <- requireProgramVersion verbosity doctestProgram (orLaterVersion (mkVersion [0,11])) (withPrograms lbi) @@ -62,36 +72,102 @@ doctest pkg_descr lbi suffixes doctestFlags = do -- smsg = setupMessage' verbosity "Running Doctest on" (packageId pkg_descr) -- (componentLocalName clbi) (maybeComponentInstantiatedWith clbi) - case component of + case component of CLib lib -> do - args <- DoctestArgs . map snd <$> getLibSourceFiles verbosity lbi lib clbi - runDoctest verbosity doctestProg args + withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ + \tmp -> do + inFiles <- map snd <$> getLibSourceFiles verbosity lbi lib clbi + args <- mkDoctestArgs verbosity tmp lbi clbi inFiles (libBuildInfo lib) + runDoctest verbosity (compiler lbi) (hostPlatform lbi) doctestProg args CExe exe -> do - args <- DoctestArgs . map snd <$> getExeSourceFiles verbosity lbi exe clbi - runDoctest verbosity doctestProg args + withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ + \tmp -> do + inFiles <- map snd <$> getExeSourceFiles verbosity lbi exe clbi + args <- mkDoctestArgs verbosity tmp lbi clbi inFiles (buildInfo exe) + runDoctest verbosity (compiler lbi) (hostPlatform lbi) doctestProg args CFLib _ -> return () -- do not doctest foreign libs CTest _ -> return () -- do not doctest tests - CBench _ -> return () -- do not doctest benchmarks - + CBench _ -> return () -- do not doctest benchmarks +-- +-- +componentGhcOptions :: Verbosity -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo -> FilePath + -> GhcOptions +componentGhcOptions verbosity lbi bi clbi odir = + let f = case compilerFlavor (compiler lbi) of + GHC -> GHC.componentGhcOptions + GHCJS -> GHCJS.componentGhcOptions + _ -> error $ + "Distribution.Simple.Doctest.componentGhcOptions:" ++ + "doctest only supports GHC and GHCJS" + in f verbosity lbi bi clbi odir + +mkDoctestArgs :: Verbosity + -> FilePath + -> LocalBuildInfo + -> ComponentLocalBuildInfo + -> [FilePath] + -> BuildInfo + -> IO DoctestArgs +mkDoctestArgs verbosity tmp lbi clbi inFiles bi = do + let vanillaOpts = (componentGhcOptions normal lbi bi clbi (buildDir lbi)) + { ghcOptOptimisation = mempty + , ghcOptWarnMissingHomeModules = mempty + , ghcOptCabal = toFlag False + + , ghcOptObjDir = toFlag tmp + , ghcOptHiDir = toFlag tmp + , ghcOptStubDir = toFlag tmp } + sharedOpts = vanillaOpts + { ghcOptDynLinkMode = toFlag GhcDynamicOnly + , ghcOptFPic = toFlag True + , ghcOptHiSuffix = toFlag "dyn_hi" + , ghcOptObjSuffix = toFlag "dyn_o" + , ghcOptExtra = toNubListR (hcSharedOptions GHC bi)} + opts <- if withVanillaLib lbi + then return vanillaOpts + else if withSharedLib lbi + then return sharedOpts + else die' verbosity $ "Must have canilla or shared lirbaries " + ++ "enabled in order to run doctest" + ghcVersion <- maybe (die' verbosity "Compiler has no GHC version") + return + (compilerCompatVersion GHC (compiler lbi)) + return $ DoctestArgs + { argTargets = inFiles + , argGhcOptions = toFlag (opts, ghcVersion) + } + + -- ----------------------------------------------------------------------------- -- Call doctest with the specified arguments. runDoctest :: Verbosity + -> Compiler + -> Platform -> ConfiguredProgram -> DoctestArgs -> IO () -runDoctest verbosity doctestProg args = do - renderArgs verbosity args $ +runDoctest verbosity comp platform doctestProg args = do + renderArgs verbosity comp platform args $ \(flags, files) -> do runProgram verbosity doctestProg (flags <> files) renderArgs :: Verbosity + -> Compiler + -> Platform -> DoctestArgs -> (([String],[FilePath]) -> IO a) -> IO a -renderArgs _verbosity args k = do - -- inject the "--no-magic" flag, to have a rather bare - -- doctest invocation, and disable doctests automagic discovery heuristics. - k (["--no-magic"], argTargets args) +renderArgs _verbosity comp platform args k = do + k (flags, argTargets args) + where + flags :: [String] + flags = mconcat + [ pure "--no-magic" -- disable doctests automagic discovery heuristics + , pure "-fdiagnostics-color=never" -- disable ghc's color diagnostics. + , [ opt | (opts, _ghcVer) <- flagToList (argGhcOptions args) + , opt <- renderGhcOptions comp platform opts ] + ] -- ------------------------------------------------------------------------------ -- Boilerplate Monoid instance. From 8eb82cdf0a460b74fdf32c79f7cb23be6bbb11fe Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 1 May 2017 22:17:54 +0800 Subject: [PATCH 07/10] More cleanup --- Cabal/Distribution/Simple/Doctest.hs | 20 +++++++++++++------- Cabal/Distribution/Simple/Haddock.hs | 2 +- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs index 7756f1265ce..8caa0b9884e 100644 --- a/Cabal/Distribution/Simple/Doctest.hs +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -1,9 +1,10 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- | --- Module : Distribution.Simple.Haddock --- Copyright : Isaac Jones 2003-2005 +-- Module : Distribution.Simple.Doctest +-- Copyright : Moritz Angermann 2017 -- License : BSD3 -- -- Maintainer : cabal-devel@haskell.org @@ -11,6 +12,8 @@ -- -- This module deals with the @doctest@ command. +-- Note: this module is modelled after Distribution.Simple.Haddock + module Distribution.Simple.Doctest ( doctest ) where @@ -88,8 +91,11 @@ doctest pkg_descr lbi suffixes doctestFlags = do CFLib _ -> return () -- do not doctest foreign libs CTest _ -> return () -- do not doctest tests CBench _ -> return () -- do not doctest benchmarks --- --- + + +-- ----------------------------------------------------------------------------- +-- Contributions to DoctestArgs (see also Haddock.hs for very similar code). + componentGhcOptions :: Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> GhcOptions @@ -128,7 +134,7 @@ mkDoctestArgs verbosity tmp lbi clbi inFiles bi = do then return vanillaOpts else if withSharedLib lbi then return sharedOpts - else die' verbosity $ "Must have canilla or shared lirbaries " + else die' verbosity $ "Must have vanilla or shared lirbaries " ++ "enabled in order to run doctest" ghcVersion <- maybe (die' verbosity "Compiler has no GHC version") return diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index 99d625bb796..066f44bd5aa 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -242,7 +242,7 @@ haddock pkg_descr lbi suffixes flags' = do for_ files $ copyFileTo verbosity (unDir $ argOutputDir commonArgs) -- ------------------------------------------------------------------------------ --- Contributions to HaddockArgs. +-- Contributions to HaddockArgs (see also Doctest.hs for very similar code). fromFlags :: PathTemplateEnv -> HaddockFlags -> HaddockArgs fromFlags env flags = From 1915a9039d43f8c6aa96c4923e2cfb1abb38d6bb Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 2 May 2017 23:30:34 +0800 Subject: [PATCH 08/10] Adds doctest-ghc(js)-options: --- Cabal/Distribution/PackageDescription.hs | 1 + .../Distribution/PackageDescription/Parse.hs | 5 +++++ .../PackageDescription/Parsec/FieldDescr.hs | 5 +++++ Cabal/Distribution/Simple/Doctest.hs | 19 ++++++++++++++++++- Cabal/Distribution/Simple/GHC/Internal.hs | 1 + Cabal/Distribution/Simple/Program/GHC.hs | 4 ++++ Cabal/Distribution/Simple/Setup.hs | 6 +++--- Cabal/Distribution/Types/BuildInfo.hs | 7 +++++++ 8 files changed, 44 insertions(+), 4 deletions(-) diff --git a/Cabal/Distribution/PackageDescription.hs b/Cabal/Distribution/PackageDescription.hs index 871c92c3746..72d1d7064ea 100644 --- a/Cabal/Distribution/PackageDescription.hs +++ b/Cabal/Distribution/PackageDescription.hs @@ -78,6 +78,7 @@ module Distribution.PackageDescription ( allExtensions, usedExtensions, hcOptions, + hcDoctestOptions, hcProfOptions, hcSharedOptions, diff --git a/Cabal/Distribution/PackageDescription/Parse.hs b/Cabal/Distribution/PackageDescription/Parse.hs index 71af5ed1c36..51253f28fbf 100644 --- a/Cabal/Distribution/PackageDescription/Parse.hs +++ b/Cabal/Distribution/PackageDescription/Parse.hs @@ -520,6 +520,11 @@ binfoFieldDescrs = options (const id) , optsField "nhc98-options" NHC options (const id) + + , optsField "doctest-ghc-options" GHC + doctestOptions (\path binfo -> binfo{doctestOptions=path}) + , optsField "doctest-ghcjs-options" GHCJS + doctestOptions (\path binfo -> binfo{doctestOptions=path}) ] storeXFieldsBI :: UnrecFieldParser BuildInfo diff --git a/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs b/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs index d4d84dc1b6e..f21cf866b2a 100644 --- a/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs +++ b/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs @@ -524,6 +524,11 @@ binfoFieldDescrs = options (const id) , optsField "nhc98-options" NHC options (const id) + + , optsField "doctest-ghc-options" GHC + doctestOptions (\path binfo -> binfo{doctestOptions=path}) + , optsField "doctest-ghcjs-options" GHCJS + doctestOptions (\path binfo -> binfo{doctestOptions=path}) ] {- diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs index 8caa0b9884e..031c6b14949 100644 --- a/Cabal/Distribution/Simple/Doctest.hs +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -108,6 +108,18 @@ componentGhcOptions verbosity lbi bi clbi odir = "doctest only supports GHC and GHCJS" in f verbosity lbi bi clbi odir +-- componentDoctestGhcOptions :: Verbosity -> LocalBuildInfo +-- -> BuildInfo -> ComponentLocalBuildInfo -> FilePath +-- -> GhcOptions +-- componentDoctestGhcOptions verbosity lbi bi clbi odir = +-- let f = case compilerFlavor (compiler lbi) of +-- GHC -> GHC.componentDoctestGhcOptions +-- GHCJS -> GHCJS.componentDoctestGhcOptions +-- _ -> error $ +-- "Distribution.Simple.Doctest.componentDoctestGhcOptions:" ++ +-- "doctest only support GHC and GHCJS" +-- in f verbosity lbi bi clbi odir + mkDoctestArgs :: Verbosity -> FilePath -> LocalBuildInfo @@ -119,6 +131,9 @@ mkDoctestArgs verbosity tmp lbi clbi inFiles bi = do let vanillaOpts = (componentGhcOptions normal lbi bi clbi (buildDir lbi)) { ghcOptOptimisation = mempty , ghcOptWarnMissingHomeModules = mempty + -- clear out ghc-options: these are likely not meant for doctest. + -- If so, should be explicitly specified via doctest-ghc-options: again. + , ghcOptExtra = mempty , ghcOptCabal = toFlag False , ghcOptObjDir = toFlag tmp @@ -139,6 +154,7 @@ mkDoctestArgs verbosity tmp lbi clbi inFiles bi = do ghcVersion <- maybe (die' verbosity "Compiler has no GHC version") return (compilerCompatVersion GHC (compiler lbi)) + return $ DoctestArgs { argTargets = inFiles , argGhcOptions = toFlag (opts, ghcVersion) @@ -172,7 +188,8 @@ renderArgs _verbosity comp platform args k = do [ pure "--no-magic" -- disable doctests automagic discovery heuristics , pure "-fdiagnostics-color=never" -- disable ghc's color diagnostics. , [ opt | (opts, _ghcVer) <- flagToList (argGhcOptions args) - , opt <- renderGhcOptions comp platform opts ] + , opt <- renderGhcOptions comp platform opts + <> fromNubListR (ghcOptDoctest opts) ] ] -- ------------------------------------------------------------------------------ diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index 19dba973e9e..195812e67be 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -344,6 +344,7 @@ componentGhcOptions verbosity implInfo lbi bi clbi odir = ghcOptOptimisation = toGhcOptimisation (withOptimization lbi), ghcOptDebugInfo = toGhcDebugInfo (withDebugInfo lbi), ghcOptExtra = toNubListR $ hcOptions GHC bi, + ghcOptDoctest = toNubListR $ hcDoctestOptions GHC bi, ghcOptExtraPath = toNubListR $ exe_paths, ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)), -- Unsupported extensions have already been checked by configure diff --git a/Cabal/Distribution/Simple/Program/GHC.hs b/Cabal/Distribution/Simple/Program/GHC.hs index 6e70a703ecf..e553cdaf29c 100644 --- a/Cabal/Distribution/Simple/Program/GHC.hs +++ b/Cabal/Distribution/Simple/Program/GHC.hs @@ -47,6 +47,10 @@ data GhcOptions = GhcOptions { -- override other stuff. ghcOptExtra :: NubListR String, + -- | Any options to pass to ghc through doctest. These go at the end and hence + -- override other stuff. Note: cabal doctest will ignore @ghcOptExtra@. + ghcOptDoctest :: NubListR String, + -- | Extra default flags to pass directly to ghc. These go at the beginning -- and so can be overridden by other stuff. ghcOptExtraDefault :: NubListR String, diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 9c18112e51e..a4362b9d55b 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -1419,7 +1419,7 @@ doctestCommand = CommandUI "Usage: " ++ pname ++ " doctest [FLAGS]\n" , commandDefaultFlags = defaultDoctestFlags , commandOptions = \showOrParseArgs -> - doctestOptions showOrParseArgs + doctestCmdOptions showOrParseArgs ++ programDbPaths progDb ParseArgs doctestProgramPaths (\v flags -> flags { doctestProgramPaths = v }) ++ programDbOption progDb showOrParseArgs @@ -1432,8 +1432,8 @@ doctestCommand = CommandUI $ addKnownProgram ghcProgram $ emptyProgramDb -doctestOptions :: ShowOrParseArgs -> [OptionField DoctestFlags] -doctestOptions showOrParseArgs = +doctestCmdOptions :: ShowOrParseArgs -> [OptionField DoctestFlags] +doctestCmdOptions showOrParseArgs = [optionVerbosity doctestVerbosity (\v flags -> flags { doctestVerbosity = v }) ,optionDistPref diff --git a/Cabal/Distribution/Types/BuildInfo.hs b/Cabal/Distribution/Types/BuildInfo.hs index 635834a8fb5..3149454141c 100644 --- a/Cabal/Distribution/Types/BuildInfo.hs +++ b/Cabal/Distribution/Types/BuildInfo.hs @@ -10,6 +10,7 @@ module Distribution.Types.BuildInfo ( usedExtensions, hcOptions, + hcDoctestOptions, hcProfOptions, hcSharedOptions, ) where @@ -74,6 +75,7 @@ data BuildInfo = BuildInfo { options :: [(CompilerFlavor,[String])], profOptions :: [(CompilerFlavor,[String])], sharedOptions :: [(CompilerFlavor,[String])], + doctestOptions :: [(CompilerFlavor,[String])], customFieldsBI :: [(String,String)], -- ^Custom fields starting -- with x-, stored in a -- simple assoc-list. @@ -112,6 +114,7 @@ instance Monoid BuildInfo where includes = [], installIncludes = [], options = [], + doctestOptions = [], profOptions = [], sharedOptions = [], customFieldsBI = [], @@ -148,6 +151,7 @@ instance Semigroup BuildInfo where includes = combineNub includes, installIncludes = combineNub installIncludes, options = combine options, + doctestOptions = combine doctestOptions, profOptions = combine profOptions, sharedOptions = combine sharedOptions, customFieldsBI = combine customFieldsBI, @@ -184,6 +188,9 @@ usedExtensions bi = oldExtensions bi hcOptions :: CompilerFlavor -> BuildInfo -> [String] hcOptions = lookupHcOptions options +hcDoctestOptions :: CompilerFlavor -> BuildInfo -> [String] +hcDoctestOptions = lookupHcOptions doctestOptions + hcProfOptions :: CompilerFlavor -> BuildInfo -> [String] hcProfOptions = lookupHcOptions profOptions From 69a7eb91d250eba2bf5e61c38ccc6e10baec0936 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 3 May 2017 09:41:31 +0800 Subject: [PATCH 09/10] Revert "Adds doctest-ghc(js)-options:"; drop --ghc-options from --help --- Cabal/Distribution/PackageDescription.hs | 1 - .../Distribution/PackageDescription/Parse.hs | 5 ---- .../PackageDescription/Parsec/FieldDescr.hs | 5 ---- Cabal/Distribution/Simple/Doctest.hs | 23 +++---------------- Cabal/Distribution/Simple/GHC/Internal.hs | 1 - Cabal/Distribution/Simple/Program/GHC.hs | 4 ---- Cabal/Distribution/Simple/Setup.hs | 9 ++++---- Cabal/Distribution/Types/BuildInfo.hs | 7 ------ 8 files changed, 7 insertions(+), 48 deletions(-) diff --git a/Cabal/Distribution/PackageDescription.hs b/Cabal/Distribution/PackageDescription.hs index 72d1d7064ea..871c92c3746 100644 --- a/Cabal/Distribution/PackageDescription.hs +++ b/Cabal/Distribution/PackageDescription.hs @@ -78,7 +78,6 @@ module Distribution.PackageDescription ( allExtensions, usedExtensions, hcOptions, - hcDoctestOptions, hcProfOptions, hcSharedOptions, diff --git a/Cabal/Distribution/PackageDescription/Parse.hs b/Cabal/Distribution/PackageDescription/Parse.hs index 51253f28fbf..71af5ed1c36 100644 --- a/Cabal/Distribution/PackageDescription/Parse.hs +++ b/Cabal/Distribution/PackageDescription/Parse.hs @@ -520,11 +520,6 @@ binfoFieldDescrs = options (const id) , optsField "nhc98-options" NHC options (const id) - - , optsField "doctest-ghc-options" GHC - doctestOptions (\path binfo -> binfo{doctestOptions=path}) - , optsField "doctest-ghcjs-options" GHCJS - doctestOptions (\path binfo -> binfo{doctestOptions=path}) ] storeXFieldsBI :: UnrecFieldParser BuildInfo diff --git a/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs b/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs index f21cf866b2a..d4d84dc1b6e 100644 --- a/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs +++ b/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs @@ -524,11 +524,6 @@ binfoFieldDescrs = options (const id) , optsField "nhc98-options" NHC options (const id) - - , optsField "doctest-ghc-options" GHC - doctestOptions (\path binfo -> binfo{doctestOptions=path}) - , optsField "doctest-ghcjs-options" GHCJS - doctestOptions (\path binfo -> binfo{doctestOptions=path}) ] {- diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs index 031c6b14949..deb061185a0 100644 --- a/Cabal/Distribution/Simple/Doctest.hs +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -70,10 +70,6 @@ doctest pkg_descr lbi suffixes doctestFlags = do withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do componentInitialBuildSteps (flag doctestDistPref) pkg_descr lbi clbi verbosity preprocessComponent pkg_descr component lbi clbi False verbosity suffixes - -- let - -- smsg :: IO () - -- smsg = setupMessage' verbosity "Running Doctest on" (packageId pkg_descr) - -- (componentLocalName clbi) (maybeComponentInstantiatedWith clbi) case component of CLib lib -> do @@ -108,18 +104,6 @@ componentGhcOptions verbosity lbi bi clbi odir = "doctest only supports GHC and GHCJS" in f verbosity lbi bi clbi odir --- componentDoctestGhcOptions :: Verbosity -> LocalBuildInfo --- -> BuildInfo -> ComponentLocalBuildInfo -> FilePath --- -> GhcOptions --- componentDoctestGhcOptions verbosity lbi bi clbi odir = --- let f = case compilerFlavor (compiler lbi) of --- GHC -> GHC.componentDoctestGhcOptions --- GHCJS -> GHCJS.componentDoctestGhcOptions --- _ -> error $ --- "Distribution.Simple.Doctest.componentDoctestGhcOptions:" ++ --- "doctest only support GHC and GHCJS" --- in f verbosity lbi bi clbi odir - mkDoctestArgs :: Verbosity -> FilePath -> LocalBuildInfo @@ -129,7 +113,8 @@ mkDoctestArgs :: Verbosity -> IO DoctestArgs mkDoctestArgs verbosity tmp lbi clbi inFiles bi = do let vanillaOpts = (componentGhcOptions normal lbi bi clbi (buildDir lbi)) - { ghcOptOptimisation = mempty + { ghcOptOptimisation = mempty -- no optimizations when runnign doctest + -- disable -Wmissing-home-modules , ghcOptWarnMissingHomeModules = mempty -- clear out ghc-options: these are likely not meant for doctest. -- If so, should be explicitly specified via doctest-ghc-options: again. @@ -154,7 +139,6 @@ mkDoctestArgs verbosity tmp lbi clbi inFiles bi = do ghcVersion <- maybe (die' verbosity "Compiler has no GHC version") return (compilerCompatVersion GHC (compiler lbi)) - return $ DoctestArgs { argTargets = inFiles , argGhcOptions = toFlag (opts, ghcVersion) @@ -188,8 +172,7 @@ renderArgs _verbosity comp platform args k = do [ pure "--no-magic" -- disable doctests automagic discovery heuristics , pure "-fdiagnostics-color=never" -- disable ghc's color diagnostics. , [ opt | (opts, _ghcVer) <- flagToList (argGhcOptions args) - , opt <- renderGhcOptions comp platform opts - <> fromNubListR (ghcOptDoctest opts) ] + , opt <- renderGhcOptions comp platform opts ] ] -- ------------------------------------------------------------------------------ diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index 195812e67be..19dba973e9e 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -344,7 +344,6 @@ componentGhcOptions verbosity implInfo lbi bi clbi odir = ghcOptOptimisation = toGhcOptimisation (withOptimization lbi), ghcOptDebugInfo = toGhcDebugInfo (withDebugInfo lbi), ghcOptExtra = toNubListR $ hcOptions GHC bi, - ghcOptDoctest = toNubListR $ hcDoctestOptions GHC bi, ghcOptExtraPath = toNubListR $ exe_paths, ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)), -- Unsupported extensions have already been checked by configure diff --git a/Cabal/Distribution/Simple/Program/GHC.hs b/Cabal/Distribution/Simple/Program/GHC.hs index e553cdaf29c..6e70a703ecf 100644 --- a/Cabal/Distribution/Simple/Program/GHC.hs +++ b/Cabal/Distribution/Simple/Program/GHC.hs @@ -47,10 +47,6 @@ data GhcOptions = GhcOptions { -- override other stuff. ghcOptExtra :: NubListR String, - -- | Any options to pass to ghc through doctest. These go at the end and hence - -- override other stuff. Note: cabal doctest will ignore @ghcOptExtra@. - ghcOptDoctest :: NubListR String, - -- | Extra default flags to pass directly to ghc. These go at the beginning -- and so can be overridden by other stuff. ghcOptExtraDefault :: NubListR String, diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index a4362b9d55b..ba79b60eed3 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -1419,7 +1419,7 @@ doctestCommand = CommandUI "Usage: " ++ pname ++ " doctest [FLAGS]\n" , commandDefaultFlags = defaultDoctestFlags , commandOptions = \showOrParseArgs -> - doctestCmdOptions showOrParseArgs + doctestOptions showOrParseArgs ++ programDbPaths progDb ParseArgs doctestProgramPaths (\v flags -> flags { doctestProgramPaths = v }) ++ programDbOption progDb showOrParseArgs @@ -1429,11 +1429,10 @@ doctestCommand = CommandUI } where progDb = addKnownProgram doctestProgram - $ addKnownProgram ghcProgram - $ emptyProgramDb + emptyProgramDb -doctestCmdOptions :: ShowOrParseArgs -> [OptionField DoctestFlags] -doctestCmdOptions showOrParseArgs = +doctestOptions :: ShowOrParseArgs -> [OptionField DoctestFlags] +doctestOptions showOrParseArgs = [optionVerbosity doctestVerbosity (\v flags -> flags { doctestVerbosity = v }) ,optionDistPref diff --git a/Cabal/Distribution/Types/BuildInfo.hs b/Cabal/Distribution/Types/BuildInfo.hs index 3149454141c..635834a8fb5 100644 --- a/Cabal/Distribution/Types/BuildInfo.hs +++ b/Cabal/Distribution/Types/BuildInfo.hs @@ -10,7 +10,6 @@ module Distribution.Types.BuildInfo ( usedExtensions, hcOptions, - hcDoctestOptions, hcProfOptions, hcSharedOptions, ) where @@ -75,7 +74,6 @@ data BuildInfo = BuildInfo { options :: [(CompilerFlavor,[String])], profOptions :: [(CompilerFlavor,[String])], sharedOptions :: [(CompilerFlavor,[String])], - doctestOptions :: [(CompilerFlavor,[String])], customFieldsBI :: [(String,String)], -- ^Custom fields starting -- with x-, stored in a -- simple assoc-list. @@ -114,7 +112,6 @@ instance Monoid BuildInfo where includes = [], installIncludes = [], options = [], - doctestOptions = [], profOptions = [], sharedOptions = [], customFieldsBI = [], @@ -151,7 +148,6 @@ instance Semigroup BuildInfo where includes = combineNub includes, installIncludes = combineNub installIncludes, options = combine options, - doctestOptions = combine doctestOptions, profOptions = combine profOptions, sharedOptions = combine sharedOptions, customFieldsBI = combine customFieldsBI, @@ -188,9 +184,6 @@ usedExtensions bi = oldExtensions bi hcOptions :: CompilerFlavor -> BuildInfo -> [String] hcOptions = lookupHcOptions options -hcDoctestOptions :: CompilerFlavor -> BuildInfo -> [String] -hcDoctestOptions = lookupHcOptions doctestOptions - hcProfOptions :: CompilerFlavor -> BuildInfo -> [String] hcProfOptions = lookupHcOptions profOptions From f75c6b1500bb336d37a8efd751cee9ff5ca1d83b Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 4 May 2017 17:18:06 +0800 Subject: [PATCH 10/10] Fix -package-db for inplace package dbs; require doctest 0.11.3 and up. The inplace package-db was not passed by default, as I had initially assumed. We also no encode the requirement for doctest 0.11.3, which sports the --no-magic flag. --- Cabal/Distribution/Simple.hs | 7 ++++--- Cabal/Distribution/Simple/Doctest.hs | 13 ++++++++----- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index ef510f09638..cf8b2396e49 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -296,16 +296,17 @@ doctestAction :: UserHooks -> DoctestFlags -> Args -> IO () doctestAction hooks flags args = do distPref <- findDistPrefOrDefault (doctestDistPref flags) let verbosity = fromFlag $ doctestVerbosity flags + flags' = flags { doctestDistPref = toFlag distPref } lbi <- getBuildConfig hooks verbosity distPref progs <- reconfigurePrograms verbosity - (doctestProgramPaths flags) - (doctestProgramArgs flags) + (doctestProgramPaths flags') + (doctestProgramArgs flags') (withPrograms lbi) hookedAction preDoctest doctestHook postDoctest (return lbi { withPrograms = progs }) - hooks flags args + hooks flags' args haddockAction :: UserHooks -> HaddockFlags -> Args -> IO () haddockAction hooks flags args = do diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs index deb061185a0..b7c448812f4 100644 --- a/Cabal/Distribution/Simple/Doctest.hs +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -33,6 +33,7 @@ import Distribution.Simple.PreProcess import Distribution.Simple.Setup import Distribution.Simple.Build import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate) +import Distribution.Simple.Register (internalPackageDBPath) import Distribution.Simple.BuildPaths import Distribution.Simple.Utils import Distribution.System @@ -60,15 +61,18 @@ doctest :: PackageDescription -> IO () doctest pkg_descr lbi suffixes doctestFlags = do let verbosity = flag doctestVerbosity + distPref = flag doctestDistPref flag f = fromFlag $ f doctestFlags tmpFileOpts = defaultTempFileOptions + lbi' = lbi { withPackageDB = withPackageDB lbi + ++ [SpecificPackageDB (internalPackageDBPath lbi distPref)] } (doctestProg, _version, _) <- requireProgramVersion verbosity doctestProgram - (orLaterVersion (mkVersion [0,11])) (withPrograms lbi) + (orLaterVersion (mkVersion [0,11,3])) (withPrograms lbi) withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do - componentInitialBuildSteps (flag doctestDistPref) pkg_descr lbi clbi verbosity + componentInitialBuildSteps distPref pkg_descr lbi clbi verbosity preprocessComponent pkg_descr component lbi clbi False verbosity suffixes case component of @@ -76,19 +80,18 @@ doctest pkg_descr lbi suffixes doctestFlags = do withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ \tmp -> do inFiles <- map snd <$> getLibSourceFiles verbosity lbi lib clbi - args <- mkDoctestArgs verbosity tmp lbi clbi inFiles (libBuildInfo lib) + args <- mkDoctestArgs verbosity tmp lbi' clbi inFiles (libBuildInfo lib) runDoctest verbosity (compiler lbi) (hostPlatform lbi) doctestProg args CExe exe -> do withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ \tmp -> do inFiles <- map snd <$> getExeSourceFiles verbosity lbi exe clbi - args <- mkDoctestArgs verbosity tmp lbi clbi inFiles (buildInfo exe) + args <- mkDoctestArgs verbosity tmp lbi' clbi inFiles (buildInfo exe) runDoctest verbosity (compiler lbi) (hostPlatform lbi) doctestProg args CFLib _ -> return () -- do not doctest foreign libs CTest _ -> return () -- do not doctest tests CBench _ -> return () -- do not doctest benchmarks - -- ----------------------------------------------------------------------------- -- Contributions to DoctestArgs (see also Haddock.hs for very similar code).