doctest 0.13.0 → 0.14.0
raw patch · 20 files changed
+1865/−93 lines, 20 filesdep ~QuickCheckdep ~basedep ~base-compatPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: QuickCheck, base, base-compat, code-page, ghc, ghc-paths, syb
API changes (from Hackage documentation)
Files
- CHANGES +107/−0
- README.markdown +423/−0
- doctest.cabal +144/−87
- src/Extract.hs +13/−3
- src/Interpreter.hs +8/−1
- src/Runner.hs +9/−2
- test/ExtractSpec.hs +88/−0
- test/InterpreterSpec.hs +30/−0
- test/LocationSpec.hs +43/−0
- test/MainSpec.hs +169/−0
- test/OptionsSpec.hs +60/−0
- test/Orphans.hs +16/−0
- test/PackageDBsSpec.hs +73/−0
- test/ParseSpec.hs +205/−0
- test/PropertySpec.hs +130/−0
- test/RunSpec.hs +134/−0
- test/Runner/ExampleSpec.hs +83/−0
- test/RunnerSpec.hs +91/−0
- test/SandboxSpec.hs +18/−0
- test/UtilSpec.hs +21/−0
+ CHANGES view
@@ -0,0 +1,107 @@+Changes in 0.14.0+ - GHC 8.4 compatibility.++Changes in 0.13.0+ - Add `--preserve-it` for allowing the `it` variable to be preserved between examples++Changes in 0.12.0+ - Preserve the 'it' variable between examples++Changes in 0.11.4+ - Add `--fast`, which disables running `:reload` between example groups++Changes in 0.11.3+ - Add `--info`+ - Add `--no-magic`++Changes in 0.11.2+ - Make `...` match zero lines++Changes in 0.11.1+ - Fix an issue with Unicode output on Windows (see #149)++Changes in 0.11.0+ - Support for GHC 8.0.1-rc2++Changes in 0.10.1+ - Automatically expand directories into contained Haskell source files (thanks @snoyberg)+ - Add cabal_macros.h and autogen dir by default (thanks @snoyberg)++Changes in 0.10.0+ - Support HASKELL_PACKAGE_SANDBOXES (thanks @snoyberg)++Changes in 0.9.13+ - Add ellipsis as wildcard++Changes in 0.9.12+ - Add support for GHC 7.10++Changes in 0.9.11+ - Defaults ambiguous type variables to Integer (#74)++Changes in 0.9.10+ - Add support for the upcoming GHC 7.8 release++Changes in 0.9.9+ - Add support for multi-line statements++Changes in 0.9.8+ - Support for GHC HEAD (7.7)++Changes in 0.9.7+ - Ignore trailing whitespace when matching example output++Changes in 0.9.6+ - Fail gracefully if GHCi is not supported (#46)++Changes in 0.9.5+ - Fix a GHC panic with GHC 7.6.1 (#41)++Changes in 0.9.4+ - Respect HASKELL_PACKAGE_SANDBOX (#39)+ - Print path to ghc on --version++Changes in 0.9.3+ - Properly handle additional object files (#38)++Changes in 0.9.2+ - Add support for QuickCheck properties++Changes in 0.9.1+ - Fix an issue with GHC 7.6.1 and type families++Changes in 0.9.0+ - Add support for setup code (see README).+ - There is no distinction between example/interaction anymore. Each+ expression is counted as an example in the summary.++Changes in 0.8.0+ - Doctest now directly accepts arbitrary GHC options, prefixing GHC options+ with --optghc is no longer necessary++Changes in 0.7.0+ - Print source location for failing tests+ - Output less clutter on failing examples+ - Expose Doctest's functionality through a very simplistic API, which can be+ used for cabal integration++Changes in 0.6.1+ - Fix a parser bug with CR+LF line endings++Changes in 0.6.0+ - Support for ghc-7.4+ - Doctest now comes with it's own parser and does not depend on Haddock+ anymore++Changes in 0.5.2+ - Proper handling of singular/plural when printing stats+ - Improve handling of invalid command line options++Changes in 0.5.1+ - Adapted for ghc-7.2++Changes in 0.5.0+ - Print number of interactions to stderr before running tests+ - Exit with exitFailure on failed tests+ - Improve documentation+ - Give a useful error message if ghc is not executable
+ README.markdown view
@@ -0,0 +1,423 @@+# Doctest: Test interactive Haskell examples++`doctest` is a small program, that checks [examples in Haddock comments](http://www.haskell.org/haddock/doc/html/ch03s08.html#id566093). It is similar+to the [popular Python module with the same name](http://docs.python.org/library/doctest.html).+++## Installation++`doctest` is available from+[Hackage](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/doctest).+Install it, by typing:++ cabal install doctest++Make sure that Cabal's `bindir` is on your `PATH`.++On Linux:++ export PATH="$HOME/.cabal/bin:$PATH"++On Mac OS X:++ export PATH="$HOME/Library/Haskell/bin:$PATH"++On Windows it's `C:\Documents And Settings\user\Application Data\cabal\bin`.++For more information, see the [section on paths in the Cabal User Guide](http://www.haskell.org/cabal/users-guide/installing-packages.html#paths-in-the-simple-build-system).++## Usage++Below is a small Haskell module.+The module contains a Haddock comment with some examples of interaction.+The examples demonstrate how the module is supposed to be used.++```haskell+module Fib where++-- | Compute Fibonacci numbers+--+-- Examples:+--+-- >>> fib 10+-- 55+--+-- >>> fib 5+-- 5+fib :: Int -> Int+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)+```++(A comment line starting with `>>>` denotes an _expression_.+All comment lines following an expression denote the _result_ of that expression.+Result is defined by what an+[REPL](http://en.wikipedia.org/wiki/Read-eval-print_loop) (e.g. ghci)+prints to `stdout` and `stderr` when evaluating that expression.)++With `doctest` you may check whether the implementation satisfies the given examples, by typing:++ doctest Fib.hs++You may produce Haddock documentation for that module with:++ haddock -h Fib.hs -o doc/++### Example groups++Examples from a single Haddock comment are grouped together and share the same+scope. E.g. the following works:++```haskell+-- |+-- >>> let x = 23+-- >>> x + 42+-- 65+```++If an example fails, subsequent examples from the same group are skipped. E.g.+for++```haskell+-- |+-- >>> let x = 23+-- >>> let n = x + y+-- >>> print n+```++`print n` is not tried, because `let n = x + y` fails (`y` is not in scope!).++#### A note on performance++By default, `doctest` calls `:reload` between each group to clear GHCi's scope+of any local definitions. This ensures that previous examples cannot influence+later ones. However, it can lead to performance penalties if you are using+`doctest` in a project with many modules. One possible remedy is to pass the+`--fast` flag to `doctest`, which disables calling `:reload` between groups.+If `doctest`s are running too slowly, you might consider using `--fast`.+(With the caveat that the order in which groups appear now matters!)++However, note that due to a+[bug on GHC 8.2.1 or later](https://ghc.haskell.org/trac/ghc/ticket/14052),+the performance of `--fast` suffers significantly when combined with the+`--preserve-it` flag (which keeps the value of GHCi's `it` value between+examples).++### Setup code++You can put setup code in a [named chunk][named-chunks] with the name `$setup`.+The setup code is run before each example group. If the setup code produces+any errors/failures, all tests from that module are skipped.++Here is an example:++```haskell+module Foo where++import Bar.Baz++-- $setup+-- >>> let x = 23 :: Int++-- |+-- >>> foo + x+-- 65+foo :: Int+foo = 42+```++Note that you should not place setup code inbetween the module header (`module+... where`) and import declarations. GHC will not be able to parse it ([issue+ #167](https://github.com/sol/doctest/issues/167)). It is best to place setup+code right after import declarations, but due to its declarative nature you can+place it anywhere inbetween top level declarations as well.+++### Multi-line input+GHCi supports commands which span multiple lines, and the same syntax works for doctest:++```haskell+-- |+-- >>> :{+-- let+-- x = 1+-- y = 2+-- in x + y + multiline+-- :}+-- 6+multiline = 3+```++Note that `>>>` can be left off for the lines following the first: this is so that+haddock does not strip leading whitespace. The expected output has whitespace+stripped relative to the :}.++Some peculiarities on the ghci side mean that whitespace at the very start is lost.+This breaks the example `broken`, since the the x and y are aligned from ghci's+perspective. A workaround is to avoid leading space, or add a newline such+that the indentation does not matter:++```haskell+{- | >>> :{+let x = 1+ y = 2+ in x + y + works+:}+6+-}+works = 3++{- | >>> :{+ let x = 1+ y = 2+ in x + y + broken+:}+3+-}+broken = 3+```++### Multi-line output+If there are no blank lines in the output, multiple lines are handled+automatically.++```haskell+-- | >>> putStr "Hello\nWorld!"+-- Hello+-- World!+```++If however the output contains blank lines, they must be noted+explicitly with `<BLANKLINE>`. For example,++```haskell+import Data.List ( intercalate )++-- | Double-space a paragraph.+--+-- Examples:+--+-- >>> let s1 = "\"Every one of whom?\""+-- >>> let s2 = "\"Every one of whom do you think?\""+-- >>> let s3 = "\"I haven't any idea.\""+-- >>> let paragraph = unlines [s1,s2,s3]+-- >>> putStrLn $ doubleSpace paragraph+-- "Every one of whom?"+-- <BLANKLINE>+-- "Every one of whom do you think?"+-- <BLANKLINE>+-- "I haven't any idea."+--+doubleSpace :: String -> String+doubleSpace = (intercalate "\n\n") . lines+```++### Matching arbitrary output+Any lines containing only three dots (`...`) will match one or more lines with+arbitrary content. For instance,++```haskell+-- |+-- >>> putStrLn "foo\nbar\nbaz"+-- foo+-- ...+-- baz+```++If a line contains three dots and additional content, the three dots will match+anything *within that line*:++```haskell+-- |+-- >>> putStrLn "foo bar baz"+-- foo ... baz+```++### QuickCheck properties++Haddock (since version 2.13.0) has markup support for properties. Doctest can+verify properties with QuickCheck. A simple property looks like this:++```haskell+-- |+-- prop> \xs -> sort xs == (sort . sort) (xs :: [Int])+```++The lambda abstraction is optional and can be omitted:++```haskell+-- |+-- prop> sort xs == (sort . sort) (xs :: [Int])+```++A complete example that uses setup code is below:++```haskell+module Fib where++-- $setup+-- >>> import Control.Applicative+-- >>> import Test.QuickCheck+-- >>> newtype Small = Small Int deriving Show+-- >>> instance Arbitrary Small where arbitrary = Small . (`mod` 10) <$> arbitrary++-- | Compute Fibonacci numbers+--+-- The following property holds:+--+-- prop> \(Small n) -> fib n == fib (n + 2) - fib (n + 1)+fib :: Int -> Int+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)+```++If you see an error like the following, ensure that+[QuickCheck](http://hackage.haskell.org/package/QuickCheck) is a dependency+of the test-suite or executable running `doctest`.++```haskell+<interactive>:39:3:+ Not in scope: ‘polyQuickCheck’+ In the splice: $(polyQuickCheck (mkName "doctest_prop"))++<interactive>:39:3:+ GHC stage restriction:+ ‘polyQuickCheck’ is used in a top-level splice or annotation,+ and must be imported, not defined locally+ In the expression: polyQuickCheck (mkName "doctest_prop")+ In the splice: $(polyQuickCheck (mkName "doctest_prop"))+```++### Hiding examples from Haddock++You can put examples into [named chunks] [named-chunks], and not refer to them+in the export list. That way they will not be part of the generated Haddock+documentation, but Doctest will still find them.++```haskell+-- $+-- >>> 1 + 1+-- 2+```++[named-chunks]: http://www.haskell.org/haddock/doc/html/ch03s05.html++### Using GHC extensions++There's two sets of GHC extensions involved when running Doctest:++1. The set of GHC extensions that are active when compiling the module code+(excluding the doctest examples). The easiest way to specify these extensions+is through [LANGUAGE pragmas] [language-pragma] in your source files.+(Doctest will not look at your cabal file.)+2. The set of GHC extensions that are active when executing the Doctest+examples. (These are not influenced by the LANGUAGE pragmas in the file.) The+recommended way to enable extensions for Doctest examples is to switch them+on like this:++```haskell+-- |+-- >>> :set -XTupleSections+-- >>> fst' $ (1,) 2+-- 1+fst' :: (a, b) -> a+fst' = fst+```++Alternatively you can pass any GHC options to Doctest, e.g.:++ doctest -XCPP Foo.hs++These options will affect both the loading of the module and the execution of+the Doctest examples.++If you want to omit the information which language extensions are enabled from+the Doctest examples you can use the method described in [Hiding examples from+Haddock] (#hiding-examples-from-haddock), e.g.:++```haskell+-- $+-- >>> :set -XTupleSections+```++[language-pragma]: http://www.haskell.org/ghc/docs/latest/html/users_guide/pragmas.html#language-pragma++### Cabal integration++Doctest provides both, an executable and a library. The library exposes a+function `doctest` of type:++```haskell+doctest :: [String] -> IO ()+```++Doctest's own `main` is simply:++```haskell+main = getArgs >>= doctest+```++Consequently, it is possible to create a custom executable for a project, by+passing all command-line arguments that are required for that project to+`doctest`. A simple example looks like this:++```haskell+-- file doctests.hs+import Test.DocTest+main = doctest ["-isrc", "src/Main.hs"]+```++And a corresponding Cabal test suite section like this:++ test-suite doctests+ type: exitcode-stdio-1.0+ ghc-options: -threaded+ main-is: doctests.hs+ build-depends: base, doctest >= 0.8++## Doctest in the wild++You can find real world examples of `Doctest` being used below:++ * [base Data/Maybe.hs](https://github.com/ghc/ghc/blob/669cbef03c220de43b0f88f2b2238bf3c02ed64c/libraries/base/Data/Maybe.hs#L36-L79)+ * [base Data/Functor.hs](https://github.com/ghc/ghc/blob/669cbef03c220de43b0f88f2b2238bf3c02ed64c/libraries/base/Data/Functor.hs#L34-L64)+++## Doctest extensions++ * [doctest-discover](https://github.com/karun012/doctest-discover)++## Development [](http://travis-ci.org/sol/doctest)++Join in at `#hspec` on freenode.++Discuss your ideas first, ideally by opening an issue on GitHub.++Add tests for new features, and make sure that the test suite passes with your+changes.++ cabal configure --enable-tests && cabal build && cabal exec cabal test+++## Contributors++ * Adam Vogt+ * Anders Persson+ * Ankit Ahuja+ * Edward Kmett+ * Hiroki Hattori+ * Joachim Breitner+ * João Cristóvão+ * Julian Arni+ * Kazu Yamamoto+ * Levent Erkok+ * Luke Murphy+ * Matvey Aksenov+ * Michael Orlitzky+ * Michael Snoyman+ * Nick Smallbone+ * Sakari Jokinen+ * Simon Hengel+ * Sönke Hahn
doctest.cabal view
@@ -1,121 +1,178 @@-name: doctest-version: 0.13.0-synopsis: Test interactive Haskell examples-description: The doctest program checks examples in source code comments.- It is modeled after doctest for Python- (<http://docs.python.org/library/doctest.html>).- .- Documentation is at- <https://github.com/sol/doctest#readme>.-category: Testing-bug-reports: https://github.com/sol/doctest/issues-homepage: https://github.com/sol/doctest#readme-license: MIT-license-file: LICENSE-copyright: (c) 2009-2017 Simon Hengel-author: Simon Hengel <sol@typeful.net>-maintainer: Simon Hengel <sol@typeful.net>-build-type: Simple-cabal-version: >= 1.8-extra-source-files: example/example.cabal- , example/src/Example.hs- , example/test/doctests.hs+-- This file has been generated from package.yaml by hpack version 0.25.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 963cf1ec79ce30b2c464e5e64a64f5b9f0cba107029eb8fdc5333229775060c9 +name: doctest+version: 0.14.0+synopsis: Test interactive Haskell examples+description: The doctest program checks examples in source code comments. It is modeled+ after doctest for Python (<http://docs.python.org/library/doctest.html>).+ .+ Documentation is at <https://github.com/sol/doctest#readme>.+category: Testing+bug-reports: https://github.com/sol/doctest/issues+homepage: https://github.com/sol/doctest#readme+license: MIT+license-file: LICENSE+copyright: (c) 2009-2017 Simon Hengel+author: Simon Hengel <sol@typeful.net>+maintainer: Simon Hengel <sol@typeful.net>+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ CHANGES+ example/example.cabal+ example/src/Example.hs+ example/test/doctests.hs+ README.markdown+ source-repository head type: git location: https://github.com/sol/doctest library+ ghc-options: -Wall+ hs-source-dirs:+ src+ ghci-wrapper/src exposed-modules: Test.DocTest- ghc-options:- -Wall- hs-source-dirs:- src, ghci-wrapper/src other-modules: Extract- , GhcUtil- , Interpreter- , Location- , Options- , PackageDBs- , Parse- , Paths_doctest- , Property- , Runner- , Runner.Example- , Run- , Util- , Sandbox- , Language.Haskell.GhciWrapper+ GhcUtil+ Interpreter+ Location+ Options+ PackageDBs+ Parse+ Property+ Run+ Runner+ Runner.Example+ Sandbox+ Util+ Language.Haskell.GhciWrapper+ Paths_doctest build-depends:- base == 4.*- , base-compat >= 0.7.0- , ghc >= 7.0 && < 8.4- , syb >= 0.3- , code-page >= 0.1+ base ==4.*+ , base-compat >=0.7.0+ , code-page >=0.1 , deepseq , directory , filepath+ , ghc >=7.0 && <8.6+ , ghc-paths >=0.1.0.9 , process- , ghc-paths >= 0.1.0.9+ , syb >=0.3 , transformers+ default-language: Haskell2010 executable doctest- main-is:- Main.hs- ghc-options:- -Wall -threaded+ main-is: Main.hs+ other-modules:+ Paths_doctest+ ghc-options: -Wall -threaded hs-source-dirs: driver build-depends:- base == 4.*+ base ==4.*+ , base-compat >=0.7.0+ , code-page >=0.1+ , deepseq+ , directory , doctest+ , filepath+ , ghc >=7.0 && <8.6+ , ghc-paths >=0.1.0.9+ , process+ , syb >=0.3+ , transformers+ default-language: Haskell2010 -test-suite spec- main-is:- Spec.hs- type:- exitcode-stdio-1.0- ghc-options:- -Wall -threaded- cpp-options:- -DTEST+test-suite doctests+ main-is: doctests.hs+ type: exitcode-stdio-1.0+ ghc-options: -Wall -threaded hs-source-dirs:- test, src, ghci-wrapper/src- c-sources:- test/integration/with-cbits/foo.c+ test build-depends:- base- , ghc- , syb- , code-page+ base ==4.*+ , base-compat >=0.7.0+ , code-page >=0.1 , deepseq , directory+ , doctest , filepath+ , ghc >=7.0 && <8.6+ , ghc-paths >=0.1.0.9 , process- , ghc-paths+ , syb >=0.3 , transformers-- , base-compat- , HUnit- , hspec >= 1.5.1- , QuickCheck >= 2.8.2- , stringbuilder >= 0.4- , silently >= 1.2.4- , setenv- , with-location- , mockery+ default-language: Haskell2010 -test-suite doctests- main-is:- doctests.hs- type:- exitcode-stdio-1.0- ghc-options:- -Wall -threaded+test-suite spec+ main-is: Spec.hs+ other-modules:+ ExtractSpec+ InterpreterSpec+ LocationSpec+ MainSpec+ OptionsSpec+ Orphans+ PackageDBsSpec+ ParseSpec+ PropertySpec+ Runner.ExampleSpec+ RunnerSpec+ RunSpec+ SandboxSpec+ UtilSpec+ Extract+ GhcUtil+ Interpreter+ Location+ Options+ PackageDBs+ Parse+ Property+ Run+ Runner+ Runner.Example+ Sandbox+ Test.DocTest+ Util+ Language.Haskell.GhciWrapper+ Paths_doctest+ type: exitcode-stdio-1.0+ ghc-options: -Wall -threaded+ cpp-options: -DTEST hs-source-dirs: test+ src+ ghci-wrapper/src+ c-sources:+ test/integration/with-cbits/foo.c build-depends:- base- , doctest+ HUnit+ , QuickCheck >=2.11.3+ , base ==4.*+ , base-compat >=0.7.0+ , code-page >=0.1+ , deepseq+ , directory+ , filepath+ , ghc >=7.0 && <8.6+ , ghc-paths >=0.1.0.9+ , hspec >=1.5.1+ , mockery+ , process+ , setenv+ , silently >=1.2.4+ , stringbuilder >=0.4+ , syb >=0.3+ , transformers+ , with-location+ default-language: Haskell2010
src/Extract.hs view
@@ -76,6 +76,16 @@ instance NFData a => NFData (Module a) where rnf (Module name setup content) = name `deepseq` setup `deepseq` content `deepseq` () +#if __GLASGOW_HASKELL__ < 803+type GhcPs = RdrName++needsTemplateHaskellOrQQ :: ModuleGraph -> Bool+needsTemplateHaskellOrQQ = needsTemplateHaskell++mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph+mapMG = map+#endif+ -- | Parse a list of modules. parse :: [String] -> IO [TypecheckedModule] parse args = withGhc args $ \modules_ -> withTempOutputDir $ do@@ -86,7 +96,7 @@ mapM (`guessTarget` Nothing) modules >>= setTargets mods <- depanal [] False - mods' <- if needsTemplateHaskell mods then enableCompilation mods else return mods+ mods' <- if needsTemplateHaskellOrQQ mods then enableCompilation mods else return mods let sortedMods = flattenSCCs (topSortModuleGraph False mods' Nothing) reverse <$> mapM (parseModule >=> typecheckModule >=> loadModule) sortedMods@@ -103,7 +113,7 @@ 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' = map upd modGraph+ let modGraph' = mapMG upd modGraph return modGraph' -- copied from Haddock/GhcUtils.hs@@ -236,7 +246,7 @@ #endif ) where- fromLHsDecl :: Selector (LHsDecl RdrName)+ fromLHsDecl :: Selector (LHsDecl GhcPs) fromLHsDecl (L loc decl) = case decl of -- Top-level documentation has to be treated separately, because it has
src/Interpreter.hs view
@@ -52,7 +52,14 @@ -> (Interpreter -> IO a) -- ^ Action to run -> IO a -- ^ Result of action withInterpreter flags action = do- let args = ["--interactive"] ++ flags+ let+ args = [+ "--interactive"+#if __GLASGOW_HASKELL__ >= 802+ , "-fdiagnostics-color=never"+ , "-fno-diagnostics-show-caret"+#endif+ ] ++ flags bracket (new defaultConfig{configGhci = ghc} args) close action -- | Evaluate an expression; return a Left value on exceptions.
src/Runner.hs view
@@ -14,7 +14,7 @@ import Prelude hiding (putStr, putStrLn, error) #if __GLASGOW_HASKELL__ < 710-import Data.Monoid+import Data.Monoid hiding ((<>)) import Control.Applicative #endif @@ -46,10 +46,17 @@ show (Summary examples tried errors failures) = printf "Examples: %d Tried: %d Errors: %d Failures: %d" examples tried errors failures + -- | Sum up summaries. instance Monoid Summary where mempty = Summary 0 0 0 0- (Summary x1 x2 x3 x4) `mappend` (Summary y1 y2 y3 y4) = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4)+#if MIN_VERSION_base(4,11,0)+instance Semigroup Summary where+ (<>)+#else+ mappend+#endif+ (Summary x1 x2 x3 x4) (Summary y1 y2 y3 y4) = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4) -- | Run all examples from a list of modules. runModules :: Bool -> Bool -> Interpreter -> [Module [Located DocTest]] -> IO Summary
+ test/ExtractSpec.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE FlexibleContexts #-}+module ExtractSpec (main, spec) where++import Test.Hspec+import Test.HUnit+import Data.WithLocation++import Panic (GhcException (..))++import Extract+import Location+import System.FilePath++import Orphans ()++shouldGive :: WithLocation ((String, String) -> [Module String] -> Assertion)+(d, m) `shouldGive` expected = do+ r <- map (fmap unLoc) `fmap` extract ["-i" ++ dir, dir </> m]+ r `shouldBe` expected+ where dir = "test/extract" </> d++main :: IO ()+main = hspec spec++spec :: Spec+spec = do++ describe "extract" $ do+ it "extracts documentation for a top-level declaration" $ do+ ("declaration", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" Some documentation"]]++ it "extracts documentation from argument list" $ do+ ("argument-list", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" doc for arg1", " doc for arg2"]]++ it "extracts documentation for a type class function" $ do+ ("type-class", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" Convert given value to a string."]]++ it "extracts documentation from the argument list of a type class function" $ do+ ("type-class-args", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" foo", " bar"]]++ it "extracts documentation from the module header" $ do+ ("module-header", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" Some documentation"]]++ it "extracts documentation from imported modules" $ do+ ("imported-module", "Bar.hs") `shouldGive` [Module "Bar" Nothing [" documentation for bar"], Module "Baz" Nothing [" documentation for baz"]]++ it "extracts documentation from export list" $ do+ ("export-list", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" documentation from export list"]]++ it "extracts documentation from named chunks" $ do+ ("named-chunks", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" named chunk foo", "\n named chunk bar"]]++ it "returns docstrings in the same order they appear in the source" $ do+ ("comment-order", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" module header", " export list 1", " export list 2", " foo", " named chunk", " bar"]]++ it "extracts $setup code" $ do+ ("setup", "Foo.hs") `shouldGive` [Module "Foo" (Just "\n some setup code") [" foo", " bar", " baz"]]++ it "fails on invalid flags" $ do+ extract ["--foobar", "test/Foo.hs"] `shouldThrow` (\e -> case e of UsageError "unrecognized option `--foobar'" -> True; _ -> False)++ describe "extract (regression tests)" $ do+ it "works with infix operators" $ do+ ("regression", "Fixity.hs") `shouldGive` [Module "Fixity" Nothing []]++ it "works with parallel list comprehensions" $ do+ ("regression", "ParallelListComp.hs") `shouldGive` [Module "ParallelListComp" Nothing []]++ it "works with list comprehensions in instance definitions" $ do+ ("regression", "ParallelListCompClass.hs") `shouldGive` [Module "ParallelListCompClass" Nothing []]++ it "works with foreign imports" $ do+ ("regression", "ForeignImport.hs") `shouldGive` [Module "ForeignImport" Nothing []]++ it "works for rewrite rules" $ do+ ("regression", "RewriteRules.hs") `shouldGive` [Module "RewriteRules" Nothing [" doc for foo"]]++ it "works for rewrite rules with type signatures" $ do+ ("regression", "RewriteRulesWithSigs.hs") `shouldGive` [Module "RewriteRulesWithSigs" Nothing [" doc for foo"]]++ it "strips CR from dos line endings" $ do+ ("dos-line-endings", "Foo.hs") `shouldGive` [Module "Foo" Nothing ["\n foo\n bar\n baz"]]++ it "works with a module that splices in an expression from an other module" $ do+ ("th", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" some documentation"], Module "Bar" Nothing []]++ it "works for type families and GHC 7.6.1" $ do+ ("type-families", "Foo.hs") `shouldGive` [Module "Foo" Nothing []]
+ test/InterpreterSpec.hs view
@@ -0,0 +1,30 @@+module InterpreterSpec (main, spec) where++import Prelude ()+import Prelude.Compat++import Test.Hspec++import Interpreter (interpreterSupported, haveInterpreterKey, ghcInfo, withInterpreter, safeEval)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "interpreterSupported" $ do+ it "indicates whether GHCi is supported on current platform" $ do+ (Interpreter.interpreterSupported >> return ()) `shouldReturn` ()++ describe "ghcInfo" $ do+ it ("includes " ++ show haveInterpreterKey) $ do+ info <- ghcInfo+ lookup haveInterpreterKey info `shouldSatisfy`+ (||) <$> (== Just "YES") <*> (== Just "NO")++ describe "safeEval" $ do+ it "evaluates an expression" $ withInterpreter [] $ \ghci -> do+ Interpreter.safeEval ghci "23 + 42" `shouldReturn` Right "65\n"++ it "returns Left on unterminated multiline command" $ withInterpreter [] $ \ghci -> do+ Interpreter.safeEval ghci ":{\n23 + 42" `shouldReturn` Left "unterminated multiline command"
+ test/LocationSpec.hs view
@@ -0,0 +1,43 @@+module LocationSpec (main, spec) where++import Test.Hspec++import Location+import SrcLoc+import FastString (fsLit)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do++ describe "toLocation" $ do++ it "works for a regular SrcSpan" $ do+ toLocation (mkSrcSpan (mkSrcLoc (fsLit "Foo.hs") 2 5) (mkSrcLoc (fsLit "Foo.hs") 10 20))+ `shouldBe` Location "Foo.hs" 2++ it "works for a single-line SrcSpan" $ do+ toLocation (mkSrcSpan (mkSrcLoc (fsLit "Foo.hs") 2 5) (mkSrcLoc (fsLit "Foo.hs") 2 10))+ `shouldBe` Location "Foo.hs" 2++ it "works for a SrcSpan that corresponds to single point" $ do+ (toLocation . srcLocSpan) (mkSrcLoc (fsLit "Foo.hs") 10 20)+ `shouldBe` Location "Foo.hs" 10++ it "works for a bad SrcSpan" $ do+ toLocation noSrcSpan `shouldBe` UnhelpfulLocation "<no location info>"++ it "works for a SrcLoc with bad locations" $ do+ toLocation (mkSrcSpan noSrcLoc noSrcLoc)+ `shouldBe` UnhelpfulLocation "<no location info>"++ describe "enumerate" $ do+ it "replicates UnhelpfulLocation" $ do+ let loc = UnhelpfulLocation "foo"+ (take 10 $ enumerate loc) `shouldBe` replicate 10 loc++ it "enumerates Location" $ do+ let loc = Location "Foo.hs" 23+ (take 3 $ enumerate loc) `shouldBe` [Location "Foo.hs" 23, Location "Foo.hs" 24, Location "Foo.hs" 25]
+ test/MainSpec.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE FlexibleContexts #-}+module MainSpec (main, spec) where++import Test.Hspec+import Test.HUnit (assertEqual, Assertion)+import Data.WithLocation++import Control.Exception+import System.Directory (getCurrentDirectory, setCurrentDirectory)+import System.FilePath+import Options+import Runner (Summary(..))+import Run hiding (doctest)+import System.IO.Silently+import System.IO++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory workingDir action = do+ bracket getCurrentDirectory setCurrentDirectory $ \_ -> do+ setCurrentDirectory workingDir+ action++-- | Construct a doctest specific 'Assertion'.+doctest :: WithLocation (FilePath -> [String] -> Summary -> Assertion)+doctest = doctestWithPreserveIt defaultPreserveIt++doctestWithPreserveIt :: WithLocation (Bool -> FilePath -> [String] -> Summary -> Assertion)+doctestWithPreserveIt preserveIt workingDir args expected = do+ actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithOptions defaultFastMode preserveIt args)+ assertEqual label expected actual+ where+ label = workingDir ++ " " ++ show args++cases :: Int -> Summary+cases n = Summary n n 0 0++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "doctest" $ do+ it "testSimple" $ do+ doctest "." ["testSimple/Fib.hs"]+ (cases 1)++ it "it-variable" $ do+ doctestWithPreserveIt True "." ["it/Foo.hs"]+ (cases 5)++ it "it-variable in $setup" $ do+ doctestWithPreserveIt True "." ["it/Setup.hs"]+ (cases 5)++ it "failing" $ do+ doctest "." ["failing/Foo.hs"]+ (cases 1) {sFailures = 1}++ it "skips subsequent examples from the same group if an example fails" $+ doctest "." ["failing-multiple/Foo.hs"]+ (cases 4) {sTried = 2, sFailures = 1}++ it "testImport" $ do+ doctest "testImport" ["ModuleA.hs"]+ (cases 3)+ doctest ".." ["-iintegration/testImport", "integration/testImport/ModuleA.hs"]+ (cases 3)++ it "testCommentLocation" $ do+ doctest "." ["testCommentLocation/Foo.hs"]+ (cases 11)++ it "testPutStr" $ do+ doctest "testPutStr" ["Fib.hs"]+ (cases 3)++ it "fails on multi-line expressions, introduced with :{" $ do+ doctest "testFailOnMultiline" ["Fib.hs"]+ (cases 2) {sErrors = 2}++ it "testBlankline" $ do+ doctest "testBlankline" ["Fib.hs"]+ (cases 1)++ it "examples from the same Haddock comment share the same scope" $ do+ doctest "testCombinedExample" ["Fib.hs"]+ (cases 4)++ it "testDocumentationForArguments" $ do+ doctest "testDocumentationForArguments" ["Fib.hs"]+ (cases 1)++ it "template-haskell" $ do+ doctest "template-haskell" ["Foo.hs"]+ (cases 2)++ it "handles source files with CRLF line endings" $ do+ doctest "dos-line-endings" ["Fib.hs"]+ (cases 1)++ it "runs $setup before each test group" $ do+ doctest "setup" ["Foo.hs"]+ (cases 2)++ it "skips subsequent tests from a module, if $setup fails" $ do+ doctest "setup-skip-on-failure" ["Foo.hs"]+ (cases 3) {sTried = 1, sFailures = 1}++ it "works with additional object files" $ do+ doctest "with-cbits" ["Bar.hs", "../../../dist/build/spec/spec-tmp/test/integration/with-cbits/foo.o"]+ (cases 1)++ it "ignores trailing whitespace when matching test output" $ do+ doctest "trailing-whitespace" ["Foo.hs"]+ (cases 1)++ describe "doctest as a runner for QuickCheck properties" $ do+ it "runs a boolean property" $ do+ doctest "property-bool" ["Foo.hs"]+ (cases 1)++ it "runs an explicitly quantified property" $ do+ doctest "property-quantified" ["Foo.hs"]+ (cases 1)++ it "runs an implicitly quantified property" $ do+ doctest "property-implicitly-quantified" ["Foo.hs"]+ (cases 1)++ it "reports a failing property" $ do+ doctest "property-failing" ["Foo.hs"]+ (cases 1) {sFailures = 1}++ it "runs a boolean property with an explicit type signature" $ do+ doctest "property-bool-with-type-signature" ["Foo.hs"]+ (cases 1)++ it "runs $setup before each property" $ do+ doctest "property-setup" ["Foo.hs"]+ (cases 3)++ describe "doctest (regression tests)" $ do+ it "bugfixWorkingDirectory" $ do+ doctest "bugfixWorkingDirectory" ["Fib.hs"]+ (cases 1)+ doctest "bugfixWorkingDirectory" ["examples/Fib.hs"]+ (cases 2)++ it "bugfixOutputToStdErr" $ do+ doctest "bugfixOutputToStdErr" ["Fib.hs"]+ (cases 2)++ it "bugfixImportHierarchical" $ do+ doctest "bugfixImportHierarchical" ["ModuleA.hs", "ModuleB.hs"]+ (cases 3)++ it "bugfixMultipleModules" $ do+ doctest "bugfixMultipleModules" ["ModuleA.hs"]+ (cases 5)++ it "testCPP" $ do+ doctest "testCPP" ["-cpp", "Foo.hs"]+ (cases 1) {sFailures = 1}+ doctest "testCPP" ["-cpp", "-DFOO", "Foo.hs"]+ (cases 1)++ it "template-haskell-bugfix" $ do+ doctest "template-haskell-bugfix" ["Main.hs"]+ (cases 2)
+ test/OptionsSpec.hs view
@@ -0,0 +1,60 @@+module OptionsSpec (spec) where++import Prelude ()+import Prelude.Compat++import Test.Hspec+import Test.QuickCheck++import Options++spec :: Spec+spec = do+ describe "parseOptions" $ do+ let warning = ["WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."]+ it "strips --optghc" $+ property $ \xs ys ->+ parseOptions (xs ++ ["--optghc", "foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt)++ it "strips --optghc=" $+ property $ \xs ys ->+ parseOptions (xs ++ ["--optghc=foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt)++ describe "--no-magic" $ do+ context "without --no-magic" $ do+ it "enables magic mode" $ do+ runMagicMode <$> parseOptions [] `shouldBe` Result True++ context "with --no-magic" $ do+ it "disables magic mode" $ do+ runMagicMode <$> parseOptions ["--no-magic"] `shouldBe` Result False++ describe "--fast" $ do+ context "without --fast" $ do+ it "disables fast mode" $ do+ runFastMode <$> parseOptions [] `shouldBe` Result False++ context "with --fast" $ do+ it "enabled fast mode" $ do+ runFastMode <$> parseOptions ["--fast"] `shouldBe` Result True++ describe "--preserve-it" $ do+ context "without --preserve-it" $ do+ it "does not preserve the `it` variable" $ do+ runPreserveIt <$> parseOptions [] `shouldBe` Result False++ context "with --preserve-it" $ do+ it "preserves the `it` variable" $ do+ runPreserveIt <$> parseOptions ["--preserve-it"] `shouldBe` Result True++ context "with --help" $ do+ it "outputs usage information" $ do+ parseOptions ["--help"] `shouldBe` Output usage++ context "with --version" $ do+ it "outputs version information" $ do+ parseOptions ["--version"] `shouldBe` Output versionInfo++ context "with --info" $ do+ it "outputs machine readable version information" $ do+ parseOptions ["--info"] `shouldBe` Output info
+ test/Orphans.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Orphans where++import Parse+import Location++-- The generic form+--+-- > deriving instance Show a => Show (Module a)+--+-- fails with GHC 7.0.1 due to an overlapping instance (leaked by the GHC API),+-- this is why we derive the things we need individually.+deriving instance Show (Module String)+deriving instance Show (Module [DocTest])+deriving instance Show (Module [Located DocTest])
+ test/PackageDBsSpec.hs view
@@ -0,0 +1,73 @@+module PackageDBsSpec (main, spec) where++import Prelude ()+import Prelude.Compat++import qualified Control.Exception as E+import Data.List (intercalate)+import PackageDBs+import System.Directory (getCurrentDirectory, setCurrentDirectory)+import System.Environment.Compat+import System.FilePath (searchPathSeparator)+import Test.Hspec++import Test.Mockery.Directory++main :: IO ()+main = hspec spec++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory workingDir action = do+ E.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do+ setCurrentDirectory workingDir+ action++withEnv :: String -> String -> IO a -> IO a+withEnv k v action = E.bracket save restore $ \_ -> do+ setEnv k v >> action+ where+ save = lookup k <$> getEnvironment+ restore = maybe (unsetEnv k) (setEnv k)++clearEnv :: IO a -> IO a+clearEnv =+ withEnv "GHC_PACKAGE_PATH" ""+ . withEnv "HASKELL_PACKAGE_SANDBOX" ""+ . withEnv "HASKELL_PACKAGE_SANDBOXES" ""++combineDirs :: [FilePath] -> String+combineDirs = intercalate [searchPathSeparator]++spec :: Spec+spec = around_ clearEnv $ do+ describe "getPackageDBsFromEnv" $ do+ context "without a cabal sandbox present" $ do+ around_ (inTempDirectory) $ do+ it "uses global and user when no env or sandboxing used" $ do+ getPackageDBsFromEnv `shouldReturn` PackageDBs True True []++ it "respects GHC_PACKAGE_PATH" $+ withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo", "bar", ""]) $ do+ getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["foo", "bar"]++ it "HASKELL_PACKAGE_SANDBOXES trumps GHC_PACKAGE_PATH" $+ withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo1", "bar1", ""]) $ do+ withEnv "HASKELL_PACKAGE_SANDBOXES" (combineDirs ["foo2", "bar2", ""]) $ do+ getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["foo2", "bar2"]++ it "HASKELL_PACKAGE_SANDBOX trumps GHC_PACKAGE_PATH" $+ withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo1", "bar1", ""]) $ do+ withEnv "HASKELL_PACKAGE_SANDBOX" (combineDirs ["foo2"]) $ do++ getPackageDBsFromEnv `shouldReturn` PackageDBs True True ["foo2"]++ context "with a cabal sandbox present" $ do+ around_ (withCurrentDirectory "test/sandbox") $ do+ it "respects cabal sandboxes" $ do+ getPackageDBsFromEnv `shouldReturn`+ PackageDBs False True ["/home/me/doctest-haskell/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]++ it "GHC_PACKAGE_PATH takes precedence" $+ withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo", "bar"]) $ do+ getPackageDBsFromEnv `shouldReturn`+ PackageDBs False False ["foo", "bar"]
+ test/ParseSpec.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE OverloadedStrings #-}+module ParseSpec (main, spec) where++import Test.Hspec+import Data.String+import Data.String.Builder (Builder, build)+import Control.Monad.Trans.Writer++import Parse+import Location++import Orphans ()++main :: IO ()+main = hspec spec++group :: Writer [DocTest] () -> Writer [[DocTest]] ()+group g = tell [execWriter g]++ghci :: Expression -> Builder -> Writer [DocTest] ()+ghci expressions expected = tell [Example expressions $ (map fromString . lines . build) expected]++prop_ :: Expression -> Writer [DocTest] ()+prop_ e = tell [Property e]++module_ :: String -> Writer [[DocTest]] () -> Writer [Module [DocTest]] ()+module_ name gs = tell [Module name Nothing $ execWriter gs]++shouldGive :: IO [Module [Located DocTest]] -> Writer [Module [DocTest]] () -> Expectation+shouldGive action expected = map (fmap $ map unLoc) `fmap` action `shouldReturn` execWriter expected++spec :: Spec+spec = do+ describe "getDocTests" $ do+ it "extracts properties from a module" $ do+ getDocTests ["test/parse/property/Fib.hs"] `shouldGive` do+ module_ "Fib" $ do+ group $ do+ prop_ "foo"+ prop_ "bar"+ prop_ "baz"++ it "extracts examples from a module" $ do+ getDocTests ["test/parse/simple/Fib.hs"] `shouldGive` do+ module_ "Fib" $ do+ group $ do+ ghci "putStrLn \"foo\""+ "foo"+ ghci "putStr \"bar\""+ "bar"+ ghci "putStrLn \"baz\""+ "baz"++ it "extracts examples from documentation for non-exported names" $ do+ getDocTests ["test/parse/non-exported/Fib.hs"] `shouldGive` do+ module_ "Fib" $ do+ group $ do+ ghci "putStrLn \"foo\""+ "foo"+ ghci "putStr \"bar\""+ "bar"+ ghci "putStrLn \"baz\""+ "baz"++ it "extracts multiple examples from a module" $ do+ getDocTests ["test/parse/multiple-examples/Foo.hs"] `shouldGive` do+ module_ "Foo" $ do+ group $ do+ ghci "foo"+ "23"+ group $ do+ ghci "bar"+ "42"++ it "returns an empty list, if documentation contains no examples" $ do+ getDocTests ["test/parse/no-examples/Fib.hs"] >>= (`shouldBe` [])++ it "sets setup code to Nothing, if it does not contain any tests" $ do+ getDocTests ["test/parse/setup-empty/Foo.hs"] `shouldGive` do+ module_ "Foo" $ do+ group $ do+ ghci "foo"+ "23"++ it "keeps modules that only contain setup code" $ do+ getDocTests ["test/parse/setup-only/Foo.hs"] `shouldGive` do+ tell [Module "Foo" (Just [Example "foo" ["23"]]) []]++ describe "parseInteractions (an internal function)" $ do++ let parse_ = map unLoc . parseInteractions . noLocation . build++ it "parses an interaction" $ do+ parse_ $ do+ ">>> foo"+ "23"+ `shouldBe` [("foo", ["23"])]++ it "drops whitespace as appropriate" $ do+ parse_ $ do+ " >>> foo "+ " 23"+ `shouldBe` [("foo", ["23"])]++ it "parses an interaction without a result" $ do+ parse_ $ do+ ">>> foo"+ `shouldBe` [("foo", [])]++ it "works with a complex example" $ do+ parse_ $ do+ "test"+ "foobar"+ ""+ ">>> foo"+ "23"+ ""+ ">>> baz"+ ""+ ">>> bar"+ "23"+ ""+ "baz"+ `shouldBe` [("foo", ["23"]), ("baz", []), ("bar", ["23"])]++ it "attaches location information to parsed interactions" $ do+ let loc = Located . Location "Foo.hs"+ r <- return . parseInteractions . loc 23 . build $ do+ "1"+ "2"+ ""+ ">>> 4"+ "5"+ ""+ ">>> 7"+ ""+ ">>> 9"+ "10"+ ""+ "11"+ r `shouldBe` [loc 26 $ ("4", ["5"]), loc 29 $ ("7", []), loc 31 $ ("9", ["10"])]++ it "basic multiline" $ do+ parse_ $ do+ ">>> :{ first"+ " next"+ "some"+ ":}"+ "output"+ `shouldBe` [(":{ first\n next\nsome\n:}", ["output"])]++ it "multiline align output" $ do+ parse_ $ do+ ">>> :{ first"+ " :}"+ " output"+ `shouldBe` [(":{ first\n:}", ["output"])]++ it "multiline align output with >>>" $ do+ parse_ $ do+ " >>> :{ first"+ " >>> :}"+ " output"+ `shouldBe` [(":{ first\n:}", ["output"])]++ it "parses wild cards lines" $ do+ parse_ $ do+ " >>> action"+ " foo"+ " ..."+ " bar"+ `shouldBe` [("action", ["foo", WildCardLine, "bar"])]++ it "parses wild card chunks" $ do+ parse_ $ do+ " >>> action"+ " foo ... bar"+ `shouldBe` [("action", [ExpectedLine ["foo ", WildCardChunk, " bar"]])]++ describe " parseProperties (an internal function)" $ do+ let parse_ = map unLoc . parseProperties . noLocation . build++ it "parses a property" $ do+ parse_ $ do+ "prop> foo"+ `shouldBe` ["foo"]++ describe "mkLineChunks (an internal function)" $ do++ it "replaces ellipsis with WildCardChunks" $ do+ mkLineChunks "foo ... bar ... baz" `shouldBe`+ ["foo ", WildCardChunk, " bar ", WildCardChunk, " baz"]++ it "doesn't replace fewer than 3 consecutive dots" $ do+ mkLineChunks "foo .. bar .. baz" `shouldBe`+ ["foo .. bar .. baz"]++ it "handles leading and trailing dots" $ do+ mkLineChunks ".. foo bar .." `shouldBe` [".. foo bar .."]++ it "handles leading and trailing ellipsis" $ do+ mkLineChunks "... foo bar ..." `shouldBe` [ WildCardChunk+ , " foo bar "+ , WildCardChunk+ ]
+ test/PropertySpec.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module PropertySpec (main, spec) where++import Test.Hspec+import Data.String.Builder++import Property+import Interpreter (withInterpreter)++main :: IO ()+main = hspec spec++isFailure :: PropertyResult -> Bool+isFailure (Failure _) = True+isFailure _ = False++spec :: Spec+spec = do+ describe "runProperty" $ do+ it "reports a failing property" $ withInterpreter [] $ \repl -> do+ runProperty repl "False" `shouldReturn` Failure "*** Failed! Falsifiable (after 1 test):"++ it "runs a Bool property" $ withInterpreter [] $ \repl -> do+ runProperty repl "True" `shouldReturn` Success++ it "runs a Bool property with an explicit type signature" $ withInterpreter [] $ \repl -> do+ runProperty repl "True :: Bool" `shouldReturn` Success++ it "runs an implicitly quantified property" $ withInterpreter [] $ \repl -> do+ runProperty repl "(reverse . reverse) xs == (xs :: [Int])" `shouldReturn` Success++ it "runs an implicitly quantified property even with GHC 7.4" $+#if __GLASGOW_HASKELL__ == 702+ pendingWith "This triggers a bug in GHC 7.2.*."+ -- try e.g.+ -- >>> 23+ -- >>> :t is+#else+ -- ghc will include a suggestion (did you mean `id` instead of `is`) in+ -- the error message+ withInterpreter [] $ \repl -> do+ runProperty repl "foldr (+) 0 is == sum (is :: [Int])" `shouldReturn` Success+#endif++ it "runs an explicitly quantified property" $ withInterpreter [] $ \repl -> do+ runProperty repl "\\xs -> (reverse . reverse) xs == (xs :: [Int])" `shouldReturn` Success++ it "allows to mix implicit and explicit quantification" $ withInterpreter [] $ \repl -> do+ runProperty repl "\\x -> x + y == y + x" `shouldReturn` Success++ it "reports the value for which a property fails" $ withInterpreter [] $ \repl -> do+ runProperty repl "x == 23" `shouldReturn` Failure "*** Failed! Falsifiable (after 1 test):\n0"++ it "reports the values for which a property that takes multiple arguments fails" $ withInterpreter [] $ \repl -> do+ let vals x = case x of (Failure r) -> tail (lines r); _ -> error "Property did not fail!"+ vals `fmap` runProperty repl "x == True && y == 10 && z == \"foo\"" `shouldReturn` ["False", "0", show ("" :: String)]++ it "defaults ambiguous type variables to Integer" $ withInterpreter [] $ \repl -> do+ runProperty repl "reverse xs == xs" >>= (`shouldSatisfy` isFailure)++ describe "freeVariables" $ do+ it "finds a free variables in a term" $ withInterpreter [] $ \repl -> do+ freeVariables repl "x" `shouldReturn` ["x"]++ it "ignores duplicates" $ withInterpreter [] $ \repl -> do+ freeVariables repl "x == x" `shouldReturn` ["x"]++ it "works for terms with multiple names" $ withInterpreter [] $ \repl -> do+ freeVariables repl "\\z -> x + y + z == foo 23" `shouldReturn` ["x", "y", "foo"]++ it "works for names that contain a prime" $ withInterpreter [] $ \repl -> do+ freeVariables repl "x' == y''" `shouldReturn` ["x'", "y''"]++ it "works for names that are similar to other names that are in scope" $ withInterpreter [] $ \repl -> do+ freeVariables repl "length_" `shouldReturn` ["length_"]++ describe "parseNotInScope" $ do+ context "when error message was produced by GHC 7.4.1" $ do+ it "extracts a variable name of variable that is not in scope from an error message" $ do+ parseNotInScope . build $ do+ "<interactive>:4:1: Not in scope: `x'"+ `shouldBe` ["x"]++ it "ignores duplicates" $ do+ parseNotInScope . build $ do+ "<interactive>:4:1: Not in scope: `x'"+ ""+ "<interactive>:4:6: Not in scope: `x'"+ `shouldBe` ["x"]++ it "works for variable names that contain a prime" $ do+ parseNotInScope . build $ do+ "<interactive>:2:1: Not in scope: x'"+ ""+ "<interactive>:2:7: Not in scope: y'"+ `shouldBe` ["x'", "y'"]++ it "works for error messages with suggestions" $ do+ parseNotInScope . build $ do+ "<interactive>:1:1:"+ " Not in scope: `is'"+ " Perhaps you meant `id' (imported from Prelude)"+ `shouldBe` ["is"]++ context "when error message was produced by GHC 8.0.1" $ do+ it "extracts a variable name of variable that is not in scope from an error message" $ do+ parseNotInScope . build $ do+ "<interactive>:1:1: error: Variable not in scope: x"+ `shouldBe` ["x"]++ it "ignores duplicates" $ do+ parseNotInScope . build $ do+ "<interactive>:1:1: error: Variable not in scope: x :: ()"+ ""+ "<interactive>:1:6: error: Variable not in scope: x :: ()"+ `shouldBe` ["x"]++ it "works for variable names that contain a prime" $ do+ parseNotInScope . build $ do+ "<interactive>:1:1: error: Variable not in scope: x' :: ()"+ ""+ "<interactive>:1:7: error: Variable not in scope: y'' :: ()"+ `shouldBe` ["x'", "y''"]++ it "works for error messages with suggestions" $ do+ parseNotInScope . build $ do+ "<interactive>:1:1: error:"+ " • Variable not in scope: length_"+ " • Perhaps you meant ‘length’ (imported from Prelude)"+ `shouldBe` ["length_"]
+ test/RunSpec.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE CPP #-}+module RunSpec (main, spec) where++import Prelude ()+import Prelude.Compat++import Test.Hspec+import System.Exit++import qualified Control.Exception as E+#if __GLASGOW_HASKELL__ < 707+import System.Cmd+#else+import System.Process+#endif+import System.Directory (getCurrentDirectory, setCurrentDirectory, removeDirectoryRecursive)+import Data.List.Compat++import System.Environment.Compat++import System.IO.Silently+import System.IO (stderr)+import qualified Options++import Run++doctestWithDefaultOptions :: [String] -> IO Summary+doctestWithDefaultOptions = doctestWithOptions Options.defaultFastMode Options.defaultPreserveIt++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory workingDir action = do+ E.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do+ setCurrentDirectory workingDir+ action++rmDir :: FilePath -> IO ()+rmDir dir = removeDirectoryRecursive dir `E.catch` (const $ return () :: E.IOException -> IO ())++withEnv :: String -> String -> IO a -> IO a+withEnv k v action = E.bracket save restore $ \_ -> do+ setEnv k v >> action+ where+ save = lookup k <$> getEnvironment+ restore = maybe (unsetEnv k) (setEnv k)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "doctest" $ do+ it "exits with ExitFailure if at least one test case fails" $ do+ hSilence [stderr] (doctest ["test/integration/failing/Foo.hs"]) `shouldThrow` (== ExitFailure 1)++ it "prints help on --help" $ do+ (r, ()) <- capture (doctest ["--help"])+ r `shouldBe` Options.usage++ it "prints version on --version" $ do+ (r, ()) <- capture (doctest ["--version"])+ lines r `shouldSatisfy` any (isPrefixOf "doctest version ")++ it "accepts arbitrary GHC options" $ do+ hSilence [stderr] $ doctest ["-cpp", "-DFOO", "test/integration/test-options/Foo.hs"]++ it "accepts GHC options with --optghc" $ do+ hSilence [stderr] $ doctest ["--optghc=-cpp", "--optghc=-DFOO", "test/integration/test-options/Foo.hs"]++ it "prints a deprecation message for --optghc" $ do+ (r, _) <- hCapture [stderr] $ doctest ["--optghc=-cpp", "--optghc=-DFOO", "test/integration/test-options/Foo.hs"]+ lines r `shouldSatisfy` isPrefixOf [+ "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options"+ , "directly."+ ]++ it "prints error message on invalid option" $ do+ (r, e) <- hCapture [stderr] . E.try $ doctest ["--foo", "test/integration/test-options/Foo.hs"]+ e `shouldBe` Left (ExitFailure 1)+ r `shouldBe` unlines [+ "doctest: unrecognized option `--foo'"+ , "Try `doctest --help' for more information."+ ]++ it "respects HASKELL_PACKAGE_SANDBOX" $ do+ withCurrentDirectory "test/integration/custom-package-conf/foo" $ do+ ExitSuccess <- rawSystem "ghc-pkg" ["init", "../packages"]+ ExitSuccess <- rawSystem "cabal" ["configure", "--disable-optimization", "--disable-library-profiling", "--package-db=../packages"]+ ExitSuccess <- rawSystem "cabal" ["build"]+ ExitSuccess <- rawSystem "cabal" ["register", "--inplace"]+ return ()++ withEnv "HASKELL_PACKAGE_SANDBOX" "test/integration/custom-package-conf/packages" $ do+ hCapture_ [stderr] (doctest ["test/integration/custom-package-conf/Bar.hs"])+ `shouldReturn` "Examples: 2 Tried: 2 Errors: 0 Failures: 0\n"++ `E.finally` do+ rmDir "test/integration/custom-package-conf/packages/"+ rmDir "test/integration/custom-package-conf/foo/dist/"++ describe "doctestWithOptions" $ do+ context "on parse error" $ do+ let action = withCurrentDirectory "test/integration/parse-error" (doctestWithDefaultOptions ["Foo.hs"])++ it "aborts with (ExitFailure 1)" $ do+ hSilence [stderr] action `shouldThrow` (== ExitFailure 1)++ it "prints a useful error message" $ do+ (r, _) <- hCapture [stderr] (E.try action :: IO (Either ExitCode Summary))+#if __GLASGOW_HASKELL__ < 706+ r `shouldBe` "\nFoo.hs:6:1: parse error (possibly incorrect indentation)\n"+#else++#if __GLASGOW_HASKELL__ < 800+ r `shouldBe` "\nFoo.hs:6:1:\n parse error (possibly incorrect indentation or mismatched brackets)\n"+#else+ r `shouldBe` "\nFoo.hs:6:1: error:\n parse error (possibly incorrect indentation or mismatched brackets)\n"+#endif++#endif++ describe "expandDirs" $ do+ it "expands a directory" $ do+ res <- expandDirs "example"+ sort res `shouldBe`+ [ "example/src/Example.hs"+ , "example/test/doctests.hs"+ ]+ it "ignores files" $ do+ res <- expandDirs "doctest.cabal"+ res `shouldBe` ["doctest.cabal"]+ it "ignores random things" $ do+ let x = "foo bar baz bin"+ res <- expandDirs x+ res `shouldBe` [x]
+ test/Runner/ExampleSpec.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}+module Runner.ExampleSpec (main, spec) where++import Prelude ()+import Prelude.Compat++import Data.String+import Test.Hspec+import Test.QuickCheck++import Parse+import Runner.Example++main :: IO ()+main = hspec spec++data Line = PlainLine String | WildCardLines [String]+ deriving (Show, Eq)++instance Arbitrary Line where+ arbitrary = frequency [ (2, PlainLine <$> arbitrary)+ , (1, WildCardLines . getNonEmpty <$> arbitrary)+ ]++lineToExpected :: [Line] -> ExpectedResult+lineToExpected = map $ \x -> case x of+ PlainLine str -> fromString str+ WildCardLines _ -> WildCardLine++lineToActual :: [Line] -> [String]+lineToActual = concatMap $ \x -> case x of+ PlainLine str -> [str]+ WildCardLines xs -> xs++spec :: Spec+spec = do+ describe "mkResult" $ do+ it "returns Equal when output matches" $ do+ property $ \xs -> do+ mkResult (map fromString xs) xs `shouldBe` Equal++ it "ignores trailing whitespace" $ do+ mkResult ["foo\t"] ["foo "] `shouldBe` Equal++ context "with WildCardLine" $ do+ it "matches zero lines" $ do+ mkResult ["foo", WildCardLine, "bar"] ["foo", "bar"]+ `shouldBe` Equal++ it "matches an arbitrary number of lines" $ do+ mkResult ["foo", WildCardLine, "bar"] ["foo", "baz", "bazoom", "bar"]+ `shouldBe` Equal++ it "matches an arbitrary number of lines (quickcheck)" $ do+ property $ \xs -> mkResult (lineToExpected xs) (lineToActual xs)+ `shouldBe` Equal++ context "with WildCardChunk" $ do+ it "matches an arbitrary line chunk" $ do+ mkResult [ExpectedLine ["foo", WildCardChunk, "bar"]] ["foo baz bar"]+ `shouldBe` Equal++ context "when output does not match" $ do+ it "constructs failure message" $ do+ mkResult ["foo"] ["bar"] `shouldBe` NotEqual [+ "expected: foo"+ , " but got: bar"+ ]++ it "constructs failure message for multi-line output" $ do+ mkResult ["foo", "bar"] ["foo", "baz"] `shouldBe` NotEqual [+ "expected: foo"+ , " bar"+ , " but got: foo"+ , " baz"+ ]++ context "when any output line contains \"unsafe\" characters" $ do+ it "uses show to format output lines" $ do+ mkResult ["foo\160bar"] ["foo bar"] `shouldBe` NotEqual [+ "expected: \"foo\\160bar\""+ , " but got: \"foo bar\""+ ]
+ test/RunnerSpec.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module RunnerSpec (main, spec) where++import Test.Hspec++#if __GLASGOW_HASKELL__ < 710+import Data.Monoid+#endif++import System.IO+import System.IO.Silently (hCapture)+import Control.Monad.Trans.State+import Runner++main :: IO ()+main = hspec spec++capture :: Report a -> IO String+capture = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 True mempty)++-- like capture, but with interactivity set to False+capture_ :: Report a -> IO String+capture_ = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 False mempty)++spec :: Spec+spec = do++ describe "report" $ do++ context "when mode is interactive" $ do++ it "writes to stderr" $ do+ capture $ do+ report "foobar"+ `shouldReturn` "foobar\n"++ it "overwrites any intermediate output" $ do+ capture $ do+ report_ "foo"+ report "bar"+ `shouldReturn` "foo\rbar\n"++ it "blank out intermediate output if necessary" $ do+ capture $ do+ report_ "foobar"+ report "baz"+ `shouldReturn` "foobar\rbaz \n"++ context "when mode is non-interactive" $ do+ it "writes to stderr" $ do+ capture_ $ do+ report "foobar"+ `shouldReturn` "foobar\n"++ describe "report_" $ do++ context "when mode is interactive" $ do+ it "writes intermediate output to stderr" $ do+ capture $ do+ report_ "foobar"+ `shouldReturn` "foobar"++ it "overwrites any intermediate output" $ do+ capture $ do+ report_ "foo"+ report_ "bar"+ `shouldReturn` "foo\rbar"++ it "blank out intermediate output if necessary" $ do+ capture $ do+ report_ "foobar"+ report_ "baz"+ `shouldReturn` "foobar\rbaz "++ context "when mode is non-interactive" $ do+ it "is ignored" $ do+ capture_ $ do+ report_ "foobar"+ `shouldReturn` ""++ it "does not influence a subsequent call to `report`" $ do+ capture_ $ do+ report_ "foo"+ report "bar"+ `shouldReturn` "bar\n"++ it "does not require `report` to blank out any intermediate output" $ do+ capture_ $ do+ report_ "foobar"+ report "baz"+ `shouldReturn` "baz\n"
+ test/SandboxSpec.hs view
@@ -0,0 +1,18 @@+module SandboxSpec where++import Test.Hspec++import Sandbox++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "getPackageDbDir" $ do+ it "parses a config file and extracts package db" $ do+ pkgDb <- getPackageDbDir "test/sandbox/cabal.sandbox.config"+ pkgDb `shouldBe` "/home/me/doctest-haskell/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"++ it "throws an error if a config file is broken" $ do+ getPackageDbDir "test/sandbox/bad.config" `shouldThrow` anyException
+ test/UtilSpec.hs view
@@ -0,0 +1,21 @@+module UtilSpec (main, spec) where++import Test.Hspec++import Util++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "convertDosLineEndings" $ do+ it "converts CRLF to LF" $ do+ convertDosLineEndings "foo\r\nbar\r\nbaz" `shouldBe` "foo\nbar\nbaz"++ it "strips a trailing CR" $ do+ convertDosLineEndings "foo\r" `shouldBe` "foo"++ describe "takeWhileEnd" $ do+ it "returns the longest suffix of elements that satisfy a given predicate" $ do+ takeWhileEnd (/= ' ') "foo bar" `shouldBe` "bar"