diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,8 @@ +# 0.2.6 + * `getNumProcessors` is now used to detect the (default) number of GHCi subprocesses to spawn. This should more reliably use all of a system's resources. Fixes [#53](https://github.com/martijnbastiaan/doctest-parallel/issues/53). + * Add Nix support. If the environment variable `NIX_BUILD_TOP` is present an extra package database is added to `GHC_PACKAGE_PATH`. This isn't expected to break existing builds, but if it does consider passing `--no-nix`. ([#34](https://github.com/martijnbastiaan/doctest-parallel/issues/34)) + * The QuickCheck example mentioned in the README now uses `abs` instead of `sort`. This prevents confusing errors when `sort` is not imported. Fixes [#50](https://github.com/martijnbastiaan/doctest-parallel/issues/50). + # 0.2.5 * Loosen Cabal bounds to >= 2.4 && < 3.9 diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -195,14 +195,14 @@ ```haskell -- | --- prop> \xs -> sort xs == (sort . sort) (xs :: [Int]) +-- prop> \n -> abs n == abs (abs (n :: Int)) ``` The lambda abstraction is optional and can be omitted: ```haskell -- | --- prop> sort xs == (sort . sort) (xs :: [Int]) +-- prop> abs n == abs (abs (n :: Int)) ``` A complete example that uses setup code is below: diff --git a/doctest-parallel.cabal b/doctest-parallel.cabal --- a/doctest-parallel.cabal +++ b/doctest-parallel.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 name: doctest-parallel -version: 0.2.5 +version: 0.2.6 synopsis: Test interactive Haskell examples description: The doctest program checks examples in source code comments. It is modeled after doctest for Python (). @@ -22,9 +22,9 @@ , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 - , GHC == 9.0.1 - , GHC == 9.2.1 - , GHC == 9.4.1 + , GHC == 9.0.2 + , GHC == 9.2.5 + , GHC == 9.4.3 extra-source-files: example/example.cabal example/src/Example.hs diff --git a/src/Test/DocTest.hs b/src/Test/DocTest.hs --- a/src/Test/DocTest.hs +++ b/src/Test/DocTest.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Test.DocTest @@ -22,7 +23,14 @@ import qualified Data.Set as Set import Control.Monad (unless) +import Control.Monad.Compat (when) +import Control.Monad.Extra (whenM) +import Data.List (isInfixOf) +import Data.Maybe (fromMaybe) +import System.Directory (doesDirectoryExist, makeAbsolute) +import System.Environment (lookupEnv, setEnv) import System.Exit (exitFailure) +import System.FilePath (()) import System.IO import System.Random (randomIO) @@ -117,25 +125,54 @@ setSeed :: Bool -> ModuleConfig -> IO ModuleConfig setSeed quiet cfg@ModuleConfig{cfgRandomizeOrder=True, cfgSeed=Nothing} = do - -- Using an abslute number to prevent copy+paste errors + -- Using an absolute number to prevent copy+paste errors seed <- abs <$> randomIO unless quiet $ putStrLn ("Using freshly generated seed to randomize test order: " <> show seed) pure cfg{cfgSeed=Just seed} setSeed _quiet cfg = pure cfg +-- | @GHC_PACKAGE_PATH@. Here as a variable to prevent typos. +gHC_PACKAGE_PATH :: String +gHC_PACKAGE_PATH = "GHC_PACKAGE_PATH" + +-- | Add locally built package to @GHC_PACKAGE_PATH@ if a Nix environment is +-- detected. +addLocalNixPackageToGhcPath :: IO () +addLocalNixPackageToGhcPath = do + lookupEnv "NIX_BUILD_TOP" >>= \case + Nothing -> pure () + Just _ -> do + pkgDb <- makeAbsolute ("dist" "package.conf.inplace") + ghcPackagePath <- fromMaybe "" <$> lookupEnv gHC_PACKAGE_PATH + + -- Don't add package db if it is already mentioned on path + unless ((pkgDb ++ ":") `isInfixOf` ghcPackagePath) $ + -- Only add package db if it exists on disk + whenM (doesDirectoryExist pkgDb) $ + setEnv gHC_PACKAGE_PATH (pkgDb ++ ":" ++ ghcPackagePath) + -- | Run doctest for given library and config. Produce a summary of all tests. run :: Library -> Config -> IO Summary run lib Config{..} = do + when cfgNix addLocalNixPackageToGhcPath + let implicitPrelude = DisableExtension ImplicitPrelude `notElem` libDefaultExtensions lib (includeArgs, moduleArgs, otherGhciArgs) = libraryToGhciArgs lib evalGhciArgs = otherGhciArgs ++ ["-XNoImplicitPrelude"] + -- Nix doesn't always expose the GHC library (_specifically_ the GHC lib) even + -- if a package lists it as a dependency. This simply always exposes it as a + -- workaround. + nixGhciArgs + | cfgNix = ["-package", "ghc"] + | otherwise = [] + modConfig <- setSeed cfgQuiet cfgModuleConfig -- get examples from Haddock comments - allModules <- getDocTests (includeArgs ++ moduleArgs ++ otherGhciArgs) + allModules <- getDocTests (includeArgs ++ moduleArgs ++ otherGhciArgs ++ nixGhciArgs) runModules modConfig cfgThreads cfgVerbose implicitPrelude evalGhciArgs cfgQuiet (filterModules cfgModules allModules) diff --git a/src/Test/DocTest/Internal/Options.hs b/src/Test/DocTest/Internal/Options.hs --- a/src/Test/DocTest/Internal/Options.hs +++ b/src/Test/DocTest/Internal/Options.hs @@ -39,6 +39,7 @@ , "† --randomize-order randomize order in which tests are run" , "† --seed=N use a specific seed to randomize test order" , "† --preserve-it preserve the `it` variable between examples" + , " --nix account for Nix build environments (default)" , " --verbose print each test as it is run" , " --quiet only print errors" , " --help display this help and exit" @@ -46,6 +47,7 @@ , " --info output machine-readable version information and exit" , "" , "Supported inverted options:" + , " --no-nix" , "† --no-implicit-module-import" , "† --no-randomize-order (default)" , "† --no-preserve-it (default)" @@ -98,6 +100,9 @@ -- ^ Only print error messages, no status or progress messages (default: @False@) , cfgModuleConfig :: ModuleConfig -- ^ Options specific to modules + , cfgNix :: Bool + -- ^ Detect Nix build environment and try to make GHC aware of the local package + -- being tested. } deriving (Show, Eq, Generic, NFData) data ModuleConfig = ModuleConfig @@ -129,6 +134,7 @@ , cfgThreads = Nothing , cfgQuiet = False , cfgModuleConfig = defaultModuleConfig + , cfgNix = True } parseLocatedModuleOptions :: @@ -167,6 +173,8 @@ "--version" -> ResultStdout versionInfo "--verbose" -> go config{cfgVerbose=True} args "--quiet" -> go config{cfgQuiet=True} args + "--nix" -> go config{cfgNix=True} args + "--no-nix" -> go config{cfgNix=False} args ('-':_) | Just n <- parseThreads arg -> go config{cfgThreads=Just n} args ('-':_) -- Module specific configuration options diff --git a/src/Test/DocTest/Internal/Runner.hs b/src/Test/DocTest/Internal/Runner.hs --- a/src/Test/DocTest/Internal/Runner.hs +++ b/src/Test/DocTest/Internal/Runner.hs @@ -13,7 +13,7 @@ import Data.Function (on) import Data.List (sortBy) import Data.Maybe (fromMaybe, maybeToList) -import GHC.Conc (numCapabilities) +import GHC.Conc (getNumProcessors) import System.IO (hPutStrLn, hPutStr, stderr, hIsTerminalDevice) import System.Random (randoms, mkStdGen) import Text.Printf (printf) @@ -74,7 +74,7 @@ :: ModuleConfig -- ^ Configuration options specific to module -> Maybe Int - -- ^ Number of threads to use. Defaults to 'numCapabilities'. + -- ^ Number of threads to use. Defaults to 'getNumProcessors'. -> Bool -- ^ Verbose -> Bool @@ -90,9 +90,10 @@ isInteractive <- hIsTerminalDevice stderr -- Start a thread pool. It sends status updates to this thread through 'output'. + nCores <- getNumProcessors (input, output) <- makeThreadPool - (fromMaybe numCapabilities nThreads) + (fromMaybe nCores nThreads) (runModule modConfig implicitPrelude args) -- Send instructions to threads diff --git a/test/MainSpec.hs b/test/MainSpec.hs --- a/test/MainSpec.hs +++ b/test/MainSpec.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiWayIf #-} module MainSpec (main, spec) where @@ -37,15 +38,20 @@ spec :: Spec spec = do - env <- runIO getEnvironment + env <- Map.fromList <$> runIO getEnvironment + let cDescribe = - -- Don't run doctests as part of the Stack testsuite yet, pending - -- https://github.com/commercialhaskell/stack/issues/5662 - if "STACK_EXE" `Map.member` Map.fromList env then - xdescribe - else - describe + if + -- Don't run doctests as part of the Stack testsuite yet, pending + -- https://github.com/commercialhaskell/stack/issues/5662 + | "STACK_EXE" `Map.member` env -> xdescribe + + -- Don't run doctests as part of a Nix build. Similar to Stack, Nix + -- doesn't seem to deal with private libraries yet. + | "NIX_BUILD_TOP" `Map.member` env -> xdescribe + + | otherwise -> describe cDescribe "doctest" $ do it "testSimple" $