diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,9 @@ -Changes in 0.1 - - First release! +# 0.2 +Changes: + * Support for GHC 9.2 has been added ([#4](https://github.com/martijnbastiaan/doctest-parallel/pull/4)) + * Support for GHC 8.2 has been dropped ([#3](https://github.com/martijnbastiaan/doctest-parallel/pull/3)) + * The dependency `cabal-install-parsers` has been dropped. This trims the dependency tree quite a bit [#3](https://github.com/martijnbastiaan/doctest-parallel/pull/3) + * The Hackage distribution now ships all files necessary to run `doctest-parallel`'s tests (Fixes [#1](https://github.com/martijnbastiaan/doctest-parallel/issues/1), PR [#2](https://github.com/martijnbastiaan/doctest-parallel/pull/2)) +# 0.1 +Fresh fork from `sol/doctest`. See the README for an overview of all the changes. diff --git a/cabal.project b/cabal.project new file mode 100644 --- /dev/null +++ b/cabal.project @@ -0,0 +1,4 @@ +packages: + ./ + +write-ghc-environment-files: always diff --git a/doctest-parallel.cabal b/doctest-parallel.cabal --- a/doctest-parallel.cabal +++ b/doctest-parallel.cabal @@ -1,7 +1,7 @@ -cabal-version: 3.0 +cabal-version: 2.0 name: doctest-parallel -version: 0.1 +version: 0.2 synopsis: Test interactive Haskell examples description: The doctest program checks examples in source code comments. It is modeled after doctest for Python (). @@ -17,8 +17,7 @@ maintainer: Martijn Bastiaan build-type: Simple tested-with: - GHC == 8.2.2 - , GHC == 8.4.4 + GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 @@ -27,9 +26,35 @@ example/example.cabal example/src/Example.hs example/test/doctests.hs + cabal.project CHANGES.markdown README.markdown + -- Rather annoyingly, Cabal implements arbitrary limitations in their file + -- globbing, one of them being that a wildcard can't be used to match + -- directories. Hence, we list them here individually. + test/extract/argument-list/*.hs + test/extract/comment-order/*.hs + test/extract/declaration/*.hs + test/extract/dos-line-endings/*.hs + test/extract/export-list/*.hs + test/extract/imported-module/*.hs + test/extract/module-header/*.hs + test/extract/named-chunks/*.hs + test/extract/regression/*.hs + test/extract/setup/*.hs + test/extract/th/*.hs + test/extract/type-class/*.hs + test/extract/type-class-args/*.hs + test/extract/type-families/*.hs + test/parse/multiple-examples/*.hs + test/parse/no-examples/*.hs + test/parse/non-exported/*.hs + test/parse/property/*.hs + test/parse/setup-empty/*.hs + test/parse/setup-only/*.hs + test/parse/simple/*.hs + source-repository head type: git location: https://github.com/martijnbastiaan/doctest-parallel @@ -53,23 +78,22 @@ Test.DocTest.Internal.Runner.Example Test.DocTest.Internal.Util Language.Haskell.GhciWrapper - other-modules: - Paths_doctest_parallel autogen-modules: Paths_doctest_parallel + other-modules: + Paths_doctest_parallel build-depends: Cabal , Glob , base >=4.10 && <5 , base-compat >=0.7.0 - , cabal-install-parsers , code-page >=0.1 , containers , deepseq , directory , exceptions , filepath - , ghc >=7.10 && <9.1 + , ghc >=8.4 && <9.3 , ghc-paths >=0.1.0.9 , pretty , process @@ -166,7 +190,7 @@ , directory , exceptions , filepath - , ghc >=7.0 && <9.1 + , ghc , ghc-paths >=0.1.0.9 , hspec >=2.3.0 , hspec-core >=2.3.0 diff --git a/src/Test/DocTest/Helpers.hs b/src/Test/DocTest/Helpers.hs --- a/src/Test/DocTest/Helpers.hs +++ b/src/Test/DocTest/Helpers.hs @@ -21,19 +21,20 @@ import Distribution.ModuleName (ModuleName) import Distribution.Simple ( Extension (DisableExtension, EnableExtension, UnknownExtension) ) +import Distribution.Types.UnqualComponentName ( unUnqualComponentName ) import Distribution.PackageDescription ( CondTree(CondNode, condTreeData), GenericPackageDescription (condLibrary) , exposedModules, libBuildInfo, hsSourceDirs, defaultExtensions, package , packageDescription, condSubLibraries ) import Distribution.Pretty (prettyShow) -import Distribution.Types.UnqualComponentName (unUnqualComponentName) +import Distribution.Verbosity (silent) #if MIN_VERSION_Cabal(3,6,0) import Distribution.Utils.Path (SourceDir, PackageDir, SymbolicPath) #endif -- cabal-install-parsers -import Cabal.Package (readPackage) +import Distribution.PackageDescription.Parsec (readGenericPackageDescription) data Library = Library { libSourceDirectories :: [FilePath] @@ -118,7 +119,7 @@ -- a specific sublibrary. extractSpecificCabalLibrary :: Maybe String -> FilePath -> IO Library extractSpecificCabalLibrary maybeLibName pkgPath = do - pkg <- readPackage pkgPath + pkg <- readGenericPackageDescription silent pkgPath case maybeLibName of Nothing -> case condLibrary pkg of diff --git a/src/Test/DocTest/Internal/Extract.hs b/src/Test/DocTest/Internal/Extract.hs --- a/src/Test/DocTest/Internal/Extract.hs +++ b/src/Test/DocTest/Internal/Extract.hs @@ -50,6 +50,10 @@ #endif #endif +#if __GLASGOW_HASKELL__ >= 901 +import GHC.Unit.Module.Graph +#endif + -- | A wrapper around `SomeException`, to allow for a custom `Show` instance. newtype ExtractError = ExtractError SomeException deriving Typeable @@ -84,12 +88,6 @@ #if __GLASGOW_HASKELL__ < 803 type GhcPs = RdrName - -needsTemplateHaskellOrQQ :: ModuleGraph -> Bool -needsTemplateHaskellOrQQ = needsTemplateHaskell - -mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph -mapMG = map #endif #if __GLASGOW_HASKELL__ < 805 @@ -100,30 +98,21 @@ -- | Parse a list of modules. parse :: [String] -> IO [ParsedModule] parse args = withGhc args $ \modules -> withTempOutputDir $ do - - mapM (`guessTarget` Nothing) modules >>= setTargets + setTargets =<< forM modules (\ m -> guessTarget m +#if __GLASGOW_HASKELL__ >= 903 + Nothing +#endif + Nothing) mods <- depanal [] False - mods' <- if needsTemplateHaskellOrQQ mods then enableCompilation mods else return mods - - let sortedMods = flattenSCCs (topSortModuleGraph False mods' Nothing) - reverse <$> mapM (loadModPlugins >=> parseModule) sortedMods - where - -- copied from Haddock/Interface.hs - enableCompilation :: ModuleGraph -> Ghc ModuleGraph - enableCompilation modGraph = do -#if __GLASGOW_HASKELL__ < 809 - let enableComp d = let platform = targetPlatform d - in d { hscTarget = defaultObjectTarget platform } -#else - let enableComp d = d { hscTarget = defaultObjectTarget d } + let sortedMods = flattenSCCs +#if __GLASGOW_HASKELL__ >= 901 + $ filterToposortToModules #endif - modifySessionDynFlags enableComp - -- We need to update the DynFlags of the ModSummaries as well. - let upd m = m { ms_hspp_opts = enableComp (ms_hspp_opts m) } - let modGraph' = mapMG upd modGraph - return modGraph' + $ topSortModuleGraph False mods Nothing + reverse <$> mapM (loadModPlugins >=> parseModule) sortedMods + where -- copied from Haddock/GhcUtils.hs modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc () modifySessionDynFlags f = do @@ -161,12 +150,25 @@ , includePaths = addQuoteInclude (includePaths d) [f] } + #if __GLASGOW_HASKELL__ >= 806 -- Since GHC 8.6, plugins are initialized on a per module basis loadModPlugins modsum = do + _ <- setSessionDynFlags (GHC.ms_hspp_opts modsum) hsc_env <- getSession + +# if __GLASGOW_HASKELL__ >= 903 + hsc_env' <- liftIO (initializePlugins hsc_env Nothing) + setSession hsc_env' + return $ modsum +# elif __GLASGOW_HASKELL__ >= 901 + hsc_env' <- liftIO (initializePlugins hsc_env) + setSession hsc_env' + return $ modsum +# else dynflags' <- liftIO (initializePlugins hsc_env (GHC.ms_hspp_opts modsum)) return $ modsum { ms_hspp_opts = dynflags' } +# endif #else loadModPlugins = return #endif @@ -210,11 +212,15 @@ -- traversing the whole source in a generic way, to ensure that we get -- everything in source order. header = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]] -#if __GLASGOW_HASKELL__ < 805 - exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)] + exports = [ (Nothing, L (locA loc) doc) +#if __GLASGOW_HASKELL__ < 710 + | L loc (IEDoc doc) <- concat (hsmodExports source) +#elif __GLASGOW_HASKELL__ < 805 + | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source) #else - exports = [(Nothing, L loc doc) | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)] + | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source) #endif + ] decls = extractDocStrings (hsmodDecls source) type Selector a = a -> ([(Maybe String, LHsDocString)], Bool) @@ -237,16 +243,23 @@ -- no location information attached. The location information is -- attached to HsDecl instead. #if __GLASGOW_HASKELL__ < 805 - DocD x -> select (fromDocDecl loc x) + DocD x #else - DocD _ x -> select (fromDocDecl loc x) + DocD _ x #endif + -> select (fromDocDecl (locA loc) x) _ -> (extractDocStrings decl, True) - fromLDocDecl :: Selector LDocDecl - fromLDocDecl (L loc x) = select (fromDocDecl loc x) + fromLDocDecl :: Selector +#if __GLASGOW_HASKELL__ >= 901 + (LDocDecl GhcPs) +#else + LDocDecl +#endif + fromLDocDecl (L loc x) = select (fromDocDecl (locA loc) x) + fromLHsDocString :: Selector LHsDocString fromLHsDocString x = select (Nothing, x) @@ -259,4 +272,9 @@ -- | Convert a docstring to a plain string. unpackHDS :: HsDocString -> String unpackHDS (HsDocString s) = unpackFS s +#endif + +#if __GLASGOW_HASKELL__ < 901 +locA :: SrcSpan -> SrcSpan +locA = id #endif diff --git a/src/Test/DocTest/Internal/GhcUtil.hs b/src/Test/DocTest/Internal/GhcUtil.hs --- a/src/Test/DocTest/Internal/GhcUtil.hs +++ b/src/Test/DocTest/Internal/GhcUtil.hs @@ -42,8 +42,15 @@ handleDynamicFlags :: GhcMonad m => [Located String] -> m [String] handleDynamicFlags flags = do - (dynflags, locSrcs, _) <- (setHaddockMode `fmap` getSessionDynFlags) >>= flip parseDynamicFlags flags - _ <- setSessionDynFlags dynflags +#if __GLASGOW_HASKELL__ >= 901 + logger <- getLogger + let parseDynamicFlags' = parseDynamicFlags logger +#else + let parseDynamicFlags' = parseDynamicFlags +#endif + dynflags0 <- setHaddockMode <$> getSessionDynFlags + (dynflags1, locSrcs, _) <- parseDynamicFlags' dynflags0 flags + _ <- setSessionDynFlags dynflags1 -- We basically do the same thing as `ghc/Main.hs` to distinguish -- "unrecognised flags" from source files. @@ -55,7 +62,11 @@ setHaddockMode :: DynFlags -> DynFlags setHaddockMode dynflags = (gopt_set dynflags Opt_Haddock) { +#if __GLASGOW_HASKELL__ >= 901 + backend = NoBackend +#else hscTarget = HscNothing +#endif , ghcMode = CompManager , ghcLink = NoLink } diff --git a/test/extract/argument-list/Foo.hs b/test/extract/argument-list/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/argument-list/Foo.hs @@ -0,0 +1,6 @@ +module Foo where + +foo :: Int -- ^ doc for arg1 + -> Int -- ^ doc for arg2 + -> Int +foo = undefined diff --git a/test/extract/comment-order/Foo.hs b/test/extract/comment-order/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/comment-order/Foo.hs @@ -0,0 +1,28 @@ +-- | module header +module Foo ( + +-- * some heading +-- | export list 1 + foo + +-- * some other heading +-- | export list 2 +, bar + +-- * one more heading +-- $foo +, baz +) where + +-- | foo +foo :: Int +foo = 23 + +-- $foo named chunk + +-- | bar +bar :: Int +bar = 23 + +baz :: Int +baz = 23 diff --git a/test/extract/declaration/Foo.hs b/test/extract/declaration/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/declaration/Foo.hs @@ -0,0 +1,5 @@ +module Foo where + +-- | Some documentation +foo :: Int +foo = 23 diff --git a/test/extract/dos-line-endings/Foo.hs b/test/extract/dos-line-endings/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/dos-line-endings/Foo.hs @@ -0,0 +1,8 @@ +module Foo where + +-- | +-- foo +-- bar +-- baz +foo :: Int +foo = 23 diff --git a/test/extract/export-list/Foo.hs b/test/extract/export-list/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/export-list/Foo.hs @@ -0,0 +1,12 @@ +module Foo ( +-- * some heading +-- | documentation from export list + foo +, bar +) where + +foo :: Int +foo = 23 + +bar :: Int +bar = 23 diff --git a/test/extract/imported-module/Bar.hs b/test/extract/imported-module/Bar.hs new file mode 100644 --- /dev/null +++ b/test/extract/imported-module/Bar.hs @@ -0,0 +1,7 @@ +module Bar where + +import Baz + +-- | documentation for bar +bar :: Int +bar = 23 diff --git a/test/extract/imported-module/Baz.hs b/test/extract/imported-module/Baz.hs new file mode 100644 --- /dev/null +++ b/test/extract/imported-module/Baz.hs @@ -0,0 +1,5 @@ +module Baz where + +-- | documentation for baz +baz :: Int +baz = 23 diff --git a/test/extract/module-header/Foo.hs b/test/extract/module-header/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/module-header/Foo.hs @@ -0,0 +1,5 @@ +-- | Some documentation +module Foo where + +foo :: Int +foo = 23 diff --git a/test/extract/named-chunks/Foo.hs b/test/extract/named-chunks/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/named-chunks/Foo.hs @@ -0,0 +1,15 @@ +module Foo ( + foo +, bar +) where + +-- $foo named chunk foo + +-- $bar +-- named chunk bar + +foo :: Int +foo = 23 + +bar :: Int +bar = 23 diff --git a/test/extract/regression/Fixity.hs b/test/extract/regression/Fixity.hs new file mode 100644 --- /dev/null +++ b/test/extract/regression/Fixity.hs @@ -0,0 +1,4 @@ +module Fixity where + +foo :: Int +foo = 23 + 42 diff --git a/test/extract/regression/ForeignImport.hs b/test/extract/regression/ForeignImport.hs new file mode 100644 --- /dev/null +++ b/test/extract/regression/ForeignImport.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module ForeignImport where +import Foreign.C + +import Prelude hiding (sin) + +-- pure function +foreign import ccall "sin" c_sin :: CDouble -> CDouble +sin :: Double -> Double +sin d = realToFrac (c_sin (realToFrac d)) diff --git a/test/extract/regression/ParallelListComp.hs b/test/extract/regression/ParallelListComp.hs new file mode 100644 --- /dev/null +++ b/test/extract/regression/ParallelListComp.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE ParallelListComp #-} +module ParallelListComp where + +foo :: [Int] +foo = [x+y | x <- [1,2,3] | y <- [4,5,6]] diff --git a/test/extract/regression/ParallelListCompClass.hs b/test/extract/regression/ParallelListCompClass.hs new file mode 100644 --- /dev/null +++ b/test/extract/regression/ParallelListCompClass.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE ParallelListComp #-} +module ParallelListCompClass where + +class Foo a where + foo :: a -> [Int] + +instance Foo Int where + foo _ = [x+y | x <- [1,2,3] | y <- [4,5,6]] diff --git a/test/extract/regression/RewriteRules.hs b/test/extract/regression/RewriteRules.hs new file mode 100644 --- /dev/null +++ b/test/extract/regression/RewriteRules.hs @@ -0,0 +1,7 @@ +module RewriteRules (foo) where + +{-# RULES "map/append" forall f xs ys. map f (xs ++ ys) = map f xs ++ map f ys #-} + +-- | doc for foo +foo :: Int +foo = 23 diff --git a/test/extract/regression/RewriteRulesWithSigs.hs b/test/extract/regression/RewriteRulesWithSigs.hs new file mode 100644 --- /dev/null +++ b/test/extract/regression/RewriteRulesWithSigs.hs @@ -0,0 +1,7 @@ +module RewriteRulesWithSigs (foo) where + +{-# RULES "map/append" forall f (xs :: [Int]) ys. map f (xs ++ ys) = map f xs ++ map f ys #-} + +-- | doc for foo +foo :: Int +foo = 23 diff --git a/test/extract/setup/Foo.hs b/test/extract/setup/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/setup/Foo.hs @@ -0,0 +1,16 @@ +module Foo where + +-- $setup +-- some setup code + +-- | foo +foo :: Int +foo = 42 + +-- | bar +bar :: Int +bar = 42 + +-- | baz +baz :: Int +baz = 42 diff --git a/test/extract/th/Bar.hs b/test/extract/th/Bar.hs new file mode 100644 --- /dev/null +++ b/test/extract/th/Bar.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Bar where + +import Language.Haskell.TH.Lib (ExpQ) + +bar :: ExpQ +bar = [| 23 |] diff --git a/test/extract/th/Foo.hs b/test/extract/th/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/th/Foo.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +module Foo where + +import Bar + +-- | some documentation +foo :: Int +foo = $(bar) diff --git a/test/extract/type-class-args/Foo.hs b/test/extract/type-class-args/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/type-class-args/Foo.hs @@ -0,0 +1,8 @@ +module Foo where + + +class Foo a where + + bar :: a -- ^ foo + -> Int -- ^ bar + -> String diff --git a/test/extract/type-class/Foo.hs b/test/extract/type-class/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/type-class/Foo.hs @@ -0,0 +1,7 @@ +module Foo where + + +class ToString a where + + -- | Convert given value to a string. + toString :: a -> String diff --git a/test/extract/type-families/Foo.hs b/test/extract/type-families/Foo.hs new file mode 100644 --- /dev/null +++ b/test/extract/type-families/Foo.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeFamilies #-} +module Foo where + +type family Foo a + +type instance Foo Int = Int diff --git a/test/integration/ModuleIsolation/TestA.hs b/test/integration/ModuleIsolation/TestA.hs --- a/test/integration/ModuleIsolation/TestA.hs +++ b/test/integration/ModuleIsolation/TestA.hs @@ -3,12 +3,11 @@ import ModuleIsolation.TestB () {- $setup ->>> :set -XTypeApplications +>>> :set -XLambdaCase -} --- | Example usage: --- --- >>> foo @Int --- 3 +-- | +-- >>> (\case { 3 -> 5; 7 -> 9}) 3 +-- 5 foo :: Num a => a foo = 3 diff --git a/test/integration/ModuleIsolation/TestB.hs b/test/integration/ModuleIsolation/TestB.hs --- a/test/integration/ModuleIsolation/TestB.hs +++ b/test/integration/ModuleIsolation/TestB.hs @@ -2,7 +2,7 @@ -- | Example usage: -- --- >>> bar @Int --- 3 +-- >>> (\case { 3 -> 5; 7 -> 9}) 3 +-- 5 bar :: Num a => a bar = 3 diff --git a/test/parse/multiple-examples/Foo.hs b/test/parse/multiple-examples/Foo.hs new file mode 100644 --- /dev/null +++ b/test/parse/multiple-examples/Foo.hs @@ -0,0 +1,11 @@ +module Foo where + +-- | +-- >>> foo +-- 23 +foo = 23 + +-- | +-- >>> bar +-- 42 +bar = 42 diff --git a/test/parse/no-examples/Fib.hs b/test/parse/no-examples/Fib.hs new file mode 100644 --- /dev/null +++ b/test/parse/no-examples/Fib.hs @@ -0,0 +1,10 @@ +module Fib where + +-- | Calculate Fibonacci numbers. +-- @ +-- some code +-- @ +-- +-- foobar 23 +fib :: Int -> Int -> Int +fib _ = undefined diff --git a/test/parse/non-exported/Fib.hs b/test/parse/non-exported/Fib.hs new file mode 100644 --- /dev/null +++ b/test/parse/non-exported/Fib.hs @@ -0,0 +1,16 @@ +module Fib (foo) where + +foo :: Int +foo = 23 + +-- | Calculate Fibonacci number of given 'Num'. +-- +-- >>> putStrLn "foo" +-- foo +-- >>> putStr "bar" +-- bar +-- +-- >>> putStrLn "baz" +-- baz +fib :: (Num t, Num t1) => t -> t1 +fib _ = undefined diff --git a/test/parse/property/Fib.hs b/test/parse/property/Fib.hs new file mode 100644 --- /dev/null +++ b/test/parse/property/Fib.hs @@ -0,0 +1,15 @@ +module Fib where + +-- | Calculate Fibonacci numbers. +-- +-- prop> foo +-- +-- some text +-- +-- prop> bar +-- +-- some more text +-- +-- prop> baz +fib :: Int -> Int -> Int +fib _ = undefined diff --git a/test/parse/setup-empty/Foo.hs b/test/parse/setup-empty/Foo.hs new file mode 100644 --- /dev/null +++ b/test/parse/setup-empty/Foo.hs @@ -0,0 +1,10 @@ +module Foo where + +-- $setup +-- some setup code + +-- | +-- >>> foo +-- 23 +foo :: Int +foo = 23 diff --git a/test/parse/setup-only/Foo.hs b/test/parse/setup-only/Foo.hs new file mode 100644 --- /dev/null +++ b/test/parse/setup-only/Foo.hs @@ -0,0 +1,9 @@ +module Foo where + +-- $setup +-- >>> foo +-- 23 + +-- | some documentation +foo :: Int +foo = 23 diff --git a/test/parse/simple/Fib.hs b/test/parse/simple/Fib.hs new file mode 100644 --- /dev/null +++ b/test/parse/simple/Fib.hs @@ -0,0 +1,13 @@ +module Fib where + +-- | Calculate Fibonacci numbers. +-- +-- >>> putStrLn "foo" +-- foo +-- >>> putStr "bar" +-- bar +-- +-- >>> putStrLn "baz" +-- baz +fib :: Int -> Int -> Int +fib _ = undefined