doctest-0.20.1/0000755000000000000000000000000007346545000011430 5ustar0000000000000000doctest-0.20.1/CHANGES.markdown0000644000000000000000000001070507346545000014247 0ustar0000000000000000Changes in 0.20.1 - GHC 9.4 compatibility. (#382) Changes in 0.20.0 - Allow doctest to be invoked via `cabal repl --with-ghc=doctest` - Include `ghc --info` output in `--info` - Make `--info` output formatting consistent with GHC Changes in 0.19.0 - Better support for `cabal v2-*` Changes in 0.18.2 - GHC 9.2 compatibility. (#305, thanks to Ryan Scott and Matthew Pickering) Changes in 0.18.1 - GHC 9.0 compatibility. (#275) Changes in 0.18 - Don't use unqualified references to `stderr` or `stdout` which may collide with definitions in user code. (#201) - Remove support for cabal-install sandboxes. They have been obsoleted in practice by Nix-style builds in cabal-install (i.e., the `v2-*` commands) and stack. Changes in 0.17 - #266: - doctest now annotates its internal marker string as a `String`, to prevent misbehaviour in `OverloadedStrings` environments. This has a theoretical chance of breakage; if you're affected, please open an issue. - `evalEcho` no longer preserves `it`. Changes in 0.16.3 - Add a cursor to highlight the differing portion between the expected and actual output. (#249) - GHC 8.10 compatibility. (#247, #257) Changes in 0.16.2 - Add doctest's necessary-for-operation options to GHC's command line at the end, so that they over-ride anything provided by the user. (#233) - Allow GHC 8.8. Changes in 0.16.1 - Fix loading plugins in doctests. (#224) - Require QuickCheck 2.13.1 or newer. - Remove dependency on `with-location` Changes in 0.16.0.1 - Bump bounds to allow GHC 8.6. (#210) Changes in 0.16.0 - Output format has changed to (hopefully) be more machine consumable. (#200) Changes in 0.15.0 - Add `--verbose` for printing each test as it is run Changes in 0.14.1 - Add test assets to source tarball (see #189) 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 doctest-0.20.1/LICENSE0000644000000000000000000000206707346545000012442 0ustar0000000000000000Copyright (c) 2009-2022 Simon Hengel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. doctest-0.20.1/README.md0000644000000000000000000003345207346545000012716 0ustar0000000000000000# Doctest: Test interactive Haskell examples `doctest` is a tool that checks [examples](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744) and [properties](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810771856) in Haddock comments. It is similar in spirit to the [popular Python module with the same name](https://docs.python.org/3/library/doctest.html). * [Getting started](#getting-started) * [Installation](#installation) * [A basic example](#a-basic-example) * [Running doctest for a Cabal package](#running-doctest-for-a-cabal-package) * [Writing examples and properties](#writing-examples-and-properties) * [Example groups](#example-groups) * [A note on performance](#a-note-on-performance) * [Setup code](#setup-code) * [Multi-line input](#multi-line-input) * [Multi-line output](#multi-line-output) * [Matching arbitrary output](#matching-arbitrary-output) * [QuickCheck properties](#quickcheck-properties) * [Hiding examples from Haddock](#hiding-examples-from-haddock) * [Using GHC extensions](#using-ghc-extensions) * [Limitations](#limitations) * [Doctest in the wild](#doctest-in-the-wild) * [Development](#development) * [Contributors](#contributors) # Getting started ## Installation `doctest` is available from [Hackage](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/doctest). Install it with: cabal update && 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: set PATH="%AppData%\cabal\bin\;%PATH%" ## A basic example 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 -- src/Fib.hs 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 a [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 can check whether the implementation satisfies the given examples: ``` doctest src/Fib.hs ``` ## Running `doctest` for a Cabal package The easiest way to run `doctest` for a Cabal package is via `cabal repl --with-ghc=doctest`. This doesn't make a big difference for a simple package, but in more involved situations `cabal` will make sure that all dependencies are available and it will pass any required GHC options to `doctest`. A simple `.cabal` file for `Fib` looks like this: ```cabal -- fib.cabal cabal-version: 1.12 name: fib version: 0.0.0 build-type: Simple library build-depends: base == 4.* hs-source-dirs: src exposed-modules: Fib default-language: Haskell2010 ``` With a `.cabal` file in place, it is possible to run `doctest` via `cabal repl`: ``` $ cabal repl --with-ghc=doctest ... Examples: 2 Tried: 2 Errors: 0 Failures: 0 ``` Notes: - If you use properties you need to pass `--build-depends=QuickCheck` and `--build-depends=template-haskell` to `cabal repl`. - `doctest` always uses the version of GHC it was compiled with. Reinstalling `doctest` with `cabal install doctest --overwrite-policy=always` before each invocation ensures that it uses the same version of GHC as is on the `PATH`. - Technically, `cabal build` is not necessary. `cabal repl --with-ghc=doctest` will build any dependencies as needed. However, it's more robust to run `cabal build` first (specifically it is not a good idea to build `ghc-paths` with `--with-ghc=doctest`). So a more robust way to call `doctest` is as follows: ``` cabal install doctest --overwrite-policy=always && cabal build && cabal repl --build-depends=QuickCheck --build-depends=template-haskell --with-ghc=doctest ``` (This is what you want to use on CI.) # Writing examples and properties ## 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 skipped, because `let n = x + y` fails (as `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 x and y aren't 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 ``. 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?" -- -- "Every one of whom do you think?" -- -- "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 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 visible to `doctest` (e.g. by passing `--build-depends=QuickCheck` to `cabal repl`). ```haskell :39:3: Not in scope: ‘polyQuickCheck’ In the splice: $(polyQuickCheck (mkName "doctest_prop")) :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. 1. 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]: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/exts/pragmas.html#language-pragma # Limitations - Doctests only works on platforms that have support for GHC's `--interactive` mode (`ghci`). - Due to [a GHC bug](https://gitlab.haskell.org/ghc/ghc/-/issues/20670), running `:set -XTemplateHaskell` within `ghci` may unload any modules that were specified on the command-line. To address this `doctest >= 0.19.0` does two things: 1. Doctest always enables `-XTemplateHaskell`. So it is safe to use Template Haskell in examples without enabling the extension explicitly. 1. Doctest filters out `-XTemplateHaskell` from single-line `:set`-statements. So it is still safe to include `:set -XTemplateHaskell` in examples for documentation purposes. It may just not work as intended in `ghci` due to that GHC bug. Doctest does not filter out `-XTemplateHaskell` from multi-line `:set`-statements. So if you e.g. use ``` >>> :{ :set -XTemplateHaskell :} ``` then you are on your own. Note that all platforms that support `--interactive` also support `-XTemplateHaskell`. So this approach does not reduce Doctest's platform support. - Modules that are rejected by `haddock` will not work with `doctest`. This can mean that `doctest` fails on input that is accepted by GHC (e.g. [#251](https://github.com/sol/doctest/issues/251)). - Doctest works best with UTF-8. If your locale is e.g. `LC_ALL=C`, you may want to invoke `doctest` with `LC_ALL=C.UTF-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) # Development 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 build --enable-tests && cabal exec -- cabal test --test-show-details=direct # Contributors * Adam Vogt * Alan Zimmerman * Alexander Bernauer * Alexandre Esteves * Anders Persson * Andreas Abel * Ankit Ahuja * Artyom Kazak * Edward Kmett * Gabor Greif * Hiroki Hattori * Ignat Insarov * Jens Petersen * Joachim Breitner * John Chee * João Cristóvão * Julian Arni * Kazu Yamamoto * Leon Schoorl * Levent Erkok * Luke Murphy * Matvey Aksenov * Michael Orlitzky * Michael Snoyman * Mitchell Rosen * Nick Smallbone * Nikos Baxevanis * Oleg Grenrus * quasicomputational * Ryan Scott * Sakari Jokinen * Simon Hengel * Sönke Hahn * Takano Akio * Tamar Christina * Veronika Romashkina For up-to-date list, query git shortlog -s doctest-0.20.1/Setup.lhs0000644000000000000000000000011407346545000013234 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain doctest-0.20.1/doctest.cabal0000644000000000000000000001531007346545000014061 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack name: doctest version: 0.20.1 synopsis: Test interactive Haskell examples description: `doctest` is a tool that checks [examples](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744) and [properties](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810771856) in Haddock comments. It is similar in spirit to the [popular Python module with the same name](https://docs.python.org/3/library/doctest.html). . Documentation is at . 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-2022 Simon Hengel author: Simon Hengel maintainer: quasicomputational@gmail.com, Andreas Abel build-type: Simple extra-source-files: example/example.cabal example/src/Example.hs example/test/doctests.hs test/parse/multiple-examples/Foo.hs test/parse/no-examples/Fib.hs test/parse/non-exported/Fib.hs test/parse/property/Fib.hs test/parse/setup-empty/Foo.hs test/parse/setup-only/Foo.hs test/parse/simple/Fib.hs test/extract/argument-list/Foo.hs test/extract/comment-order/Foo.hs test/extract/declaration/Foo.hs test/extract/dos-line-endings/Foo.hs test/extract/export-list/Foo.hs test/extract/imported-module/Bar.hs test/extract/imported-module/Baz.hs test/extract/module-header/Foo.hs test/extract/named-chunks/Foo.hs test/extract/regression/Fixity.hs test/extract/regression/ForeignImport.hs test/extract/regression/ParallelListComp.hs test/extract/regression/ParallelListCompClass.hs test/extract/regression/RewriteRules.hs test/extract/regression/RewriteRulesWithSigs.hs test/extract/setup/Foo.hs test/extract/th/Bar.hs test/extract/th/Foo.hs test/extract/type-class-args/Foo.hs test/extract/type-class/Foo.hs test/extract/type-families/Foo.hs test/integration/bugfixImportHierarchical/ModuleA.hs test/integration/bugfixImportHierarchical/ModuleB.hs test/integration/bugfixMultipleModules/ModuleA.hs test/integration/bugfixMultipleModules/ModuleB.hs test/integration/bugfixOutputToStdErr/Fib.hs test/integration/bugfixWorkingDirectory/description test/integration/bugfixWorkingDirectory/examples/Fib.hs test/integration/bugfixWorkingDirectory/Fib.hs test/integration/color/Foo.hs test/integration/custom-package-conf/Bar.hs test/integration/custom-package-conf/foo/doctest-foo.cabal test/integration/custom-package-conf/foo/Foo.hs test/integration/dos-line-endings/Fib.hs test/integration/failing-multiple/Foo.hs test/integration/failing/Foo.hs test/integration/it/Foo.hs test/integration/it/Setup.hs test/integration/local-stderr-binding/A.hs test/integration/multiline/Multiline.hs test/integration/parse-error/Foo.hs test/integration/property-bool-with-type-signature/Foo.hs test/integration/property-bool/Foo.hs test/integration/property-failing/Foo.hs test/integration/property-implicitly-quantified/Foo.hs test/integration/property-quantified/Foo.hs test/integration/property-setup/Foo.hs test/integration/setup-skip-on-failure/Foo.hs test/integration/setup/Foo.hs test/integration/system-io-imported/A.hs test/integration/template-haskell-bugfix/Main.hs test/integration/template-haskell-bugfix/Printf.hs test/integration/template-haskell/Foo.hs test/integration/test-options/Foo.hs test/integration/testBlankline/Fib.hs test/integration/testCombinedExample/Fib.hs test/integration/testCommentLocation/Foo.hs test/integration/testCPP/Foo.hs test/integration/testDocumentationForArguments/Fib.hs test/integration/testFailOnMultiline/Fib.hs test/integration/testImport/ModuleA.hs test/integration/testImport/ModuleB.hs test/integration/testPutStr/Fib.hs test/integration/testSimple/Fib.hs test/integration/trailing-whitespace/Foo.hs test/integration/with-cbits/Bar.hs test/integration/with-cbits/foo.c CHANGES.markdown README.md 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 other-modules: Extract GhcUtil Info Interpreter Location Options PackageDBs Parse Property Run Runner Runner.Example Util Language.Haskell.GhciWrapper Paths_doctest build-depends: base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq , directory , exceptions , filepath , ghc >=8.0 && <9.5 , ghc-paths >=0.1.0.9 , process , syb >=0.3 , transformers default-language: Haskell2010 executable doctest main-is: Main.hs other-modules: Paths_doctest ghc-options: -Wall -threaded hs-source-dirs: driver build-depends: base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq , directory , doctest , exceptions , filepath , ghc >=8.0 && <9.5 , ghc-paths >=0.1.0.9 , process , syb >=0.3 , transformers default-language: Haskell2010 test-suite spec main-is: Spec.hs other-modules: ExtractSpec InfoSpec InterpreterSpec LocationSpec MainSpec OptionsSpec Orphans PackageDBsSpec ParseSpec PropertySpec Runner.ExampleSpec RunnerSpec RunSpec UtilSpec Extract GhcUtil Info Interpreter Location Options PackageDBs Parse Property Run Runner Runner.Example 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-tool-depends: hspec-discover:hspec-discover build-depends: HUnit , QuickCheck >=2.13.1 , base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq , directory , exceptions , filepath , ghc >=8.0 && <9.5 , ghc-paths >=0.1.0.9 , hspec >=2.3.0 , hspec-core >=2.3.0 , mockery , process , setenv , silently >=1.2.4 , stringbuilder >=0.4 , syb >=0.3 , transformers default-language: Haskell2010 doctest-0.20.1/driver/0000755000000000000000000000000007346545000012723 5ustar0000000000000000doctest-0.20.1/driver/Main.hs0000644000000000000000000000021707346545000014143 0ustar0000000000000000module Main (main) where import Test.DocTest import System.Environment (getArgs) main :: IO () main = getArgs >>= doctest doctest-0.20.1/example/0000755000000000000000000000000007346545000013063 5ustar0000000000000000doctest-0.20.1/example/example.cabal0000644000000000000000000000056607346545000015511 0ustar0000000000000000name: example version: 0.0.0 build-type: Simple cabal-version: >= 1.8 library hs-source-dirs: src exposed-modules: Example build-depends: base test-suite doctests type: exitcode-stdio-1.0 hs-source-dirs: test main-is: doctests.hs ghc-options: -threaded build-depends: base, doctest >= 0.8 doctest-0.20.1/example/src/0000755000000000000000000000000007346545000013652 5ustar0000000000000000doctest-0.20.1/example/src/Example.hs0000644000000000000000000000012507346545000015577 0ustar0000000000000000module Example where -- | -- >>> foo -- 23 foo = 23 -- | -- >>> bar -- 42 bar = 42 doctest-0.20.1/example/test/0000755000000000000000000000000007346545000014042 5ustar0000000000000000doctest-0.20.1/example/test/doctests.hs0000644000000000000000000000015307346545000016225 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["-isrc", "src/Example.hs"] doctest-0.20.1/ghci-wrapper/src/Language/Haskell/0000755000000000000000000000000007346545000017715 5ustar0000000000000000doctest-0.20.1/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs0000644000000000000000000001205007346545000022462 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Language.Haskell.GhciWrapper ( Interpreter , Config(..) , defaultConfig , new , close , eval , evalIt , evalEcho ) where import System.IO hiding (stdin, stdout, stderr) import System.Process import System.Exit import Control.Monad import Control.Exception import Data.List (isSuffixOf) import Data.Maybe data Config = Config { configGhci :: String , configVerbose :: Bool , configIgnoreDotGhci :: Bool } deriving (Eq, Show) defaultConfig :: Config defaultConfig = Config { configGhci = "ghci" , configVerbose = False , configIgnoreDotGhci = True } -- | Truly random marker, used to separate expressions. -- -- IMPORTANT: This module relies upon the fact that this marker is unique. It -- has been obtained from random.org. Do not expect this module to work -- properly, if you reuse it for any purpose! marker :: String marker = show "dcbd2a1e20ae519a1c7714df2859f1890581d57fac96ba3f499412b2f5c928a1" itMarker :: String itMarker = "d42472243a0e6fc481e7514cbc9eb08812ed48daa29ca815844d86010b1d113a" data Interpreter = Interpreter { hIn :: Handle , hOut :: Handle , process :: ProcessHandle } new :: Config -> [String] -> IO Interpreter new Config{..} args_ = do (Just stdin_, Just stdout_, Nothing, processHandle ) <- createProcess $ (proc configGhci args) {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit} setMode stdin_ setMode stdout_ let interpreter = Interpreter {hIn = stdin_, hOut = stdout_, process = processHandle} evalThrow interpreter "import qualified System.IO" evalThrow interpreter "import qualified GHC.IO.Encoding" evalThrow interpreter "import qualified GHC.IO.Handle" -- The buffering of stdout and stderr is NoBuffering evalThrow interpreter "GHC.IO.Handle.hDuplicateTo System.IO.stdout System.IO.stderr" -- Now the buffering of stderr is BlockBuffering Nothing -- In this situation, GHC 7.7 does not flush the buffer even when -- error happens. evalThrow interpreter "GHC.IO.Handle.hSetBuffering System.IO.stdout GHC.IO.Handle.LineBuffering" evalThrow interpreter "GHC.IO.Handle.hSetBuffering System.IO.stderr GHC.IO.Handle.LineBuffering" -- this is required on systems that don't use utf8 as default encoding (e.g. -- Windows) evalThrow interpreter "GHC.IO.Handle.hSetEncoding System.IO.stdout GHC.IO.Encoding.utf8" evalThrow interpreter "GHC.IO.Handle.hSetEncoding System.IO.stderr GHC.IO.Encoding.utf8" evalThrow interpreter ":m - System.IO" evalThrow interpreter ":m - GHC.IO.Encoding" evalThrow interpreter ":m - GHC.IO.Handle" return interpreter where args = args_ ++ catMaybes [ if configIgnoreDotGhci then Just "-ignore-dot-ghci" else Nothing , if configVerbose then Nothing else Just "-v0" ] setMode h = do hSetBinaryMode h False hSetBuffering h LineBuffering hSetEncoding h utf8 evalThrow :: Interpreter -> String -> IO () evalThrow interpreter expr = do output <- eval interpreter expr unless (null output || configVerbose) $ do close interpreter throwIO (ErrorCall output) close :: Interpreter -> IO () close repl = do hClose $ hIn repl -- It is crucial not to close `hOut` before calling `waitForProcess`, -- otherwise ghci may not cleanly terminate on SIGINT (ctrl-c) and hang -- around consuming 100% CPU. This happens when ghci tries to print -- something to stdout in its signal handler (e.g. when it is blocked in -- threadDelay it writes "Interrupted." on SIGINT). e <- waitForProcess $ process repl hClose $ hOut repl when (e /= ExitSuccess) $ do throwIO (userError $ "Language.Haskell.GhciWrapper.close: Interpreter exited with an error (" ++ show e ++ ")") putExpression :: Interpreter -> Bool -> String -> IO () putExpression Interpreter{hIn = stdin} preserveIt e = do hPutStrLn stdin e when preserveIt $ hPutStrLn stdin $ "let " ++ itMarker ++ " = it" hPutStrLn stdin (marker ++ " :: Data.String.String") when preserveIt $ hPutStrLn stdin $ "let it = " ++ itMarker hFlush stdin getResult :: Bool -> Interpreter -> IO String getResult echoMode Interpreter{hOut = stdout} = go where go = do line <- hGetLine stdout if marker `isSuffixOf` line then do let xs = stripMarker line echo xs return xs else do echo (line ++ "\n") result <- go return (line ++ "\n" ++ result) stripMarker l = take (length l - length marker) l echo :: String -> IO () echo | echoMode = putStr | otherwise = (const $ return ()) -- | Evaluate an expression eval :: Interpreter -> String -> IO String eval repl expr = do putExpression repl False expr getResult False repl -- | Like 'eval', but try to preserve the @it@ variable evalIt :: Interpreter -> String -> IO String evalIt repl expr = do putExpression repl True expr getResult False repl -- | Evaluate an expression evalEcho :: Interpreter -> String -> IO String evalEcho repl expr = do putExpression repl False expr getResult True repl doctest-0.20.1/src/0000755000000000000000000000000007346545000012217 5ustar0000000000000000doctest-0.20.1/src/Extract.hs0000644000000000000000000002364307346545000014175 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-} module Extract (Module(..), extract) where import Prelude hiding (mod, concat) import Control.Monad import Control.Exception import Data.List (partition, isSuffixOf) import Data.Maybe import Control.DeepSeq (deepseq, NFData(rnf)) import Data.Generics #if __GLASGOW_HASKELL__ < 900 import GHC hiding (Module, Located) import DynFlags import MonadUtils (liftIO) #else import GHC hiding (Module, Located) import GHC.Driver.Session import GHC.Utils.Monad (liftIO) #endif #if __GLASGOW_HASKELL__ < 900 import Digraph (flattenSCCs) import Exception (ExceptionMonad) #else import GHC.Data.Graph.Directed (flattenSCCs) import GHC.Utils.Exception (ExceptionMonad) import Control.Monad.Catch (generalBracket) #endif import System.Directory import System.FilePath #if __GLASGOW_HASKELL__ < 805 import FastString (unpackFS) #endif import System.Posix.Internals (c_getpid) import GhcUtil (withGhc) import Location hiding (unLoc) import Util (convertDosLineEndings) import PackageDBs (getPackageDBArgs) #if __GLASGOW_HASKELL__ >= 806 #if __GLASGOW_HASKELL__ < 900 import DynamicLoading (initializePlugins) #else import GHC.Runtime.Loader (initializePlugins) #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 instance Show ExtractError where show (ExtractError e) = unlines [ "Ouch! Hit an error thunk in GHC's AST while extracting documentation." , "" , " " ++ msg , "" , "This is most likely a bug in doctest." , "" , "Please report it here: https://github.com/sol/doctest/issues/new" ] where msg = case fromException e of Just (Panic s) -> "GHC panic: " ++ s _ -> show e instance Exception ExtractError -- | Documentation for a module grouped together with the modules name. data Module a = Module { moduleName :: String , moduleSetup :: Maybe a , moduleContent :: [a] } deriving (Eq, Functor) 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 #endif #if __GLASGOW_HASKELL__ < 805 addQuoteInclude :: [String] -> [String] -> [String] addQuoteInclude includes new = new ++ includes #endif -- | Parse a list of modules. parse :: [String] -> IO [ParsedModule] parse args = withGhc args $ \modules_ -> withTempOutputDir $ do -- ignore additional object files let modules = filter (not . isSuffixOf ".o") modules_ setTargets =<< forM modules (\ m -> guessTarget m #if __GLASGOW_HASKELL__ >= 903 Nothing #endif Nothing) mods <- depanal [] False let sortedMods = flattenSCCs #if __GLASGOW_HASKELL__ >= 901 $ filterToposortToModules #endif $ topSortModuleGraph False mods Nothing reverse <$> mapM (loadModPlugins >=> parseModule) sortedMods where -- copied from Haddock/GhcUtils.hs modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc () modifySessionDynFlags f = do dflags <- getSessionDynFlags -- GHCi 7.7 now uses dynamic linking. let dflags' = case lookup "GHC Dynamic" (compilerInfo dflags) of Just "YES" -> gopt_set dflags Opt_BuildDynamicToo _ -> dflags _ <- setSessionDynFlags (f dflags') return () withTempOutputDir :: Ghc a -> Ghc a withTempOutputDir action = do tmp <- liftIO getTemporaryDirectory x <- liftIO c_getpid let dir = tmp ".doctest-" ++ show x modifySessionDynFlags (setOutputDir dir) gbracket_ (liftIO $ createDirectory dir) (liftIO $ removeDirectoryRecursive dir) action -- | A variant of 'gbracket' where the return value from the first computation -- is not required. gbracket_ :: ExceptionMonad m => m a -> m b -> m c -> m c #if __GLASGOW_HASKELL__ < 900 gbracket_ before_ after thing = gbracket before_ (const after) (const thing) #else gbracket_ before_ after thing = fst <$> generalBracket before_ (\ _ _ -> after) (const thing) #endif setOutputDir f d = d { objectDir = Just f , hiDir = Just f , stubDir = Just f , 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__ >= 902 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 -- | Extract all docstrings from given list of files/modules. -- -- This includes the docstrings of all local modules that are imported from -- those modules (possibly indirect). extract :: [String] -> IO [Module (Located String)] extract args = do packageDBArgs <- getPackageDBArgs let args' = args ++ packageDBArgs mods <- parse args' let docs = map (fmap (fmap convertDosLineEndings) . extractFromModule) mods (docs `deepseq` return docs) `catches` [ -- Re-throw AsyncException, otherwise execution will not terminate on -- SIGINT (ctrl-c). All AsyncExceptions are re-thrown (not just -- UserInterrupt) because all of them indicate severe conditions and -- should not occur during normal operation. Handler (\e -> throw (e :: AsyncException)) , Handler (throwIO . ExtractError) ] -- | Extract all docstrings from given module and attach the modules name. extractFromModule :: ParsedModule -> Module (Located String) extractFromModule m = Module name (listToMaybe $ map snd setup) (map snd docs) where isSetup = (== Just "setup") . fst (setup, docs) = partition isSetup (docStringsFromModule m) name = (moduleNameString . GHC.moduleName . ms_mod . pm_mod_summary) m #if __GLASGOW_HASKELL__ >= 904 unpackHDS :: HsDocString -> String unpackHDS = renderHsDocString #endif -- | Extract all docstrings from given module. docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)] docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs where source = (unLoc . pm_parsed_source) mod -- we use dlist-style concatenation here docs :: [(Maybe String, LHsDocString)] docs = header ++ exports ++ decls -- We process header, exports and declarations separately instead of -- traversing the whole source in a generic way, to ensure that we get -- everything in source order. #if __GLASGOW_HASKELL__ >= 904 header = [(Nothing, hsDocString <$> x) | Just x <- [hsmodHaddockModHeader source]] #else header = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]] #endif exports :: [(Maybe String, LHsDocString)] #if __GLASGOW_HASKELL__ >= 904 exports = [ (Nothing, L (locA loc) (hsDocString (unLoc doc))) #else exports = [ (Nothing, L (locA loc) doc) #endif #if __GLASGOW_HASKELL__ < 805 | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source) #else | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source) #endif ] decls :: [(Maybe String, LHsDocString)] decls = extractDocStrings (hsmodDecls source) -- | Extract all docstrings from given value. extractDocStrings :: Data a => a -> [(Maybe String, LHsDocString)] extractDocStrings d = #if __GLASGOW_HASKELL__ >= 904 let docStrs = extractAll extractDocDocString d docStrNames = catMaybes $ extractAll extractDocName d in flip fmap docStrs $ \docStr -> (lookup (getLoc docStr) docStrNames, docStr) where extractAll z = everything (++) ((mkQ [] ((:[]) . z))) extractDocDocString :: LHsDoc GhcPs -> LHsDocString extractDocDocString = fmap hsDocString extractDocName :: DocDecl GhcPs -> Maybe (SrcSpan, String) extractDocName docDecl = case docDecl of DocCommentNamed name y -> Just (getLoc y, name) _ -> Nothing #else everythingBut (++) (([], False) `mkQ` fromLHsDecl `extQ` fromLDocDecl `extQ` fromLHsDocString ) d where fromLHsDecl :: Selector (LHsDecl GhcPs) fromLHsDecl (L loc decl) = case decl of -- Top-level documentation has to be treated separately, because it has -- no location information attached. The location information is -- attached to HsDecl instead. #if __GLASGOW_HASKELL__ < 805 DocD x #else DocD _ x #endif -> select (fromDocDecl (locA loc) x) _ -> (extractDocStrings decl, True) 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) fromDocDecl :: SrcSpan -> DocDecl -> (Maybe String, LHsDocString) fromDocDecl loc x = case x of DocCommentNamed name doc -> (Just name, L loc doc) _ -> (Nothing, L loc $ docDeclDoc x) type Selector a = a -> ([(Maybe String, LHsDocString)], Bool) -- | Collect given value and descend into subtree. select :: a -> ([a], Bool) select x = ([x], False) #endif #if __GLASGOW_HASKELL__ < 805 -- | 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 doctest-0.20.1/src/GhcUtil.hs0000644000000000000000000000434707346545000014122 0ustar0000000000000000{-# LANGUAGE CPP #-} module GhcUtil (withGhc) where import GHC.Paths (libdir) import GHC #if __GLASGOW_HASKELL__ < 900 import DynFlags (gopt_set) #else import GHC.Driver.Session (gopt_set) #endif #if __GLASGOW_HASKELL__ < 900 import Panic (throwGhcException) #else import GHC.Utils.Panic (throwGhcException) #endif #if __GLASGOW_HASKELL__ < 900 import MonadUtils (liftIO) #else import GHC.Utils.Monad (liftIO) #endif import System.Exit (exitFailure) #if __GLASGOW_HASKELL__ < 801 import StaticFlags (discardStaticFlags) #endif -- Catch GHC source errors, print them and exit. handleSrcErrors :: Ghc a -> Ghc a handleSrcErrors action' = flip handleSourceError action' $ \err -> do printException err liftIO exitFailure -- | Run a GHC action in Haddock mode withGhc :: [String] -> ([String] -> Ghc a) -> IO a withGhc flags action = do flags_ <- handleStaticFlags flags runGhc (Just libdir) $ do handleDynamicFlags flags_ >>= handleSrcErrors . action handleStaticFlags :: [String] -> IO [Located String] #if __GLASGOW_HASKELL__ < 801 handleStaticFlags flags = return $ map noLoc $ discardStaticFlags flags #else handleStaticFlags flags = return $ map noLoc $ flags #endif handleDynamicFlags :: GhcMonad m => [Located String] -> m [String] handleDynamicFlags flags = do #if __GLASGOW_HASKELL__ >= 901 logger <- getLogger let parseDynamicFlags' = parseDynamicFlags logger #else let parseDynamicFlags' = parseDynamicFlags #endif (dynflags, locSrcs, _) <- (setHaddockMode `fmap` getSessionDynFlags) >>= (`parseDynamicFlags'` flags) _ <- setSessionDynFlags dynflags -- We basically do the same thing as `ghc/Main.hs` to distinguish -- "unrecognised flags" from source files. let srcs = map unLoc locSrcs unknown_opts = [ f | f@('-':_) <- srcs ] case unknown_opts of opt : _ -> throwGhcException (UsageError ("unrecognized option `"++ opt ++ "'")) _ -> return srcs setHaddockMode :: DynFlags -> DynFlags setHaddockMode dynflags = (gopt_set dynflags Opt_Haddock) { #if __GLASGOW_HASKELL__ >= 901 backend = NoBackend #else hscTarget = HscNothing #endif , ghcMode = CompManager , ghcLink = NoLink } doctest-0.20.1/src/Info.hs0000644000000000000000000000202407346545000013444 0ustar0000000000000000{-# LANGUAGE CPP #-} module Info ( versionInfo , info #ifdef TEST , formatInfo #endif ) where import Data.List.Compat import System.Process import System.IO.Unsafe #if __GLASGOW_HASKELL__ < 900 import Config as GHC #else import GHC.Settings.Config as GHC #endif import Data.Version (showVersion) import qualified Paths_doctest import Interpreter (ghc) version :: String version = showVersion Paths_doctest.version ghcVersion :: String ghcVersion = GHC.cProjectVersion versionInfo :: String versionInfo = unlines [ "doctest version " ++ version , "using version " ++ ghcVersion ++ " of the GHC API" , "using " ++ ghc ] info :: String info = formatInfo $ ("version", version) : ("ghc_version", ghcVersion) : ("ghc", ghc) : ghcInfo type Info = [(String, String)] ghcInfo :: Info ghcInfo = read $ unsafePerformIO (readProcess ghc ["--info"] "") formatInfo :: Info -> String formatInfo xs = " [" ++ (intercalate "\n ," $ map show xs) ++ "\n ]\n" doctest-0.20.1/src/Interpreter.hs0000644000000000000000000000535507346545000015066 0ustar0000000000000000{-# LANGUAGE CPP #-} module Interpreter ( Interpreter , safeEval , safeEvalIt , withInterpreter , ghc , interpreterSupported -- exported for testing , ghcInfo , haveInterpreterKey , filterExpression ) where import System.Process import System.Directory (getPermissions, executable) import Control.Monad import Control.Exception hiding (handle) import Data.Char import GHC.Paths (ghc) import Language.Haskell.GhciWrapper haveInterpreterKey :: String haveInterpreterKey = "Have interpreter" ghcInfo :: IO [(String, String)] ghcInfo = read <$> readProcess ghc ["--info"] [] interpreterSupported :: IO Bool interpreterSupported = do -- in a perfect world this permission check should never fail, but I know of -- at least one case where it did.. x <- getPermissions ghc unless (executable x) $ do fail $ ghc ++ " is not executable!" maybe False (== "YES") . lookup haveInterpreterKey <$> ghcInfo -- | Run an interpreter session. -- -- Example: -- -- >>> withInterpreter [] $ \i -> eval i "23 + 42" -- ... -- "65\n" withInterpreter :: [String] -- ^ List of flags, passed to GHC -> (Interpreter -> IO a) -- ^ Action to run -> IO a -- ^ Result of action withInterpreter flags action = do let args = flags ++ [ "--interactive" , xTemplateHaskell #if __GLASGOW_HASKELL__ >= 802 , "-fdiagnostics-color=never" , "-fno-diagnostics-show-caret" #endif ] bracket (new defaultConfig{configGhci = ghc} args) close action xTemplateHaskell :: String xTemplateHaskell = "-XTemplateHaskell" -- | Evaluate an expression; return a Left value on exceptions. -- -- An exception may e.g. be caused on unterminated multiline expressions. safeEval :: Interpreter -> String -> IO (Either String String) safeEval repl = either (return . Left) (fmap Right . eval repl) . filterExpression safeEvalIt :: Interpreter -> String -> IO (Either String String) safeEvalIt repl = either (return . Left) (fmap Right . evalIt repl) . filterExpression filterExpression :: String -> Either String String filterExpression e = case lines e of [] -> Right e l -> if firstLine == ":{" && lastLine /= ":}" then err else Right (filterXTemplateHaskell e) where firstLine = strip $ head l lastLine = strip $ last l err = Left "unterminated multi-line command" where strip :: String -> String strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse filterXTemplateHaskell :: String -> String filterXTemplateHaskell input = case words input of [":set", setting] | setting == xTemplateHaskell -> "" ":set" : xs | xTemplateHaskell `elem` xs -> unwords $ ":set" : filter (/= xTemplateHaskell) xs _ -> input doctest-0.20.1/src/Location.hs0000644000000000000000000000412407346545000014324 0ustar0000000000000000{-# LANGUAGE CPP, DeriveFunctor #-} module Location where import Control.DeepSeq (deepseq, NFData(rnf)) #if __GLASGOW_HASKELL__ < 900 import SrcLoc hiding (Located) import qualified SrcLoc as GHC import FastString (unpackFS) #else import GHC.Types.SrcLoc hiding (Located) import qualified GHC.Types.SrcLoc as GHC import GHC.Data.FastString (unpackFS) #endif -- | A thing with a location attached. data Located a = Located Location a deriving (Eq, Show, Functor) instance NFData a => NFData (Located a) where rnf (Located loc a) = loc `deepseq` a `deepseq` () -- | Convert a GHC located thing to a located thing. toLocated :: GHC.Located a -> Located a toLocated (L loc a) = Located (toLocation loc) a -- | Discard location information. unLoc :: Located a -> a unLoc (Located _ a) = a -- | Add dummy location information. noLocation :: a -> Located a noLocation = Located (UnhelpfulLocation "") -- | A line number. type Line = Int -- | A combination of file name and line number. data Location = UnhelpfulLocation String | Location FilePath Line deriving Eq instance Show Location where show (UnhelpfulLocation s) = s show (Location file line) = file ++ ":" ++ show line instance NFData Location where rnf (UnhelpfulLocation str) = str `deepseq` () rnf (Location file line) = file `deepseq` line `deepseq` () -- | -- Create a list from a location, by repeatedly increasing the line number by -- one. enumerate :: Location -> [Location] enumerate loc = case loc of UnhelpfulLocation _ -> repeat loc Location file line -> map (Location file) [line ..] -- | Convert a GHC source span to a location. toLocation :: SrcSpan -> Location #if __GLASGOW_HASKELL__ < 900 toLocation loc = case loc of UnhelpfulSpan str -> UnhelpfulLocation (unpackFS str) RealSrcSpan sp -> Location (unpackFS . srcSpanFile $ sp) (srcSpanStartLine sp) #else toLocation loc = case loc of UnhelpfulSpan str -> UnhelpfulLocation (unpackFS $ unhelpfulSpanFS str) RealSrcSpan sp _ -> Location (unpackFS . srcSpanFile $ sp) (srcSpanStartLine sp) #endif doctest-0.20.1/src/Options.hs0000644000000000000000000001077507346545000014220 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} module Options ( Result(..) , Run(..) , defaultMagic , defaultFastMode , defaultPreserveIt , defaultVerbose , parseOptions #ifdef TEST , usage , info , versionInfo , nonInteractiveGhcOptions #endif ) where import Prelude () import Prelude.Compat import Control.Monad.Trans.RWS (RWS, execRWS) import qualified Control.Monad.Trans.RWS as RWS import Control.Monad (when) import Data.List.Compat (stripPrefix) import Data.Monoid (Endo (Endo)) import Info usage :: String usage = unlines [ "Usage:" , " doctest [ --fast | --preserve-it | --no-magic | --verbose | GHC OPTION | MODULE ]..." , " doctest --help" , " doctest --version" , " doctest --info" , "" , "Options:" , " --fast disable :reload between example groups" , " --preserve-it preserve the `it` variable between examples" , " --verbose print each test as it is run" , " --help display this help and exit" , " --version output version information and exit" , " --info output machine-readable version information and exit" ] data Result a = RunGhc [String] | Output String | Result a deriving (Eq, Show, Functor) type Warning = String data Run = Run { runWarnings :: [Warning] , runOptions :: [String] , runMagicMode :: Bool , runFastMode :: Bool , runPreserveIt :: Bool , runVerbose :: Bool } deriving (Eq, Show) nonInteractiveGhcOptions :: [String] nonInteractiveGhcOptions = [ "--numeric-version" , "--supported-languages" , "--info" , "--print-global-package-db" , "--print-libdir" , "-c" , "-o" , "--make" , "--abi-hash" ] defaultMagic :: Bool defaultMagic = True defaultFastMode :: Bool defaultFastMode = False defaultPreserveIt :: Bool defaultPreserveIt = False defaultVerbose :: Bool defaultVerbose = False defaultRun :: Run defaultRun = Run { runWarnings = [] , runOptions = [] , runMagicMode = defaultMagic , runFastMode = defaultFastMode , runPreserveIt = defaultPreserveIt , runVerbose = defaultVerbose } modifyWarnings :: ([String] -> [String]) -> Run -> Run modifyWarnings f run = run { runWarnings = f (runWarnings run) } setOptions :: [String] -> Run -> Run setOptions opts run = run { runOptions = opts } setMagicMode :: Bool -> Run -> Run setMagicMode magic run = run { runMagicMode = magic } setFastMode :: Bool -> Run -> Run setFastMode fast run = run { runFastMode = fast } setPreserveIt :: Bool -> Run -> Run setPreserveIt preserveIt run = run { runPreserveIt = preserveIt } setVerbose :: Bool -> Run -> Run setVerbose verbose run = run { runVerbose = verbose } parseOptions :: [String] -> Result Run parseOptions args | "--info" `elem` args = Output info | "--interactive" `elem` args = Result Run { runWarnings = [] , runOptions = filter (/= "--interactive") args , runMagicMode = False , runFastMode = False , runPreserveIt = False , runVerbose = False } | any (`elem` nonInteractiveGhcOptions) args = RunGhc args | "--help" `elem` args = Output usage | "--version" `elem` args = Output versionInfo | otherwise = case execRWS parse () args of (xs, Endo setter) -> Result (setOptions xs $ setter defaultRun) where parse :: RWS () (Endo Run) [String] () parse = do stripNoMagic stripFast stripPreserveIt stripVerbose stripOptGhc stripNoMagic :: RWS () (Endo Run) [String] () stripNoMagic = stripFlag (setMagicMode False) "--no-magic" stripFast :: RWS () (Endo Run) [String] () stripFast = stripFlag (setFastMode True) "--fast" stripPreserveIt :: RWS () (Endo Run) [String] () stripPreserveIt = stripFlag (setPreserveIt True) "--preserve-it" stripVerbose :: RWS () (Endo Run) [String] () stripVerbose = stripFlag (setVerbose True) "--verbose" stripFlag :: (Run -> Run) -> String -> RWS () (Endo Run) [String] () stripFlag setter flag = do args <- RWS.get when (flag `elem` args) $ RWS.tell (Endo setter) RWS.put (filter (/= flag) args) stripOptGhc :: RWS () (Endo Run) [String] () stripOptGhc = do issueWarning <- RWS.state go when issueWarning $ RWS.tell $ Endo $ modifyWarnings (++ [warning]) where go args = case args of [] -> (False, []) "--optghc" : opt : rest -> (True, opt : snd (go rest)) opt : rest -> maybe (fmap (opt :)) (\x (_, xs) -> (True, x : xs)) (stripPrefix "--optghc=" opt) (go rest) warning = "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly." doctest-0.20.1/src/PackageDBs.hs0000644000000000000000000000342307346545000014501 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Manage GHC package databases module PackageDBs ( getPackageDBArgs #ifdef TEST , PackageDBs (..) , getPackageDBsFromEnv #endif ) where import System.Environment (getEnvironment) import System.FilePath (splitSearchPath, searchPathSeparator) -- | Full stack of GHC package databases data PackageDBs = PackageDBs { includeUser :: Bool , includeGlobal :: Bool , extraDBs :: [FilePath] } deriving (Show, Eq) -- | Determine command line arguments to be passed to GHC to set databases correctly -- -- >>> dbArgs (PackageDBs False True []) -- ["-no-user-package-db"] -- -- >>> dbArgs (PackageDBs True True ["somedb"]) -- ["-package-db","somedb"] dbArgs :: PackageDBs -> [String] dbArgs (PackageDBs user global extras) = (if user then id else ("-no-user-package-db":)) $ (if global then id else ("-no-global-package-db":)) $ concatMap (\extra -> ["-package-db", extra]) extras -- | Determine the PackageDBs based on the environment. getPackageDBsFromEnv :: IO PackageDBs getPackageDBsFromEnv = do env <- getEnvironment return $ case () of () | Just packageDBs <- lookup "GHC_PACKAGE_PATH" env -> fromEnvMulti packageDBs | otherwise -> PackageDBs True True [] where fromEnvMulti s = PackageDBs { includeUser = False , includeGlobal = global , extraDBs = splitSearchPath s' } where (s', global) = case reverse s of c:rest | c == searchPathSeparator -> (reverse rest, True) _ -> (s, False) -- | Get the package DB flags for the current GHC version and from the -- environment. getPackageDBArgs :: IO [String] getPackageDBArgs = do dbs <- getPackageDBsFromEnv return $ dbArgs dbs doctest-0.20.1/src/Parse.hs0000644000000000000000000001325407346545000013632 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-} module Parse ( Module (..) , DocTest (..) , Interaction , Expression , ExpectedResult , ExpectedLine (..) , LineChunk (..) , getDocTests -- * exported for testing , parseInteractions , parseProperties , mkLineChunks ) where import Data.Char (isSpace) import Data.List (isPrefixOf, stripPrefix) import Data.Maybe import Data.String import Extract import Location data DocTest = Example Expression ExpectedResult | Property Expression deriving (Eq, Show) data LineChunk = LineChunk String | WildCardChunk deriving (Show, Eq) instance IsString LineChunk where fromString = LineChunk data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine deriving (Show, Eq) instance IsString ExpectedLine where fromString = ExpectedLine . return . LineChunk type Expression = String type ExpectedResult = [ExpectedLine] type Interaction = (Expression, ExpectedResult) -- | -- Extract 'DocTest's from all given modules and all modules included by the -- given modules. getDocTests :: [String] -> IO [Module [Located DocTest]] -- ^ Extracted 'DocTest's getDocTests args = parseModules <$> extract args parseModules :: [Module (Located String)] -> [Module [Located DocTest]] parseModules = filter (not . isEmpty) . map parseModule where isEmpty (Module _ setup tests) = null tests && isNothing setup -- | Convert documentation to `Example`s. parseModule :: Module (Located String) -> Module [Located DocTest] parseModule m = case parseComment <$> m of Module name setup tests -> Module name setup_ (filter (not . null) tests) where setup_ = case setup of Just [] -> Nothing _ -> setup parseComment :: Located String -> [Located DocTest] parseComment c = properties ++ examples where examples = map (fmap $ uncurry Example) (parseInteractions c) properties = map (fmap Property) (parseProperties c) -- | Extract all properties from given Haddock comment. parseProperties :: Located String -> [Located Expression] parseProperties (Located loc input) = go $ zipWith Located (enumerate loc) (lines input) where isPrompt :: Located String -> Bool isPrompt = isPrefixOf "prop>" . dropWhile isSpace . unLoc go xs = case dropWhile (not . isPrompt) xs of prop:rest -> stripPrompt `fmap` prop : go rest [] -> [] stripPrompt = strip . drop 5 . dropWhile isSpace -- | Extract all interactions from given Haddock comment. parseInteractions :: Located String -> [Located Interaction] parseInteractions (Located loc input) = go $ zipWith Located (enumerate loc) (lines input) where isPrompt :: Located String -> Bool isPrompt = isPrefixOf ">>>" . dropWhile isSpace . unLoc isBlankLine :: Located String -> Bool isBlankLine = null . dropWhile isSpace . unLoc isEndOfInteraction :: Located String -> Bool isEndOfInteraction x = isPrompt x || isBlankLine x go :: [Located String] -> [Located Interaction] go xs = case dropWhile (not . isPrompt) xs of prompt:rest | ":{" : _ <- words (drop 3 (dropWhile isSpace (unLoc prompt))), (ys,zs) <- break isBlankLine rest -> toInteraction prompt ys : go zs | otherwise -> let (ys,zs) = break isEndOfInteraction rest in toInteraction prompt ys : go zs [] -> [] -- | Create an `Interaction`, strip superfluous whitespace as appropriate. -- -- also merge lines between :{ and :}, preserving whitespace inside -- the block (since this is useful for avoiding {;}). toInteraction :: Located String -> [Located String] -> Located Interaction toInteraction (Located loc x) xs = Located loc $ ( (strip cleanedE) -- we do not care about leading and trailing -- whitespace in expressions, so drop them , map mkExpectedLine result_ ) where -- 1. drop trailing whitespace from the prompt, remember the prefix (prefix, e) = span isSpace x (ePrompt, eRest) = splitAt 3 e -- 2. drop, if possible, the exact same sequence of whitespace -- characters from each result line unindent pre = map (tryStripPrefix pre . unLoc) cleanBody line = fromMaybe (unLoc line) (stripPrefix ePrompt (dropWhile isSpace (unLoc line))) (cleanedE, result_) | (body , endLine : rest) <- break ( (==) [":}"] . take 1 . words . cleanBody) xs = (unlines (eRest : map cleanBody body ++ [dropWhile isSpace (cleanBody endLine)]), unindent (takeWhile isSpace (unLoc endLine)) rest) | otherwise = (eRest, unindent prefix xs) tryStripPrefix :: String -> String -> String tryStripPrefix prefix ys = fromMaybe ys $ stripPrefix prefix ys mkExpectedLine :: String -> ExpectedLine mkExpectedLine x = case x of "" -> "" "..." -> WildCardLine _ -> ExpectedLine $ mkLineChunks x mkLineChunks :: String -> [LineChunk] mkLineChunks = finish . foldr go (0, [], []) where mkChunk :: String -> [LineChunk] mkChunk "" = [] mkChunk x = [LineChunk x] go :: Char -> (Int, String, [LineChunk]) -> (Int, String, [LineChunk]) go '.' (count, acc, res) = if count == 2 then (0, "", WildCardChunk : mkChunk acc ++ res) else (count + 1, acc, res) go c (count, acc, res) = if count > 0 then (0, c : replicate count '.' ++ acc, res) else (0, c : acc, res) finish (count, acc, res) = mkChunk (replicate count '.' ++ acc) ++ res -- | Remove leading and trailing whitespace. strip :: String -> String strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse doctest-0.20.1/src/Property.hs0000644000000000000000000000436207346545000014404 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} module Property ( runProperty , PropertyResult (..) #ifdef TEST , freeVariables , parseNotInScope #endif ) where import Data.List import Data.Maybe import Data.Foldable import Util import Interpreter (Interpreter) import qualified Interpreter import Parse -- | The result of evaluating an interaction. data PropertyResult = Success | Failure String | Error String deriving (Eq, Show) runProperty :: Interpreter -> Expression -> IO PropertyResult runProperty repl expression = do _ <- Interpreter.safeEval repl "import Test.QuickCheck ((==>))" _ <- Interpreter.safeEval repl "import Test.QuickCheck.All (polyQuickCheck)" _ <- Interpreter.safeEval repl "import Language.Haskell.TH (mkName)" r <- freeVariables repl expression >>= (Interpreter.safeEval repl . quickCheck expression) case r of Left err -> do return (Error err) Right res | "OK, passed" `isInfixOf` res -> return Success | otherwise -> do let msg = stripEnd (takeWhileEnd (/= '\b') res) return (Failure msg) where quickCheck term vars = "let doctest_prop " ++ unwords vars ++ " = " ++ term ++ "\n" ++ "$(polyQuickCheck (mkName \"doctest_prop\"))" -- | Find all free variables in given term. -- -- GHCi is used to detect free variables. freeVariables :: Interpreter -> String -> IO [String] freeVariables repl term = do r <- Interpreter.safeEval repl (":type " ++ term) return (either (const []) (nub . parseNotInScope) r) -- | Parse and return all variables that are not in scope from a ghc error -- message. parseNotInScope :: String -> [String] parseNotInScope = nub . mapMaybe extractVariable . lines where -- | Extract variable name from a "Not in scope"-error. extractVariable :: String -> Maybe String extractVariable x | "Not in scope: " `isInfixOf` x = Just . unquote . takeWhileEnd (/= ' ') $ x | Just y <- (asum $ map (stripPrefix "Variable not in scope: ") (tails x)) = Just (takeWhile (/= ' ') y) | otherwise = Nothing -- | Remove quotes from given name, if any. unquote ('`':xs) = init xs unquote ('\8216':xs) = init xs unquote xs = xs doctest-0.20.1/src/Run.hs0000644000000000000000000001044007346545000013316 0ustar0000000000000000{-# LANGUAGE CPP #-} module Run ( doctest #ifdef TEST , doctestWithOptions , Summary , expandDirs #endif ) where import Prelude () import Prelude.Compat import Control.Monad (when, unless) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.Environment (getEnvironment) import System.Exit (exitFailure, exitSuccess) import System.FilePath ((), takeExtension) import System.IO import System.IO.CodePage (withCP65001) import System.Process (rawSystem) import qualified Control.Exception as E #if __GLASGOW_HASKELL__ < 900 import Panic #else import GHC.Utils.Panic #endif import PackageDBs import Parse import Options import Runner import qualified Interpreter -- | Run doctest with given list of arguments. -- -- Example: -- -- >>> doctest ["-iexample/src", "example/src/Example.hs"] -- ... -- Examples: 2 Tried: 2 Errors: 0 Failures: 0 -- -- This can be used to create a Cabal test suite that runs doctest for your -- project. -- -- If a directory is given, it is traversed to find all .hs and .lhs files -- inside of it, ignoring hidden entries. doctest :: [String] -> IO () doctest args0 = case parseOptions args0 of RunGhc args -> rawSystem Interpreter.ghc args >>= E.throwIO Output s -> putStr s Result (Run warnings args_ magicMode fastMode preserveIt verbose) -> do mapM_ (hPutStrLn stderr) warnings hFlush stderr i <- Interpreter.interpreterSupported unless i $ do hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests" exitSuccess args <- case magicMode of False -> return args_ True -> do expandedArgs <- concat <$> mapM expandDirs args_ packageDBArgs <- getPackageDBArgs addDistArgs <- getAddDistArgs return (addDistArgs $ packageDBArgs ++ expandedArgs) r <- doctestWithOptions fastMode preserveIt verbose args `E.catch` \e -> do case fromException e of Just (UsageError err) -> do hPutStrLn stderr ("doctest: " ++ err) hPutStrLn stderr "Try `doctest --help' for more information." exitFailure _ -> E.throwIO e when (not $ isSuccess r) exitFailure -- | Expand a reference to a directory to all .hs and .lhs files within it. expandDirs :: String -> IO [String] expandDirs fp0 = do isDir <- doesDirectoryExist fp0 if isDir then findHaskellFiles fp0 else return [fp0] where findHaskellFiles dir = do contents <- getDirectoryContents dir concat <$> mapM go (filter (not . hidden) contents) where go name = do isDir <- doesDirectoryExist fp if isDir then findHaskellFiles fp else if isHaskellFile fp then return [fp] else return [] where fp = dir name hidden ('.':_) = True hidden _ = False isHaskellFile fp = takeExtension fp `elem` [".hs", ".lhs"] -- | Get the necessary arguments to add the @cabal_macros.h@ file and autogen -- directory, if present. getAddDistArgs :: IO ([String] -> [String]) getAddDistArgs = do env <- getEnvironment let dist = case lookup "HASKELL_DIST_DIR" env of Nothing -> "dist" Just x -> x autogen = dist ++ "/build/autogen/" cabalMacros = autogen ++ "cabal_macros.h" dirExists <- doesDirectoryExist autogen if dirExists then do fileExists <- doesFileExist cabalMacros return $ \rest -> concat ["-i", dist, "/build/autogen/"] : "-optP-include" : (if fileExists then (concat ["-optP", dist, "/build/autogen/cabal_macros.h"]:) else id) rest else return id isSuccess :: Summary -> Bool isSuccess s = sErrors s == 0 && sFailures s == 0 doctestWithOptions :: Bool -> Bool -> Bool -> [String] -> IO Summary doctestWithOptions fastMode preserveIt verbose args = do -- get examples from Haddock comments modules <- getDocTests args Interpreter.withInterpreter args $ \repl -> withCP65001 $ do runModules fastMode preserveIt verbose repl modules doctest-0.20.1/src/Runner.hs0000644000000000000000000001655207346545000014035 0ustar0000000000000000{-# LANGUAGE CPP #-} module Runner ( runModules , Summary(..) #ifdef TEST , Report , ReportState (..) , report , report_ #endif ) where import Prelude hiding (putStr, putStrLn, error) import Control.Monad hiding (forM_) import Text.Printf (printf) import System.IO (hPutStrLn, hPutStr, stderr, hIsTerminalDevice) import Data.Foldable (forM_) import Control.Monad.Trans.State import Control.Monad.IO.Class import Interpreter (Interpreter) import qualified Interpreter import Parse import Location import Property import Runner.Example -- | Summary of a test run. data Summary = Summary { sExamples :: Int , sTried :: Int , sErrors :: Int , sFailures :: Int } deriving Eq -- | Format a summary. instance Show Summary where 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 #if __GLASGOW_HASKELL__ < 804 mappend #else instance Semigroup Summary where (<>) #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 -> Bool -> Interpreter -> [Module [Located DocTest]] -> IO Summary runModules fastMode preserveIt verbose repl modules = do isInteractive <- hIsTerminalDevice stderr ReportState _ _ _ s <- (`execStateT` ReportState 0 isInteractive verbose mempty {sExamples = c}) $ do forM_ modules $ runModule fastMode preserveIt repl verboseReport "# Final summary:" gets (show . reportStateSummary) >>= report return s where c = (sum . map count) modules -- | Count number of expressions in given module. count :: Module [Located DocTest] -> Int count (Module _ setup tests) = sum (map length tests) + maybe 0 length setup -- | A monad for generating test reports. type Report = StateT ReportState IO data ReportState = ReportState { reportStateCount :: Int -- ^ characters on the current line , reportStateInteractive :: Bool -- ^ should intermediate results be printed? , reportStateVerbose :: Bool , reportStateSummary :: Summary -- ^ test summary } -- | Add output to the report. report :: String -> Report () report msg = do overwrite msg -- add a newline, this makes the output permanent liftIO $ hPutStrLn stderr "" modify (\st -> st {reportStateCount = 0}) -- | Add intermediate output to the report. -- -- This will be overwritten by subsequent calls to `report`/`report_`. -- Intermediate out may not contain any newlines. report_ :: String -> Report () report_ msg = do f <- gets reportStateInteractive when f $ do overwrite msg modify (\st -> st {reportStateCount = length msg}) -- | Add output to the report, overwrite any intermediate out. overwrite :: String -> Report () overwrite msg = do n <- gets reportStateCount let str | 0 < n = "\r" ++ msg ++ replicate (n - length msg) ' ' | otherwise = msg liftIO (hPutStr stderr str) -- | Run all examples from given module. runModule :: Bool -> Bool -> Interpreter -> Module [Located DocTest] -> Report () runModule fastMode preserveIt repl (Module module_ setup examples) = do Summary _ _ e0 f0 <- gets reportStateSummary forM_ setup $ runTestGroup preserveIt repl reload Summary _ _ e1 f1 <- gets reportStateSummary -- only run tests, if setup does not produce any errors/failures when (e0 == e1 && f0 == f1) $ forM_ examples $ runTestGroup preserveIt repl setup_ where reload :: IO () reload = do unless fastMode $ -- NOTE: It is important to do the :reload first! See -- https://ghc.haskell.org/trac/ghc/ticket/5904, which results in a -- panic on GHC 7.4.1 if you do the :reload second. void $ Interpreter.safeEval repl ":reload" void $ Interpreter.safeEval repl $ ":m *" ++ module_ when preserveIt $ -- Evaluate a dumb expression to populate the 'it' variable NOTE: This is -- one reason why we cannot have safeEval = safeEvalIt: 'it' isn't set in -- a fresh GHCi session. void $ Interpreter.safeEval repl $ "()" setup_ :: IO () setup_ = do reload forM_ setup $ \l -> forM_ l $ \(Located _ x) -> case x of Property _ -> return () Example e _ -> void $ safeEvalWith preserveIt repl e reportStart :: Location -> Expression -> String -> Report () reportStart loc expression testType = do verboseReport (printf "### Started execution at %s.\n### %s:\n%s" (show loc) testType expression) reportFailure :: Location -> Expression -> [String] -> Report () reportFailure loc expression err = do report (printf "%s: failure in expression `%s'" (show loc) expression) mapM_ report err report "" updateSummary (Summary 0 1 0 1) reportError :: Location -> Expression -> String -> Report () reportError loc expression err = do report (printf "%s: error in expression `%s'" (show loc) expression) report err report "" updateSummary (Summary 0 1 1 0) reportSuccess :: Report () reportSuccess = do verboseReport "### Successful!\n" updateSummary (Summary 0 1 0 0) verboseReport :: String -> Report () verboseReport xs = do verbose <- gets reportStateVerbose when verbose $ report xs updateSummary :: Summary -> Report () updateSummary summary = do ReportState n f v s <- get put (ReportState n f v $ s `mappend` summary) reportProgress :: Report () reportProgress = do verbose <- gets reportStateVerbose when (not verbose) $ gets (show . reportStateSummary) >>= report_ -- | Run given test group. -- -- The interpreter state is zeroed with @:reload@ first. This means that you -- can reuse the same 'Interpreter' for several test groups. runTestGroup :: Bool -> Interpreter -> IO () -> [Located DocTest] -> Report () runTestGroup preserveIt repl setup tests = do reportProgress liftIO setup runExampleGroup preserveIt repl examples forM_ properties $ \(loc, expression) -> do r <- do liftIO setup reportStart loc expression "property" liftIO $ runProperty repl expression case r of Success -> reportSuccess Error err -> do reportError loc expression err Failure msg -> do reportFailure loc expression [msg] where properties = [(loc, p) | Located loc (Property p) <- tests] examples :: [Located Interaction] examples = [Located loc (e, r) | Located loc (Example e r) <- tests] -- | -- Execute all expressions from given example in given 'Interpreter' and verify -- the output. runExampleGroup :: Bool -> Interpreter -> [Located Interaction] -> Report () runExampleGroup preserveIt repl = go where go ((Located loc (expression, expected)) : xs) = do reportStart loc expression "example" r <- fmap lines <$> liftIO (safeEvalWith preserveIt repl expression) case r of Left err -> do reportError loc expression err Right actual -> case mkResult expected actual of NotEqual err -> do reportFailure loc expression err Equal -> do reportSuccess go xs go [] = return () safeEvalWith :: Bool -> Interpreter -> String -> IO (Either String String) safeEvalWith preserveIt | preserveIt = Interpreter.safeEvalIt | otherwise = Interpreter.safeEval doctest-0.20.1/src/Runner/0000755000000000000000000000000007346545000013470 5ustar0000000000000000doctest-0.20.1/src/Runner/Example.hs0000644000000000000000000001251407346545000015422 0ustar0000000000000000module Runner.Example ( Result (..) , mkResult ) where import Data.Char import Data.List (isPrefixOf) import Util import Parse maxBy :: (Ord a) => (b -> a) -> b -> b -> b maxBy f x y = case compare (f x) (f y) of LT -> y EQ -> x GT -> x data Result = Equal | NotEqual [String] deriving (Eq, Show) mkResult :: ExpectedResult -> [String] -> Result mkResult expected_ actual_ = case expected `matches` actual of Full -> Equal Partial partial -> NotEqual (formatNotEqual expected actual partial) where -- use show to escape special characters in output lines if any output line -- contains any unsafe character escapeOutput | any (not . isSafe) $ concat (expectedAsString ++ actual_) = init . tail . show . stripEnd | otherwise = id actual :: [String] actual = fmap escapeOutput actual_ expected :: ExpectedResult expected = fmap (transformExcpectedLine escapeOutput) expected_ expectedAsString :: [String] expectedAsString = map (\x -> case x of ExpectedLine str -> concatMap lineChunkToString str WildCardLine -> "..." ) expected_ isSafe :: Char -> Bool isSafe c = c == ' ' || (isPrint c && (not . isSpace) c) chunksMatch :: [LineChunk] -> String -> Match ChunksDivergence chunksMatch [] "" = Full chunksMatch [LineChunk xs] ys = if stripEnd xs == stripEnd ys then Full else Partial $ matchingPrefix xs ys chunksMatch (LineChunk x : xs) ys = if x `isPrefixOf` ys then fmap (prependText x) $ (xs `chunksMatch` drop (length x) ys) else Partial $ matchingPrefix x ys chunksMatch zs@(WildCardChunk : xs) (_:ys) = -- Prefer longer matches. fmap prependWildcard $ maxBy (fmap $ length . matchText) (chunksMatch xs ys) (chunksMatch zs ys) chunksMatch [WildCardChunk] [] = Full chunksMatch (WildCardChunk:_) [] = Partial (ChunksDivergence "" "") chunksMatch [] (_:_) = Partial (ChunksDivergence "" "") matchingPrefix xs ys = let common = fmap fst (takeWhile (\(x, y) -> x == y) (xs `zip` ys)) in ChunksDivergence common common matches :: ExpectedResult -> [String] -> Match LinesDivergence matches (ExpectedLine x : xs) (y : ys) = case x `chunksMatch` y of Full -> fmap incLineNo $ xs `matches` ys Partial partial -> Partial (LinesDivergence 1 (expandedWildcards partial)) matches zs@(WildCardLine : xs) us@(_ : ys) = -- Prefer longer matches, and later ones of equal length. let matchWithoutWC = xs `matches` us in let matchWithWC = fmap incLineNo (zs `matches` ys) in let key (LinesDivergence lineNo line) = (length line, lineNo) in maxBy (fmap key) matchWithoutWC matchWithWC matches [WildCardLine] [] = Full matches [] [] = Full matches [] _ = Partial (LinesDivergence 1 "") matches _ [] = Partial (LinesDivergence 1 "") -- Note: order of constructors matters, so that full matches sort as -- greater than partial. data Match a = Partial a | Full deriving (Eq, Ord, Show) instance Functor Match where fmap f (Partial a) = Partial (f a) fmap _ Full = Full data ChunksDivergence = ChunksDivergence { matchText :: String, expandedWildcards :: String } deriving (Show) prependText :: String -> ChunksDivergence -> ChunksDivergence prependText s (ChunksDivergence mt wct) = ChunksDivergence (s++mt) (s++wct) prependWildcard :: ChunksDivergence -> ChunksDivergence prependWildcard (ChunksDivergence mt wct) = ChunksDivergence mt ('.':wct) data LinesDivergence = LinesDivergence { _mismatchLineNo :: Int, _partialLine :: String } deriving (Show) incLineNo :: LinesDivergence -> LinesDivergence incLineNo (LinesDivergence lineNo partialLineMatch) = LinesDivergence (lineNo + 1) partialLineMatch formatNotEqual :: ExpectedResult -> [String] -> LinesDivergence -> [String] formatNotEqual expected_ actual partial = formatLines "expected: " expected ++ formatLines " but got: " (lineMarker wildcard partial actual) where expected :: [String] expected = map (\x -> case x of ExpectedLine str -> concatMap lineChunkToString str WildCardLine -> "..." ) expected_ formatLines :: String -> [String] -> [String] formatLines message xs = case xs of y:ys -> (message ++ y) : map (padding ++) ys [] -> [message] where padding = replicate (length message) ' ' wildcard :: Bool wildcard = any (\x -> case x of ExpectedLine xs -> any (\y -> case y of { WildCardChunk -> True; _ -> False }) xs WildCardLine -> True ) expected_ lineChunkToString :: LineChunk -> String lineChunkToString WildCardChunk = "..." lineChunkToString (LineChunk str) = str transformExcpectedLine :: (String -> String) -> ExpectedLine -> ExpectedLine transformExcpectedLine f (ExpectedLine xs) = ExpectedLine $ fmap (\el -> case el of LineChunk s -> LineChunk $ f s WildCardChunk -> WildCardChunk ) xs transformExcpectedLine _ WildCardLine = WildCardLine lineMarker :: Bool -> LinesDivergence -> [String] -> [String] lineMarker wildcard (LinesDivergence row expanded) actual = let (pre, post) = splitAt row actual in pre ++ [(if wildcard && length expanded > 30 -- show expanded pattern if match is long, to help understanding what matched what then expanded else replicate (length expanded) ' ') ++ "^"] ++ post doctest-0.20.1/src/Test/0000755000000000000000000000000007346545000013136 5ustar0000000000000000doctest-0.20.1/src/Test/DocTest.hs0000644000000000000000000000007607346545000015042 0ustar0000000000000000module Test.DocTest ( doctest ) where import Run doctest-0.20.1/src/Util.hs0000644000000000000000000000131307346545000013466 0ustar0000000000000000module Util where import Data.Char convertDosLineEndings :: String -> String convertDosLineEndings = go where go input = case input of '\r':'\n':xs -> '\n' : go xs -- Haddock comments from source files with dos line endings end with a -- CR, so we strip that, too. "\r" -> "" x:xs -> x : go xs "" -> "" -- | Return the longest suffix of elements that satisfy a given predicate. takeWhileEnd :: (a -> Bool) -> [a] -> [a] takeWhileEnd p = reverse . takeWhile p . reverse -- | Remove trailing white space from a string. -- -- >>> stripEnd "foo " -- "foo" stripEnd :: String -> String stripEnd = reverse . dropWhile isSpace . reverse doctest-0.20.1/test/0000755000000000000000000000000007346545000012407 5ustar0000000000000000doctest-0.20.1/test/ExtractSpec.hs0000644000000000000000000000774707346545000015207 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} module ExtractSpec (main, spec) where import Test.Hspec import Test.HUnit #if __GLASGOW_HASKELL__ < 900 import Panic (GhcException (..)) #else import GHC.Utils.Panic (GhcException (..)) #endif import Extract import Location import System.FilePath import Orphans () shouldGive :: HasCallStack => (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 []] doctest-0.20.1/test/InfoSpec.hs0000644000000000000000000000052407346545000014452 0ustar0000000000000000module InfoSpec (spec) where import Test.Hspec import System.Process import Info (formatInfo) import Interpreter (ghc) spec :: Spec spec = do describe "formatInfo" $ do it "formats --info output" $ do info <- readProcess ghc ["--info"] "" formatInfo (read info) `shouldBe` info doctest-0.20.1/test/InterpreterSpec.hs0000644000000000000000000000273007346545000016063 0ustar0000000000000000module InterpreterSpec (main, spec) where import Prelude () import Prelude.Compat import Test.Hspec import Interpreter (interpreterSupported, haveInterpreterKey, ghcInfo, withInterpreter, safeEval, filterExpression) 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 multi-line command" describe "filterExpression" $ do it "removes :set -XTemplateHaskell" $ do filterExpression ":set -XTemplateHaskell" `shouldBe` Right "" it "filters -XTemplateHaskell" $ do filterExpression ":set -XTemplateHaskell -XCPP" `shouldBe` Right ":set -XCPP" it "leaves :set-statement that do not set -XTemplateHaskell alone " $ do filterExpression ":set -XFoo -XBar" `shouldBe` Right ":set -XFoo -XBar" doctest-0.20.1/test/LocationSpec.hs0000644000000000000000000000301107346545000015321 0ustar0000000000000000{-# LANGUAGE CPP #-} module LocationSpec (main, spec) where import Test.Hspec import Location #if __GLASGOW_HASKELL__ < 900 import SrcLoc import FastString (fsLit) #else import GHC.Types.SrcLoc import GHC.Data.FastString (fsLit) #endif 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 "" it "works for a SrcLoc with bad locations" $ do toLocation (mkSrcSpan noSrcLoc noSrcLoc) `shouldBe` UnhelpfulLocation "" 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] doctest-0.20.1/test/MainSpec.hs0000644000000000000000000001364507346545000014453 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} module MainSpec (main, spec) where import Test.Hspec import Test.HUnit (assertEqual, Assertion) 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 :: HasCallStack => FilePath -> [String] -> Summary -> Assertion doctest = doctestWithPreserveIt defaultPreserveIt doctestWithPreserveIt :: HasCallStack => Bool -> FilePath -> [String] -> Summary -> Assertion doctestWithPreserveIt preserveIt workingDir args expected = do actual <- withCurrentDirectory ("test/integration" workingDir) (hSilence [stderr] $ doctestWithOptions defaultFastMode preserveIt defaultVerbose 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} -- Andreas, 2021-02-27, see issue #294. -- This test case contains a hard-wired path that does not work -- with v2-cabal. -- I tested it under v2-cabal with a very non-portable path. -- Deactivating the test case until a systematic solution is found... -- -- it "works with additional object files" $ do -- -- -- Path for v1-cabal: -- -- doctest "with-cbits" ["Bar.hs", "../../../dist/build/spec/spec-tmp/test/integration/with-cbits/foo.o"] -- -- -- Path for v2-cabal with ghc-9.0.1 -- -- doctest "with-cbits" ["Bar.hs", "../../../dist-newstyle/build/x86_64-osx/ghc-9.0.1/doctest-0.19/t/spec/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) it "doesn't clash with user bindings of stdout/stderr" $ do doctest "local-stderr-binding" ["A.hs"] (cases 1) it "doesn't get confused by doctests using System.IO imports" $ do doctest "system-io-imported" ["A.hs"] (cases 1) doctest-0.20.1/test/OptionsSpec.hs0000644000000000000000000000626207346545000015217 0ustar0000000000000000module OptionsSpec (spec) where import Prelude () import Prelude.Compat import Data.List.Compat import Test.Hspec import Test.QuickCheck import Options newtype NonInteractive = NonInteractive String deriving (Eq, Show) instance Arbitrary NonInteractive where arbitrary = NonInteractive <$> elements (nonInteractiveGhcOptions \\ ["--info"]) spec :: Spec spec = do describe "parseOptions" $ do let warning = ["WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."] it "strips --optghc" $ parseOptions ["--optghc", "foobar"] `shouldBe` Result (Run warning ["foobar"] defaultMagic defaultFastMode defaultPreserveIt defaultVerbose) it "strips --optghc=" $ parseOptions ["--optghc=foobar"] `shouldBe` Result (Run warning ["foobar"] defaultMagic defaultFastMode defaultPreserveIt defaultVerbose) context "with ghc options that are not valid with --interactive" $ do it "returns RunGhc" $ do property $ \ (NonInteractive x) xs -> do let options = x : xs parseOptions options `shouldBe` RunGhc options context "with --interactive" $ do let options = ["--interactive", "--foo", "--bar"] it "disables magic mode" $ do runMagicMode <$> parseOptions options `shouldBe` Result False it "filters out --interactive" $ do runOptions <$> parseOptions options `shouldBe` Result ["--foo", "--bar"] 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 describe "--verbose" $ do context "without --verbose" $ do it "is not verbose by default" $ do runVerbose <$> parseOptions [] `shouldBe` Result False context "with --verbose" $ do it "parses verbose option" $ do runVerbose <$> parseOptions ["--verbose"] `shouldBe` Result True doctest-0.20.1/test/Orphans.hs0000644000000000000000000000077507346545000014366 0ustar0000000000000000{-# 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]) doctest-0.20.1/test/PackageDBsSpec.hs0000644000000000000000000000234607346545000015507 0ustar0000000000000000module PackageDBsSpec (main, spec) where import Prelude () import Prelude.Compat import qualified Control.Exception as E import Data.List (intercalate) import PackageDBs import System.Environment.Compat import System.FilePath (searchPathSeparator) import Test.Hspec import Test.Mockery.Directory main :: IO () main = hspec spec 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" "" combineDirs :: [FilePath] -> String combineDirs = intercalate [searchPathSeparator] spec :: Spec spec = around_ clearEnv $ do describe "getPackageDBsFromEnv" $ do around_ (inTempDirectory) $ do it "uses global and user when no env 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"] doctest-0.20.1/test/ParseSpec.hs0000644000000000000000000001342307346545000014633 0ustar0000000000000000{-# 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 ] doctest-0.20.1/test/PropertySpec.hs0000644000000000000000000001215607346545000015407 0ustar0000000000000000{-# LANGUAGE 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! Falsified (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" $ -- 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 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! Falsified (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 ":4:1: Not in scope: `x'" `shouldBe` ["x"] it "ignores duplicates" $ do parseNotInScope . build $ do ":4:1: Not in scope: `x'" "" ":4:6: Not in scope: `x'" `shouldBe` ["x"] it "works for variable names that contain a prime" $ do parseNotInScope . build $ do ":2:1: Not in scope: x'" "" ":2:7: Not in scope: y'" `shouldBe` ["x'", "y'"] it "works for error messages with suggestions" $ do parseNotInScope . build $ do ":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 ":1:1: error: Variable not in scope: x" `shouldBe` ["x"] it "ignores duplicates" $ do parseNotInScope . build $ do ":1:1: error: Variable not in scope: x :: ()" "" ":1:6: error: Variable not in scope: x :: ()" `shouldBe` ["x"] it "works for variable names that contain a prime" $ do parseNotInScope . build $ do ":1:1: error: Variable not in scope: x' :: ()" "" ":1:7: error: Variable not in scope: y'' :: ()" `shouldBe` ["x'", "y''"] it "works for error messages with suggestions" $ do parseNotInScope . build $ do ":1:1: error:" " • Variable not in scope: length_" " • Perhaps you meant ‘length’ (imported from Prelude)" `shouldBe` ["length_"] doctest-0.20.1/test/RunSpec.hs0000644000000000000000000001325107346545000014324 0ustar0000000000000000{-# LANGUAGE CPP #-} module RunSpec (main, spec) where import Prelude () import Prelude.Compat import Test.Hspec import System.Exit import qualified Control.Exception as E import System.FilePath import System.Directory (getCurrentDirectory, setCurrentDirectory) import Data.List.Compat (isPrefixOf, sort) import Data.Char import System.IO.Silently import System.IO (stderr) import qualified Options import Run doctestWithDefaultOptions :: [String] -> IO Summary doctestWithDefaultOptions = doctestWithOptions Options.defaultFastMode Options.defaultPreserveIt Options.defaultVerbose withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory workingDir action = do E.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do setCurrentDirectory workingDir action main :: IO () main = hspec spec removeLoadedPackageEnvironment :: String -> String #if __GLASGOW_HASKELL__ < 810 removeLoadedPackageEnvironment = unlines . filter (not . isPrefixOf "Loaded package environment from ") . lines #else removeLoadedPackageEnvironment = id #endif 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) removeLoadedPackageEnvironment r `shouldBe` unlines [ "doctest: unrecognized option `--foo'" , "Try `doctest --help' for more information." ] it "prints verbose description of a specification" $ do (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/testSimple/Fib.hs"] removeLoadedPackageEnvironment r `shouldBe` unlines [ "### Started execution at test/integration/testSimple/Fib.hs:5." , "### example:" , "fib 10" , "### Successful!" , "" , "# Final summary:" , "Examples: 1 Tried: 1 Errors: 0 Failures: 0" ] it "prints verbose description of a property" $ do (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/property-bool/Foo.hs"] removeLoadedPackageEnvironment r `shouldBe` unlines [ "### Started execution at test/integration/property-bool/Foo.hs:4." , "### property:" , "True" , "### Successful!" , "" , "# Final summary:" , "Examples: 1 Tried: 1 Errors: 0 Failures: 0" ] it "prints verbose error" $ do (r, e) <- hCapture [stderr] . E.try $ doctest ["--verbose", "test/integration/failing/Foo.hs"] e `shouldBe` Left (ExitFailure 1) removeLoadedPackageEnvironment r `shouldBe` unlines [ "### Started execution at test/integration/failing/Foo.hs:5." , "### example:" , "23" , "test/integration/failing/Foo.hs:5: failure in expression `23'" , "expected: 42" , " but got: 23" , " ^" , "" , "# Final summary:" , "Examples: 1 Tried: 1 Errors: 0 Failures: 1" ] #if __GLASGOW_HASKELL__ >= 802 it "can deal with potentially problematic GHC options" $ do hSilence [stderr] $ doctest ["-fdiagnostics-color=always", "test/integration/color/Foo.hs"] #endif 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)) stripAnsiColors (removeLoadedPackageEnvironment r) `shouldBe` "\nFoo.hs:6:1: error:\n parse error (possibly incorrect indentation or mismatched brackets)\n" 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] stripAnsiColors :: String -> String stripAnsiColors xs = case xs of '\ESC' : '[' : ';' : ys | 'm' : zs <- dropWhile isNumber ys -> stripAnsiColors zs '\ESC' : '[' : ys | 'm' : zs <- dropWhile isNumber ys -> stripAnsiColors zs y : ys -> y : stripAnsiColors ys [] -> [] doctest-0.20.1/test/Runner/0000755000000000000000000000000007346545000013660 5ustar0000000000000000doctest-0.20.1/test/Runner/ExampleSpec.hs0000644000000000000000000001307707346545000016432 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Runner.ExampleSpec (main, spec) where import Prelude () import Prelude.Compat import Data.String import Test.Hspec import Test.Hspec.Core.QuickCheck (modifyMaxSize) 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 first zero line" $ do mkResult [WildCardLine, "foo", "bar"] ["foo", "bar"] `shouldBe` Equal it "matches final zero line" $ do mkResult ["foo", "bar", WildCardLine] ["foo", "bar"] `shouldBe` Equal it "matches an arbitrary number of lines" $ do mkResult ["foo", WildCardLine, "bar"] ["foo", "baz", "bazoom", "bar"] `shouldBe` Equal -- See https://github.com/sol/doctest/issues/259 modifyMaxSize (const 8) $ 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 it "matches an arbitrary line chunk at end" $ do mkResult [ExpectedLine ["foo", WildCardChunk]] ["foo baz bar"] `shouldBe` Equal it "does not match at end" $ do mkResult [ExpectedLine [WildCardChunk, "baz"]] ["foo baz bar"] `shouldBe` NotEqual [ "expected: ...baz" , " but got: foo baz bar" , " ^" ] it "does not match at start" $ do mkResult [ExpectedLine ["fuu", WildCardChunk]] ["foo baz bar"] `shouldBe` NotEqual [ "expected: fuu..." , " but got: foo baz bar" , " ^" ] 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" , " ^" ] it "insert caret after last matching character on different lengths" $ do mkResult ["foo"] ["fo"] `shouldBe` NotEqual [ "expected: foo" , " but got: fo" , " ^" ] it "insert caret after mismatching line for multi-line output" $ do mkResult ["foo", "bar", "bat"] ["foo", "baz", "bax"] `shouldBe` NotEqual [ "expected: foo" , " bar" , " bat" , " but got: foo" , " baz" , " ^" , " bax" ] it "insert caret after mismatching line with the longest match for multi-line wildcard pattern" $ do mkResult ["foo", WildCardLine, "bar", "bat"] ["foo", "xxx", "yyy", "baz", "bxx"] `shouldBe` NotEqual [ "expected: foo" , " ..." , " bar" , " bat" , " but got: foo" , " xxx" , " yyy" , " baz" , " ^" , " bxx" ] it "insert caret after longest match for wildcard" $ do mkResult [ExpectedLine ["foo ", WildCardChunk, " bar bat"]] ["foo xxx yyy baz bxx"] `shouldBe` NotEqual [ "expected: foo ... bar bat" , " but got: foo xxx yyy baz bxx" , " ^" ] it "show expanded pattern for long matches" $ do mkResult [ExpectedLine ["foo ", WildCardChunk, " bar bat"]] ["foo 123456789 123456789 xxx yyy baz bxx"] `shouldBe` NotEqual [ "expected: foo ... bar bat" , " but got: foo 123456789 123456789 xxx yyy baz bxx" , " foo ........................... ba^" ] doctest-0.20.1/test/RunnerSpec.hs0000644000000000000000000000442107346545000015030 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module RunnerSpec (main, spec) where import Test.Hspec 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 False mempty) -- like capture, but with interactivity set to False capture_ :: Report a -> IO String capture_ = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 False 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" doctest-0.20.1/test/Spec.hs0000644000000000000000000000005407346545000013634 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} doctest-0.20.1/test/UtilSpec.hs0000644000000000000000000000105107346545000014470 0ustar0000000000000000module 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" doctest-0.20.1/test/extract/argument-list/0000755000000000000000000000000007346545000016654 5ustar0000000000000000doctest-0.20.1/test/extract/argument-list/Foo.hs0000644000000000000000000000014707346545000017735 0ustar0000000000000000module Foo where foo :: Int -- ^ doc for arg1 -> Int -- ^ doc for arg2 -> Int foo = undefined doctest-0.20.1/test/extract/comment-order/0000755000000000000000000000000007346545000016634 5ustar0000000000000000doctest-0.20.1/test/extract/comment-order/Foo.hs0000644000000000000000000000042107346545000017710 0ustar0000000000000000-- | 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 doctest-0.20.1/test/extract/declaration/0000755000000000000000000000000007346545000016346 5ustar0000000000000000doctest-0.20.1/test/extract/declaration/Foo.hs0000644000000000000000000000007607346545000017430 0ustar0000000000000000module Foo where -- | Some documentation foo :: Int foo = 23 doctest-0.20.1/test/extract/dos-line-endings/0000755000000000000000000000000007346545000017220 5ustar0000000000000000doctest-0.20.1/test/extract/dos-line-endings/Foo.hs0000644000000000000000000000011007346545000020267 0ustar0000000000000000module Foo where -- | -- foo -- bar -- baz foo :: Int foo = 23 doctest-0.20.1/test/extract/export-list/0000755000000000000000000000000007346545000016353 5ustar0000000000000000doctest-0.20.1/test/extract/export-list/Foo.hs0000644000000000000000000000020107346545000017423 0ustar0000000000000000module Foo ( -- * some heading -- | documentation from export list foo , bar ) where foo :: Int foo = 23 bar :: Int bar = 23 doctest-0.20.1/test/extract/imported-module/0000755000000000000000000000000007346545000017167 5ustar0000000000000000doctest-0.20.1/test/extract/imported-module/Bar.hs0000644000000000000000000000011507346545000020224 0ustar0000000000000000module Bar where import Baz -- | documentation for bar bar :: Int bar = 23 doctest-0.20.1/test/extract/imported-module/Baz.hs0000644000000000000000000000010107346545000020227 0ustar0000000000000000module Baz where -- | documentation for baz baz :: Int baz = 23 doctest-0.20.1/test/extract/module-header/0000755000000000000000000000000007346545000016574 5ustar0000000000000000doctest-0.20.1/test/extract/module-header/Foo.hs0000644000000000000000000000007607346545000017656 0ustar0000000000000000-- | Some documentation module Foo where foo :: Int foo = 23 doctest-0.20.1/test/extract/named-chunks/0000755000000000000000000000000007346545000016436 5ustar0000000000000000doctest-0.20.1/test/extract/named-chunks/Foo.hs0000644000000000000000000000020007346545000017505 0ustar0000000000000000module Foo ( foo , bar ) where -- $foo named chunk foo -- $bar -- named chunk bar foo :: Int foo = 23 bar :: Int bar = 23 doctest-0.20.1/test/extract/regression/0000755000000000000000000000000007346545000016241 5ustar0000000000000000doctest-0.20.1/test/extract/regression/Fixity.hs0000644000000000000000000000005607346545000020052 0ustar0000000000000000module Fixity where foo :: Int foo = 23 + 42 doctest-0.20.1/test/extract/regression/ForeignImport.hs0000644000000000000000000000037707346545000021370 0ustar0000000000000000{-# 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)) doctest-0.20.1/test/extract/regression/ParallelListComp.hs0000644000000000000000000000017007346545000022002 0ustar0000000000000000{-# LANGUAGE ParallelListComp #-} module ParallelListComp where foo :: [Int] foo = [x+y | x <- [1,2,3] | y <- [4,5,6]] doctest-0.20.1/test/extract/regression/ParallelListCompClass.hs0000644000000000000000000000026207346545000022772 0ustar0000000000000000{-# 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]] doctest-0.20.1/test/extract/regression/RewriteRules.hs0000644000000000000000000000023207346545000021226 0ustar0000000000000000module 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 doctest-0.20.1/test/extract/regression/RewriteRulesWithSigs.hs0000644000000000000000000000025607346545000022716 0ustar0000000000000000module 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 doctest-0.20.1/test/extract/setup/0000755000000000000000000000000007346545000015221 5ustar0000000000000000doctest-0.20.1/test/extract/setup/Foo.hs0000644000000000000000000000021107346545000016272 0ustar0000000000000000module Foo where -- $setup -- some setup code -- | foo foo :: Int foo = 42 -- | bar bar :: Int bar = 42 -- | baz baz :: Int baz = 42 doctest-0.20.1/test/extract/th/0000755000000000000000000000000007346545000014474 5ustar0000000000000000doctest-0.20.1/test/extract/th/Bar.hs0000644000000000000000000000016607346545000015537 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Bar where import Language.Haskell.TH.Lib (ExpQ) bar :: ExpQ bar = [| 23 |] doctest-0.20.1/test/extract/th/Foo.hs0000644000000000000000000000015707346545000015556 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Foo where import Bar -- | some documentation foo :: Int foo = $(bar) doctest-0.20.1/test/extract/type-class-args/0000755000000000000000000000000007346545000017077 5ustar0000000000000000doctest-0.20.1/test/extract/type-class-args/Foo.hs0000644000000000000000000000014407346545000020155 0ustar0000000000000000module Foo where class Foo a where bar :: a -- ^ foo -> Int -- ^ bar -> String doctest-0.20.1/test/extract/type-class/0000755000000000000000000000000007346545000016145 5ustar0000000000000000doctest-0.20.1/test/extract/type-class/Foo.hs0000644000000000000000000000015507346545000017225 0ustar0000000000000000module Foo where class ToString a where -- | Convert given value to a string. toString :: a -> String doctest-0.20.1/test/extract/type-families/0000755000000000000000000000000007346545000016631 5ustar0000000000000000doctest-0.20.1/test/extract/type-families/Foo.hs0000644000000000000000000000013707346545000017711 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} module Foo where type family Foo a type instance Foo Int = Int doctest-0.20.1/test/integration/bugfixImportHierarchical/0000755000000000000000000000000007346545000021710 5ustar0000000000000000doctest-0.20.1/test/integration/bugfixImportHierarchical/ModuleA.hs0000644000000000000000000000010207346545000023563 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import Foo.ModuleB doctest-0.20.1/test/integration/bugfixImportHierarchical/ModuleB.hs0000644000000000000000000000023407346545000023572 0ustar0000000000000000module Foo.ModuleB (fib) where -- | -- >>> fib 10 -- 55 -- >>> fib 5 -- 5 fib :: Integer -> Integer fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) doctest-0.20.1/test/integration/bugfixMultipleModules/0000755000000000000000000000000007346545000021263 5ustar0000000000000000doctest-0.20.1/test/integration/bugfixMultipleModules/ModuleA.hs0000644000000000000000000000007607346545000023150 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import ModuleB doctest-0.20.1/test/integration/bugfixMultipleModules/ModuleB.hs0000644000000000000000000000035007346545000023144 0ustar0000000000000000module ModuleB (fib) where -- | -- >>> fib 10 -- 55 -- >>> fib 5 -- 5 fib :: Integer -> Integer fib = foo -- | -- >>> foo 10 -- 55 -- >>> foo 5 -- 5 foo :: Integer -> Integer foo 0 = 0 foo 1 = 1 foo n = foo (n - 1) + foo (n - 2) doctest-0.20.1/test/integration/bugfixOutputToStdErr/0000755000000000000000000000000007346545000021066 5ustar0000000000000000doctest-0.20.1/test/integration/bugfixOutputToStdErr/Fib.hs0000644000000000000000000000027407346545000022125 0ustar0000000000000000module Fib where -- | Calculate Fibonacci number of given 'Num'. -- -- >>> import System.IO -- >>> hPutStrLn stderr "foobar" -- foobar fib :: (Num t, Num t1) => t -> t1 fib _ = undefined doctest-0.20.1/test/integration/bugfixWorkingDirectory/0000755000000000000000000000000007346545000021444 5ustar0000000000000000doctest-0.20.1/test/integration/bugfixWorkingDirectory/Fib.hs0000644000000000000000000000022407346545000022476 0ustar0000000000000000module Fib where -- | Calculate Fibonacci number of given 'Num'. -- -- >>> bar -- 10 fib :: (Num t, Num t1) => t -> t1 fib _ = undefined bar = 10 doctest-0.20.1/test/integration/bugfixWorkingDirectory/description0000644000000000000000000000031207346545000023706 0ustar0000000000000000Put the following files in the current working directory: ./Fib.hs ./examples/Fib.hs Now run: doctest examples/Fib.hs Erroneously `./Fib.hs` will be tested instead of `examples/Fib.hs`. doctest-0.20.1/test/integration/bugfixWorkingDirectory/examples/0000755000000000000000000000000007346545000023262 5ustar0000000000000000doctest-0.20.1/test/integration/bugfixWorkingDirectory/examples/Fib.hs0000644000000000000000000000042507346545000024317 0ustar0000000000000000module Fib where -- | Calculate Fibonacci number of given 'Num'. -- -- Examples: -- -- >>> fib 10 -- 55 fib :: Integer -> Integer fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) -- | -- -- Examples: -- -- >>> fib 10 -- 55 foo :: Int -> Int foo = undefined doctest-0.20.1/test/integration/color/0000755000000000000000000000000007346545000016050 5ustar0000000000000000doctest-0.20.1/test/integration/color/Foo.hs0000644000000000000000000000037107346545000017130 0ustar0000000000000000module Foo where import Data.Maybe -- | Convert a map into list array. -- prop> tabulate m !! fromEnum d == fromMaybe 0 (lookup d m) tabulate :: [(Bool, Double)] -> [Double] tabulate m = [fromMaybe 0 $ lookup False m, fromMaybe 0 $ lookup True m] doctest-0.20.1/test/integration/custom-package-conf/0000755000000000000000000000000007346545000020560 5ustar0000000000000000doctest-0.20.1/test/integration/custom-package-conf/Bar.hs0000644000000000000000000000013207346545000021614 0ustar0000000000000000module Bar where import Foo -- | -- >>> import Foo -- >>> foo -- 23 bar :: Int bar = 42 doctest-0.20.1/test/integration/custom-package-conf/foo/0000755000000000000000000000000007346545000021343 5ustar0000000000000000doctest-0.20.1/test/integration/custom-package-conf/foo/Foo.hs0000644000000000000000000000004507346545000022421 0ustar0000000000000000module Foo where foo :: Int foo = 23 doctest-0.20.1/test/integration/custom-package-conf/foo/doctest-foo.cabal0000644000000000000000000000023207346545000024552 0ustar0000000000000000name: doctest-foo version: 0.0.0 build-type: Simple cabal-version: >= 1.8 library exposed-modules: Foo build-depends: base doctest-0.20.1/test/integration/dos-line-endings/0000755000000000000000000000000007346545000020071 5ustar0000000000000000doctest-0.20.1/test/integration/dos-line-endings/Fib.hs0000644000000000000000000000024507346545000021126 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- -- >>> fib 10 -- 55 fib :: Integer -> Integer fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) doctest-0.20.1/test/integration/failing-multiple/0000755000000000000000000000000007346545000020174 5ustar0000000000000000doctest-0.20.1/test/integration/failing-multiple/Foo.hs0000644000000000000000000000021507346545000021251 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> 23 -- 23 -- -- >>> 23 -- 42 -- -- >>> 23 -- 23 -- >>> 23 -- 23 test :: a test = undefined doctest-0.20.1/test/integration/failing/0000755000000000000000000000000007346545000016343 5ustar0000000000000000doctest-0.20.1/test/integration/failing/Foo.hs0000644000000000000000000000012707346545000017422 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> 23 -- 42 test :: a test = undefined doctest-0.20.1/test/integration/it/0000755000000000000000000000000007346545000015346 5ustar0000000000000000doctest-0.20.1/test/integration/it/Foo.hs0000644000000000000000000000026007346545000016423 0ustar0000000000000000module Foo where -- | -- -- >>> :t 'a' -- 'a' :: Char -- -- >>> "foo" -- "foo" -- -- >>> length it -- 3 -- -- >>> it * it -- 9 -- -- >>> :t it -- it :: Int -- foo = undefined doctest-0.20.1/test/integration/it/Setup.hs0000644000000000000000000000031007346545000016774 0ustar0000000000000000module Setup where -- $setup -- >>> :t 'a' -- 'a' :: Char -- -- >>> 42 :: Int -- 42 -- -- >>> it -- 42 -- | -- -- >>> it * it -- 1764 foo = undefined -- | -- -- >>> it * it -- 1764 bar = undefined doctest-0.20.1/test/integration/local-stderr-binding/0000755000000000000000000000000007346545000020735 5ustar0000000000000000doctest-0.20.1/test/integration/local-stderr-binding/A.hs0000644000000000000000000000015007346545000021445 0ustar0000000000000000module A where stderr :: Bool stderr = True stdout :: String stdout = "hello" -- | -- >>> 3 + 3 -- 6 doctest-0.20.1/test/integration/multiline/0000755000000000000000000000000007346545000016734 5ustar0000000000000000doctest-0.20.1/test/integration/multiline/Multiline.hs0000644000000000000000000000114207346545000021230 0ustar0000000000000000module Multiline where {- | >>> :{ let x = 1 y = z in x + y :} 3 -} z = 2 {- | Aligns with the closing >>> :{ let x = 1 y = z in x + y :} 3 -} z2 = 2 {- | Also works let that's for do: >>> :{ let x = 1 y = z :} >>> y 2 -} z3 = 2 {- | Handles repeated @>>>@ too, which is bad since haddock-2.13.2 currently will strip the leading whitespace leading to something that will not copy-paste (unless it uses explicit { ; } and the users manually strip the @>>>@) >>> :{ >>> let >>> x = 1 >>> y = z >>> in x + y >>> :} 3 -} z4 = 4 doctest-0.20.1/test/integration/parse-error/0000755000000000000000000000000007346545000017173 5ustar0000000000000000doctest-0.20.1/test/integration/parse-error/Foo.hs0000644000000000000000000000007307346545000020252 0ustar0000000000000000module Foo where -- | Some documentation foo :: Int foo = doctest-0.20.1/test/integration/property-bool-with-type-signature/0000755000000000000000000000000007346545000023476 5ustar0000000000000000doctest-0.20.1/test/integration/property-bool-with-type-signature/Foo.hs0000644000000000000000000000007507346545000024557 0ustar0000000000000000module Foo where -- | -- prop> True :: Bool foo = undefined doctest-0.20.1/test/integration/property-bool/0000755000000000000000000000000007346545000017547 5ustar0000000000000000doctest-0.20.1/test/integration/property-bool/Foo.hs0000644000000000000000000000006507346545000020627 0ustar0000000000000000module Foo where -- | -- prop> True foo = undefined doctest-0.20.1/test/integration/property-failing/0000755000000000000000000000000007346545000020225 5ustar0000000000000000doctest-0.20.1/test/integration/property-failing/Foo.hs0000644000000000000000000000007307346545000021304 0ustar0000000000000000module Foo where -- | -- prop> abs x == x foo = undefined doctest-0.20.1/test/integration/property-implicitly-quantified/0000755000000000000000000000000007346545000023122 5ustar0000000000000000doctest-0.20.1/test/integration/property-implicitly-quantified/Foo.hs0000644000000000000000000000010507346545000024175 0ustar0000000000000000module Foo where -- | -- prop> abs x == abs (abs x) foo = undefined doctest-0.20.1/test/integration/property-quantified/0000755000000000000000000000000007346545000020745 5ustar0000000000000000doctest-0.20.1/test/integration/property-quantified/Foo.hs0000644000000000000000000000011307346545000022017 0ustar0000000000000000module Foo where -- | -- prop> \x -> abs x == abs (abs x) foo = undefined doctest-0.20.1/test/integration/property-setup/0000755000000000000000000000000007346545000017754 5ustar0000000000000000doctest-0.20.1/test/integration/property-setup/Foo.hs0000644000000000000000000000024507346545000021034 0ustar0000000000000000module Foo where -- $setup -- >>> import Test.QuickCheck -- >>> let arbitraryEven = (* 2) `fmap` arbitrary -- | -- prop> forAll arbitraryEven even foo = undefined doctest-0.20.1/test/integration/setup-skip-on-failure/0000755000000000000000000000000007346545000021075 5ustar0000000000000000doctest-0.20.1/test/integration/setup-skip-on-failure/Foo.hs0000644000000000000000000000017707346545000022161 0ustar0000000000000000module Foo where -- $setup -- >>> x -- 23 -- | -- >>> foo -- 42 foo :: Int foo = 42 -- | -- >>> y -- 42 bar :: Int bar = 42 doctest-0.20.1/test/integration/setup/0000755000000000000000000000000007346545000016072 5ustar0000000000000000doctest-0.20.1/test/integration/setup/Foo.hs0000644000000000000000000000014407346545000017150 0ustar0000000000000000module Foo where -- $setup -- >>> let x = 23 :: Int -- | -- >>> x + foo -- 65 foo :: Int foo = 42 doctest-0.20.1/test/integration/system-io-imported/0000755000000000000000000000000007346545000020504 5ustar0000000000000000doctest-0.20.1/test/integration/system-io-imported/A.hs0000644000000000000000000000036307346545000021222 0ustar0000000000000000module A where import System.IO -- ghci-wrapper needs to poke around with System.IO itself, and unloads the module once it's done. Test to make sure legitimate uses of System.IO don't get lost in the wash. -- | -- >>> ReadMode -- ReadMode doctest-0.20.1/test/integration/template-haskell-bugfix/0000755000000000000000000000000007346545000021450 5ustar0000000000000000doctest-0.20.1/test/integration/template-haskell-bugfix/Main.hs0000644000000000000000000000042707346545000022673 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Main where -- Import our template "pr" import Printf ( pr ) -- The splice operator $ takes the Haskell source code -- generated at compile time by "pr" and splices it into -- the argument of "putStrLn". main = putStrLn ( $(pr "Hello") ) doctest-0.20.1/test/integration/template-haskell-bugfix/Printf.hs0000644000000000000000000000077507346545000023257 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- -- derived from: http://www.haskell.org/ghc/docs/latest/html/users_guide/template-haskell.html#th-example -- module Printf (pr) where import Language.Haskell.TH data Format = D | S | L String parse :: String -> [Format] parse s = [ L s ] gen :: [Format] -> Q Exp gen [D] = [| \n -> show n |] gen [S] = [| \s -> s |] gen [L s] = stringE s -- | -- -- >>> :set -XTemplateHaskell -- >>> putStrLn ( $(pr "Hello") ) -- Hello pr :: String -> Q Exp pr s = gen (parse s) doctest-0.20.1/test/integration/template-haskell/0000755000000000000000000000000007346545000020166 5ustar0000000000000000doctest-0.20.1/test/integration/template-haskell/Foo.hs0000644000000000000000000000061407346545000021246 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Foo where import Language.Haskell.TH import Text.Printf -- | Report an error. -- -- >>> :set -XTemplateHaskell -- >>> $(logError "Something bad happened!") -- ERROR : Something bad happened! logError :: String -> Q Exp logError msg = do loc <- location let s = (printf "ERROR %s: %s" (loc_filename loc) msg) :: String [| putStrLn s |] doctest-0.20.1/test/integration/test-options/0000755000000000000000000000000007346545000017402 5ustar0000000000000000doctest-0.20.1/test/integration/test-options/Foo.hs0000644000000000000000000000015607346545000020463 0ustar0000000000000000module Foo where -- | -- Examples: -- -- >>> foo -- 23 foo :: Int #ifdef FOO foo = 23 #else foo = 42 #endif doctest-0.20.1/test/integration/testBlankline/0000755000000000000000000000000007346545000017531 5ustar0000000000000000doctest-0.20.1/test/integration/testBlankline/Fib.hs0000644000000000000000000000026307346545000020566 0ustar0000000000000000module Fib where -- | Calculate Fibonacci number of given 'Num'. -- -- >>> putStrLn "foo\n\nbar" -- foo -- -- bar fib :: (Num t, Num t1) => t -> t1 fib _ = undefined doctest-0.20.1/test/integration/testCPP/0000755000000000000000000000000007346545000016254 5ustar0000000000000000doctest-0.20.1/test/integration/testCPP/Foo.hs0000644000000000000000000000015607346545000017335 0ustar0000000000000000module Foo where -- | -- Examples: -- -- >>> foo -- 23 foo :: Int #ifdef FOO foo = 23 #else foo = 42 #endif doctest-0.20.1/test/integration/testCombinedExample/0000755000000000000000000000000007346545000020666 5ustar0000000000000000doctest-0.20.1/test/integration/testCombinedExample/Fib.hs0000644000000000000000000000046607346545000021730 0ustar0000000000000000module Fib where -- | Calculate Fibonacci number of given 'Num'. -- -- First let's set `n` to ten: -- -- >>> let n = 10 -- -- And now calculate the 10th Fibonacci number: -- -- >>> fib n -- 55 -- -- >>> let x = 10 -- >>> x -- 10 fib :: Integer -> Integer fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) doctest-0.20.1/test/integration/testCommentLocation/0000755000000000000000000000000007346545000020725 5ustar0000000000000000doctest-0.20.1/test/integration/testCommentLocation/Foo.hs0000644000000000000000000000260307346545000022005 0ustar0000000000000000-- | -- Examples in various locations... -- -- Some random text. Some random text. Some random text. Some random text. -- Some random text. Some random text. Some random text. Some random text. -- Some random text. -- -- >>> let x = 10 -- -- Some random text. Some random text. Some random text. Some random text. -- Some random text. Some random text. Some random text. Some random text. -- Some random text. -- -- -- >>> baz -- "foobar" module Foo ( -- | Some documentation not attached to a particular Haskell entity -- -- >>> test 10 -- *** Exception: Prelude.undefined -- ... test, -- | -- >>> fib 10 -- 55 fib, -- | -- >>> bar -- "bar" bar ) where -- | My test -- -- >>> test 20 -- *** Exception: Prelude.undefined -- ... test :: Integer -> Integer test = undefined -- | Note that examples for 'fib' include the two examples below -- and the one example with ^ syntax after 'fix' -- -- >>> foo -- "foo" {- | Example: >>> fib 10 55 -} -- | Calculate Fibonacci number of given `n`. fib :: Integer -- ^ given `n` -- -- >>> fib 10 -- 55 -> Integer -- ^ Fibonacci of given `n` -- -- >>> baz -- "foobar" fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) -- ^ Example: -- -- >>> fib 5 -- 5 foo = "foo" bar = "bar" baz = foo ++ bar doctest-0.20.1/test/integration/testDocumentationForArguments/0000755000000000000000000000000007346545000023000 5ustar0000000000000000doctest-0.20.1/test/integration/testDocumentationForArguments/Fib.hs0000644000000000000000000000014607346545000024035 0ustar0000000000000000module Fib where fib :: Int -- ^ -- >>> 23 -- 23 -> Int fib _ = undefined doctest-0.20.1/test/integration/testFailOnMultiline/0000755000000000000000000000000007346545000020665 5ustar0000000000000000doctest-0.20.1/test/integration/testFailOnMultiline/Fib.hs0000644000000000000000000000034707346545000021725 0ustar0000000000000000module Fib where -- | The following interaction cause `doctest' to fail with an error: -- -- >>> :{ foo :: Int foo = 23 -- | The following interaction cause `doctest' to fail with an error: -- -- >>> :{ bar :: Int bar = 23 doctest-0.20.1/test/integration/testImport/0000755000000000000000000000000007346545000017104 5ustar0000000000000000doctest-0.20.1/test/integration/testImport/ModuleA.hs0000644000000000000000000000007607346545000020771 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import ModuleB doctest-0.20.1/test/integration/testImport/ModuleB.hs0000644000000000000000000000023007346545000020762 0ustar0000000000000000module ModuleB (fib) where -- | -- >>> fib 10 -- 55 -- >>> fib 5 -- 5 fib :: Integer -> Integer fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) doctest-0.20.1/test/integration/testPutStr/0000755000000000000000000000000007346545000017073 5ustar0000000000000000doctest-0.20.1/test/integration/testPutStr/Fib.hs0000644000000000000000000000032107346545000020123 0ustar0000000000000000module Fib where -- | Calculate Fibonacci number of given 'Num'. -- -- >>> putStrLn "foo" -- foo -- >>> putStr "bar" -- bar -- -- >>> putStrLn "baz" -- baz fib :: (Num t, Num t1) => t -> t1 fib _ = undefined doctest-0.20.1/test/integration/testSimple/0000755000000000000000000000000007346545000017063 5ustar0000000000000000doctest-0.20.1/test/integration/testSimple/Fib.hs0000644000000000000000000000023307346545000020115 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- -- >>> fib 10 -- 55 fib :: Integer -> Integer fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) doctest-0.20.1/test/integration/trailing-whitespace/0000755000000000000000000000000007346545000020675 5ustar0000000000000000doctest-0.20.1/test/integration/trailing-whitespace/Foo.hs0000644000000000000000000000014707346545000021756 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> putStrLn "foo " -- foo test :: a test = undefined doctest-0.20.1/test/integration/with-cbits/0000755000000000000000000000000007346545000017007 5ustar0000000000000000doctest-0.20.1/test/integration/with-cbits/Bar.hs0000644000000000000000000000020507346545000020044 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module Bar where import Foreign.C -- | -- >>> foo -- 23 foreign import ccall foo :: CInt doctest-0.20.1/test/integration/with-cbits/foo.c0000644000000000000000000000003307346545000017732 0ustar0000000000000000int foo() { return 23; } doctest-0.20.1/test/parse/multiple-examples/0000755000000000000000000000000007346545000017170 5ustar0000000000000000doctest-0.20.1/test/parse/multiple-examples/Foo.hs0000644000000000000000000000012107346545000020241 0ustar0000000000000000module Foo where -- | -- >>> foo -- 23 foo = 23 -- | -- >>> bar -- 42 bar = 42 doctest-0.20.1/test/parse/no-examples/0000755000000000000000000000000007346545000015751 5ustar0000000000000000doctest-0.20.1/test/parse/no-examples/Fib.hs0000644000000000000000000000020607346545000017003 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- @ -- some code -- @ -- -- foobar 23 fib :: Int -> Int -> Int fib _ = undefined doctest-0.20.1/test/parse/non-exported/0000755000000000000000000000000007346545000016143 5ustar0000000000000000doctest-0.20.1/test/parse/non-exported/Fib.hs0000644000000000000000000000035407346545000017201 0ustar0000000000000000module 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 doctest-0.20.1/test/parse/property/0000755000000000000000000000000007346545000015405 5ustar0000000000000000doctest-0.20.1/test/parse/property/Fib.hs0000644000000000000000000000026407346545000016443 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- -- prop> foo -- -- some text -- -- prop> bar -- -- some more text -- -- prop> baz fib :: Int -> Int -> Int fib _ = undefined doctest-0.20.1/test/parse/setup-empty/0000755000000000000000000000000007346545000016015 5ustar0000000000000000doctest-0.20.1/test/parse/setup-empty/Foo.hs0000644000000000000000000000013207346545000017070 0ustar0000000000000000module Foo where -- $setup -- some setup code -- | -- >>> foo -- 23 foo :: Int foo = 23 doctest-0.20.1/test/parse/setup-only/0000755000000000000000000000000007346545000015640 5ustar0000000000000000doctest-0.20.1/test/parse/setup-only/Foo.hs0000644000000000000000000000013207346545000016713 0ustar0000000000000000module Foo where -- $setup -- >>> foo -- 23 -- | some documentation foo :: Int foo = 23 doctest-0.20.1/test/parse/simple/0000755000000000000000000000000007346545000015012 5ustar0000000000000000doctest-0.20.1/test/parse/simple/Fib.hs0000644000000000000000000000027207346545000016047 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- -- >>> putStrLn "foo" -- foo -- >>> putStr "bar" -- bar -- -- >>> putStrLn "baz" -- baz fib :: Int -> Int -> Int fib _ = undefined