doctest-0.22.6/0000755000000000000000000000000007346545000011437 5ustar0000000000000000doctest-0.22.6/CHANGES.markdown0000644000000000000000000001210007346545000014245 0ustar0000000000000000Changes in 0.22.5 - Add (experimental) `cabal-doctest` executable. This is guarded behind a flag for now, use `cabal install doctest -f cabal-doctest` to install it. Changes in 0.22.4 - Use `-Wno-unused-packages` for GHC `8.10` / `9.0` / `9.2` Changes in 0.22.3 - Use `-Wno-unused-packages` when extracting comments Changes in 0.22.2 - GHC 9.8 compatibility Changes in 0.22.1 - Add `Test.DocTest.Internal.Run.doctestWithRepl` Changes in 0.22.0 - Export more internals Changes in 0.21.1 - GHC 9.6 compatibility. Changes in 0.21.0 - Accept `--fast`, `--preserve-it` and `--verbose` via `--repl-options` Changes in 0.20.1 - GHC 9.4 compatibility. (#382) Changes in 0.20.0 - Allow doctest to be invoked via `cabal repl --with-compiler=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.22.6/LICENSE0000644000000000000000000000206707346545000012451 0ustar0000000000000000Copyright (c) 2009-2024 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.22.6/README.md0000644000000000000000000003676407346545000012736 0ustar0000000000000000# Doctest: Test interactive Haskell examples `doctest` is a tool that checks [examples](https://haskell-haddock.readthedocs.io/latest/markup.html#examples) and [properties](https://haskell-haddock.readthedocs.io/latest/markup.html#properties) 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) * [Passing doctest options to cabal repl](#passing-doctest-options-to-cabal-repl) * [Cabal integration](#cabal-integration) * [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](https://hackage.haskell.org/package/doctest). Install it with: cabal update && cabal install --ignore-project doctest Make sure that Cabal's `installdir` is on your `PATH`. On Linux / macOS / BSD: ```bash # requires cabal-install version 3.12, or later export PATH="$(cabal -v0 path --installdir):$PATH" ``` or ```bash export PATH="$HOME/.local/bin:$PATH" ``` On Windows with PowerShell: ```pwsh # requires cabal-install version 3.12, or later $Env:PATH = "$(cabal -v0 path --installdir)" + ";" + $Env: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](https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_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-compiler=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`: ```bash $ cabal repl --with-compiler=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`. - You likely want to reset the warning strategy for `cabal repl` with `--repl-options='-w -Wdefault'`. - `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-compiler=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-compiler=doctest`). So a more robust way to call `doctest` is as follows: ``` cabal install doctest --ignore-project --overwrite-policy=always && cabal build && cabal repl --build-depends=QuickCheck --build-depends=template-haskell --with-compiler=doctest --repl-options='-w -Wdefault' ``` (This is what you want to use on CI.) ## Passing `doctest` options to `cabal repl` You can pass `doctest` options like `--fast`, `--preserve-it` and `--verbose` to `cabal repl` via `--repl-options`. Example: ```bash $ cabal repl --with-compiler=doctest --repl-options=--verbose ### Started execution at src/Fib.hs:7. ### example: fib 10 ### Successful! ### Started execution at src/Fib.hs:10. ### example: fib 5 ### Successful! # Final summary: Examples: 2 Tried: 2 Errors: 0 Failures: 0 ``` ## Cabal integration ***NOTE:*** This feature is experimental. ***NOTE:*** This feature requires `cabal-install` version 3.12 or later. ```bash $ cabal install --ignore-project doctest --flag cabal-doctest ``` ```bash $ cabal doctest Examples: 2 Tried: 2 Errors: 0 Failures: 0 ``` ```bash $ cabal doctest -w ghc-8.6.5 Examples: 2 Tried: 2 Errors: 0 Failures: 0 ``` ```bash $ cabal doctest --repl-options=--verbose ### Started execution at src/Fib.hs:7. ### example: fib 10 ### Successful! ### Started execution at src/Fib.hs:10. ### example: fib 5 ### Successful! # Final summary: Examples: 2 Tried: 2 Errors: 0 Failures: 0 ``` ```bash $ cabal doctest --build-depends transformers Examples: 2 Tried: 2 Errors: 0 Failures: 0 ``` # 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://gitlab.haskell.org/ghc/ghc/-/issues/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](https://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]: https://haskell-haddock.readthedocs.io/latest/markup.html#named-chunks ## 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 -- | -- >>> :seti -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 -- $ -- >>> :seti -XTupleSections ``` [language-pragma]: https://downloads.haskell.org/ghc/latest/docs/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 && cabal exec $(cabal list-bin spec) # Contributors * Simon Hengel * quasicomputational * Kazu Yamamoto * Andreas Abel * Michael Snoyman * Michael Orlitzky * Sakari Jokinen * Adam Vogt * Ryan Scott * Oleg Grenrus * Sönke Hahn * Edward Kmett * Elliot Marsden * Greg Pfeil * Ignat Insarov * Julian K. Arni * Takano Akio * Joachim Breitner * Alan Zimmerman * Alexander Bernauer * Alexandre Esteves * Anders Persson * Ankit Ahuja * Artyom Kazak * Gabor Greif * Guillaume Bouchard * Hiroki Hattori * Jens Petersen * John Chee * João Cristóvão * Leon Schoorl * Levent Erkok * Luke Murphy * Matvey Aksenov * Mitchell Rosen * Nick Smallbone * Nikos Baxevanis * Tamar Christina * Veronika Romashkina For up-to-date list, query git shortlog -s doctest-0.22.6/Setup.lhs0000644000000000000000000000011407346545000013243 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain doctest-0.22.6/doctest.cabal0000644000000000000000000002032707346545000014074 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: doctest version: 0.22.6 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-2024 Simon Hengel author: Simon Hengel maintainer: Simon Hengel 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 flag cabal-doctest description: Install (experimental) cabal-doctest executable manual: True default: False library ghc-options: -Wall hs-source-dirs: src default-extensions: NamedFieldPuns RecordWildCards DeriveFunctor NoImplicitPrelude exposed-modules: Test.DocTest Test.DocTest.Internal.Extract Test.DocTest.Internal.Location Test.DocTest.Internal.Parse Test.DocTest.Internal.Run Test.DocTest.Internal.Cabal other-modules: Cabal Cabal.Options Cabal.Paths Extract GhcUtil Imports Info Interpreter Language.Haskell.GhciWrapper Location Options PackageDBs Parse Property Run Runner Runner.Example Util Paths_doctest build-depends: base >=4.7 && <5 , code-page >=0.1 , containers , deepseq , directory , exceptions , filepath , ghc >=8.0 && <9.12 , ghc-paths >=0.1.0.9 , process , syb >=0.3 , transformers default-language: Haskell2010 if impl(ghc >= 9.0) ghc-options: -fwarn-unused-packages if impl(ghc >= 9.8) ghc-options: -fno-warn-x-partial executable cabal-doctest main-is: driver/cabal-doctest.hs other-modules: Paths_doctest default-extensions: NamedFieldPuns RecordWildCards DeriveFunctor NoImplicitPrelude ghc-options: -Wall -threaded build-depends: base >=4.7 && <5 , doctest default-language: Haskell2010 if impl(ghc >= 9.0) ghc-options: -fwarn-unused-packages if impl(ghc >= 9.8) ghc-options: -fno-warn-x-partial if flag(cabal-doctest) buildable: True else buildable: False executable doctest main-is: driver/doctest.hs other-modules: Paths_doctest ghc-options: -Wall -threaded default-extensions: NamedFieldPuns RecordWildCards DeriveFunctor NoImplicitPrelude build-depends: base >=4.7 && <5 , doctest default-language: Haskell2010 if impl(ghc >= 9.0) ghc-options: -fwarn-unused-packages if impl(ghc >= 9.8) ghc-options: -fno-warn-x-partial test-suite spec main-is: Spec.hs other-modules: Cabal.OptionsSpec Cabal.PathsSpec ExtractSpec InfoSpec InterpreterSpec Language.Haskell.GhciWrapperSpec LocationSpec MainSpec OptionsSpec PackageDBsSpec ParseSpec PropertySpec Runner.ExampleSpec RunnerSpec RunSpec UtilSpec Cabal Cabal.Options Cabal.Paths Extract GhcUtil Imports Info Interpreter Language.Haskell.GhciWrapper Location Options PackageDBs Parse Property Run Runner Runner.Example Test.DocTest Test.DocTest.Internal.Cabal Test.DocTest.Internal.Extract Test.DocTest.Internal.Location Test.DocTest.Internal.Parse Test.DocTest.Internal.Run Util Paths_doctest type: exitcode-stdio-1.0 ghc-options: -Wall -threaded cpp-options: -DTEST hs-source-dirs: test src default-extensions: NamedFieldPuns RecordWildCards DeriveFunctor NoImplicitPrelude c-sources: test/integration/with-cbits/foo.c build-tool-depends: hspec-discover:hspec-discover build-depends: HUnit , QuickCheck >=2.13.1 , base >=4.7 && <5 , code-page >=0.1 , containers , deepseq , directory , exceptions , filepath , ghc >=8.0 && <9.12 , ghc-paths >=0.1.0.9 , hspec >=2.3.0 , hspec-core >=2.3.0 , mockery , process , silently >=1.2.4 , stringbuilder >=0.4 , syb >=0.3 , transformers default-language: Haskell2010 if impl(ghc >= 9.0) ghc-options: -fwarn-unused-packages if impl(ghc >= 9.8) ghc-options: -fno-warn-x-partial doctest-0.22.6/driver/0000755000000000000000000000000007346545000012732 5ustar0000000000000000doctest-0.22.6/driver/cabal-doctest.hs0000644000000000000000000000030707346545000015773 0ustar0000000000000000module Main (main) where import Prelude import qualified Test.DocTest.Internal.Cabal as Cabal import System.Environment (getArgs) main :: IO () main = getArgs >>= Cabal.doctest doctest-0.22.6/driver/doctest.hs0000644000000000000000000000025107346545000014731 0ustar0000000000000000module Main (main) where import Prelude import Test.DocTest import System.Environment (getArgs) main :: IO () main = getArgs >>= doctest doctest-0.22.6/example/0000755000000000000000000000000007346545000013072 5ustar0000000000000000doctest-0.22.6/example/example.cabal0000644000000000000000000000056607346545000015520 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.22.6/example/src/0000755000000000000000000000000007346545000013661 5ustar0000000000000000doctest-0.22.6/example/src/Example.hs0000644000000000000000000000012507346545000015606 0ustar0000000000000000module Example where -- | -- >>> foo -- 23 foo = 23 -- | -- >>> bar -- 42 bar = 42 doctest-0.22.6/example/test/0000755000000000000000000000000007346545000014051 5ustar0000000000000000doctest-0.22.6/example/test/doctests.hs0000644000000000000000000000015307346545000016234 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["-isrc", "src/Example.hs"] doctest-0.22.6/src/0000755000000000000000000000000007346545000012226 5ustar0000000000000000doctest-0.22.6/src/Cabal.hs0000644000000000000000000000352307346545000013567 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} module Cabal (externalCommand) where import Imports import System.IO import System.Environment import System.Exit (exitWith) import System.Directory import System.FilePath import System.Process import qualified Info import Cabal.Paths import Cabal.Options externalCommand :: [String] -> IO () externalCommand args = do lookupEnv "CABAL" >>= \ case Nothing -> run "cabal" args Just cabal -> run cabal (drop 1 args) run :: String -> [String] -> IO () run cabal args = do rejectUnsupportedOptions args Paths{..} <- paths cabal (discardReplOptions args) let doctest = cache "doctest" <> "-" <> Info.version script = cache "init-ghci-" <> Info.version doesFileExist doctest >>= \ case True -> pass False -> callProcess cabal [ "install" , "doctest-" <> Info.version , "--flag", "-cabal-doctest" , "--ignore-project" , "--installdir", cache , "--program-suffix", "-" <> Info.version , "--install-method=copy" , "--with-compiler", ghc , "--with-hc-pkg", ghcPkg ] doesFileExist script >>= \ case True -> pass False -> writeFileAtomically script ":seti -w -Wdefault" callProcess doctest ["--version"] callProcess cabal ("build" : "--only-dependencies" : discardReplOptions args) rawSystem cabal ("repl" : "--build-depends=QuickCheck" : "--build-depends=template-haskell" : ("--repl-options=-ghci-script=" <> script) : args ++ [ "--with-compiler", doctest , "--with-hc-pkg", ghcPkg ]) >>= exitWith writeFileAtomically :: FilePath -> String -> IO () writeFileAtomically name contents = do (tmp, h) <- openTempFile (takeDirectory name) (takeFileName name) hPutStr h contents hClose h renameFile tmp name doctest-0.22.6/src/Cabal/0000755000000000000000000000000007346545000013230 5ustar0000000000000000doctest-0.22.6/src/Cabal/Options.hs0000644000000000000000000000567707346545000015236 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Cabal.Options ( rejectUnsupportedOptions , discardReplOptions #ifdef TEST , Option(..) , pathOptions , replOptions , shouldReject , Discard(..) , shouldDiscard #endif ) where import Imports import Data.List import System.Exit import Data.Set (Set) import qualified Data.Set as Set data Option = Option { optionName :: String , _optionArgument :: OptionArgument } data OptionArgument = Argument | NoArgument pathOptions :: [Option] pathOptions = [ Option "-z" NoArgument , Option "--ignore-project" NoArgument , Option "--output-format" Argument , Option "--compiler-info" NoArgument , Option "--cache-home" NoArgument , Option "--remote-repo-cache" NoArgument , Option "--logs-dir" NoArgument , Option "--store-dir" NoArgument , Option "--config-file" NoArgument , Option "--installdir" NoArgument ] replOptions :: [Option] replOptions = [ Option "-z" NoArgument , Option "--ignore-project" NoArgument , Option "--repl-no-load" NoArgument , Option "--repl-options" Argument , Option "--repl-multi-file" Argument , Option "-b" Argument , Option "--build-depends" Argument , Option "--no-transitive-deps" NoArgument , Option "--enable-multi-repl" NoArgument , Option "--disable-multi-repl" NoArgument , Option "--keep-temp-files" NoArgument ] rejectUnsupportedOptions :: [String] -> IO () rejectUnsupportedOptions = mapM_ $ \ arg -> when (shouldReject arg) $ do die "Error: cabal: unrecognized 'doctest' option `--installdir'" shouldReject :: String -> Bool shouldReject arg = Set.member arg rejectNames || (`any` longOptionsWithArgument) (`isPrefixOf` arg) where rejectNames :: Set String rejectNames = Set.fromList (map optionName pathOptions) longOptionsWithArgument :: [String] longOptionsWithArgument = [name <> "=" | Option name@('-':'-':_) Argument <- pathOptions] discardReplOptions :: [String] -> [String] discardReplOptions = go where go = \ case [] -> [] arg : args -> case shouldDiscard arg of Keep -> arg : go args Discard -> go args DiscardWithArgument -> go (drop 1 args) data Discard = Keep | Discard | DiscardWithArgument deriving (Eq, Show) shouldDiscard :: String -> Discard shouldDiscard arg | Set.member arg flags = Discard | Set.member arg options = DiscardWithArgument | isOptionWithArgument = Discard | otherwise = Keep where flags :: Set String flags = Set.fromList [name | Option name NoArgument <- replOptions] options :: Set String options = Set.fromList (longOptions <> shortOptions) longOptions :: [String] longOptions = [name | Option name@('-':'-':_) Argument <- replOptions] shortOptions :: [String] shortOptions = [name | Option name@['-', _] Argument <- replOptions] isOptionWithArgument :: Bool isOptionWithArgument = any (`isPrefixOf` arg) (map (<> "=") longOptions <> shortOptions) doctest-0.22.6/src/Cabal/Paths.hs0000644000000000000000000000526507346545000014653 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Cabal.Paths ( Paths(..) , paths ) where import Imports import Data.Char import Data.Tuple import Data.Version hiding (parseVersion) import qualified Data.Version as Version import System.Exit hiding (die) import System.Directory import System.FilePath import System.IO import System.Process import Text.ParserCombinators.ReadP data Paths = Paths { ghc :: FilePath , ghcPkg :: FilePath , cache :: FilePath } deriving (Eq, Show) paths :: FilePath -> [String] -> IO Paths paths cabal args = do cabalVersion <- strip <$> readProcess cabal ["--numeric-version"] "" let required :: Version required = makeVersion [3, 12] when (parseVersion cabalVersion < Just required) $ do die $ "'cabal-install' version " <> showVersion required <> " or later is required, but 'cabal --numeric-version' returned " <> cabalVersion <> "." values <- parseFields <$> readProcess cabal ("path" : args ++ ["-v0"]) "" let getPath :: String -> String -> IO FilePath getPath subject key = case lookup key values of Nothing -> die $ "Cannot determine the path to " <> subject <> ". Running 'cabal path' did not return a value for '" <> key <> "'." Just path -> canonicalizePath path ghc <- getPath "'ghc'" "compiler-path" ghcVersion <- strip <$> readProcess ghc ["--numeric-version"] "" let ghcPkg :: FilePath ghcPkg = takeDirectory ghc "ghc-pkg-" <> ghcVersion #ifdef mingw32_HOST_OS <.> "exe" #endif doesFileExist ghcPkg >>= \ case True -> pass False -> die $ "Cannot determine the path to 'ghc-pkg' from '" <> ghc <> "'. File '" <> ghcPkg <> "' does not exist." abi <- strip <$> readProcess ghcPkg ["--no-user-package-db", "field", "base", "abi", "--simple-output"] "" cache_home <- getPath "Cabal's cache directory" "cache-home" let cache = cache_home "doctest" "ghc-" <> ghcVersion <> "-" <> abi createDirectoryIfMissing True cache return Paths { ghc , ghcPkg , cache } where parseFields :: String -> [(String, FilePath)] parseFields = map parseField . lines parseField :: String -> (String, FilePath) parseField input = case break (== ':') input of (key, ':' : value) -> (key, dropWhile isSpace value) (key, _) -> (key, "") die :: String -> IO a die message = do hPutStrLn stderr "Error: [cabal-doctest]" hPutStrLn stderr message exitFailure strip :: String -> String strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace parseVersion :: String -> Maybe Version parseVersion = lookup "" . map swap . readP_to_S Version.parseVersion doctest-0.22.6/src/Extract.hs0000644000000000000000000002425207346545000014201 0ustar0000000000000000{-# LANGUAGE CPP #-} module Extract (Module(..), extract) where import Imports hiding (mod, concat) import Control.Exception import Data.List (partition, isSuffixOf) 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, Show, 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 ++ #if __GLASGOW_HASKELL__ >= 810 -- `ghci` ignores unused packages in certain situation. This ensures -- that we don't fail in situations where `ghci` would not. "-Wno-unused-packages" : #endif 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__ >= 906 header = [(Nothing, hsDocString <$> x) | Just x <- [hsmodHaddockModHeader (hsmodExt source)]] #elif __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.22.6/src/GhcUtil.hs0000644000000000000000000000447607346545000014134 0ustar0000000000000000{-# LANGUAGE CPP #-} module GhcUtil (withGhc) where import Imports 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__ >= 906 backend = noBackend #elif __GLASGOW_HASKELL__ >= 901 backend = NoBackend #else hscTarget = HscNothing #endif , ghcMode = CompManager , ghcLink = NoLink } doctest-0.22.6/src/Imports.hs0000644000000000000000000000043007346545000014214 0ustar0000000000000000module Imports (module Imports) where import Prelude as Imports import Data.Monoid as Imports import Data.Maybe as Imports import Control.Monad as Imports import Control.Arrow as Imports pass :: Monad m => m () pass = return () doctest-0.22.6/src/Info.hs0000644000000000000000000000216207346545000013456 0ustar0000000000000000{-# LANGUAGE CPP #-} module Info ( versionInfo , info , version #ifdef TEST , formatInfo #endif ) where import Imports import Data.List import System.Process import System.IO.Unsafe #if __GLASGOW_HASKELL__ < 900 import Config as GHC #else import GHC.Settings.Config as GHC #endif import Interpreter (ghc) #ifdef TEST version :: String version = "0.0.0" #else import Data.Version (showVersion) import qualified Paths_doctest version :: String version = showVersion Paths_doctest.version #endif 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.22.6/src/Interpreter.hs0000644000000000000000000000523407346545000015071 0ustar0000000000000000{-# LANGUAGE CPP #-} module Interpreter ( Interpreter , safeEval , safeEvalIt , withInterpreter , ghc , interpreterSupported -- exported for testing , ghcInfo , haveInterpreterKey , filterExpression ) where import Imports import System.Process import System.Directory (getPermissions, executable) 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!" (== Just "YES") . lookup haveInterpreterKey <$> ghcInfo withInterpreter :: (String, [String]) -> (Interpreter -> IO a) -- ^ Action to run -> IO a -- ^ Result of action withInterpreter (command, flags) action = do let args = flags ++ [ xTemplateHaskell #if __GLASGOW_HASKELL__ >= 802 , "-fdiagnostics-color=never" , "-fno-diagnostics-show-caret" #endif #if __GLASGOW_HASKELL__ >= 810 && __GLASGOW_HASKELL__ < 904 , "-Wno-unused-packages" #endif ] bracket (new defaultConfig{configGhci = command} 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.22.6/src/Language/Haskell/0000755000000000000000000000000007346545000015334 5ustar0000000000000000doctest-0.22.6/src/Language/Haskell/GhciWrapper.hs0000644000000000000000000001175007346545000020107 0ustar0000000000000000module Language.Haskell.GhciWrapper ( Interpreter , Config(..) , defaultConfig , new , close , eval , evalIt , evalEcho ) where import Imports import System.IO hiding (stdin, stdout, stderr) import System.Process import System.Exit import Control.Exception import Data.List (isSuffixOf) 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 = \ _ -> 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.22.6/src/Location.hs0000644000000000000000000000413707346545000014337 0ustar0000000000000000{-# LANGUAGE CPP #-} module Location where import Imports 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.22.6/src/Options.hs0000644000000000000000000001037707346545000014225 0ustar0000000000000000{-# LANGUAGE CPP #-} module Options ( Result(..) , Run(..) , Config(..) , defaultConfig , parseOptions #ifdef TEST , defaultRun , usage , info , versionInfo , nonInteractiveGhcOptions #endif ) where import Imports import Control.Monad.Trans.RWS (RWS, execRWS) import qualified Control.Monad.Trans.RWS as RWS import Data.List (stripPrefix) import GHC.Paths (ghc) 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 = ProxyToGhc [String] | Output String | Result a deriving (Eq, Show, Functor) type Warning = String data Run = Run { runWarnings :: [Warning] , runMagicMode :: Bool , runConfig :: Config } deriving (Eq, Show) data Config = Config { ghcOptions :: [String] , fastMode :: Bool , preserveIt :: Bool , verbose :: Bool , repl :: (String, [String]) } deriving (Eq, Show) defaultConfig :: Config defaultConfig = Config { ghcOptions = [] , fastMode = False , preserveIt = False , verbose = False , repl = (ghc, ["--interactive"]) } nonInteractiveGhcOptions :: [String] nonInteractiveGhcOptions = [ "--numeric-version" , "--supported-languages" , "--info" , "--print-global-package-db" , "--print-libdir" , "-c" , "-o" , "--make" , "--abi-hash" ] defaultRun :: Run defaultRun = Run { runWarnings = [] , runMagicMode = False , runConfig = defaultConfig } modifyWarnings :: ([String] -> [String]) -> Run -> Run modifyWarnings f run = run { runWarnings = f (runWarnings run) } setOptions :: [String] -> Run -> Run setOptions ghcOptions run@Run{..} = run { runConfig = runConfig { ghcOptions } } setMagicMode :: Bool -> Run -> Run setMagicMode magic run = run { runMagicMode = magic } setFastMode :: Bool -> Run -> Run setFastMode fastMode run@Run{..} = run { runConfig = runConfig { fastMode } } setPreserveIt :: Bool -> Run -> Run setPreserveIt preserveIt run@Run{..} = run { runConfig = runConfig { preserveIt } } setVerbose :: Bool -> Run -> Run setVerbose verbose run@Run{..} = run { runConfig = runConfig { verbose } } parseOptions :: [String] -> Result Run parseOptions args | on "--info" = Output info | on "--interactive" = runRunOptionsParser (discard "--interactive" args) defaultRun $ do commonRunOptions | on `any` nonInteractiveGhcOptions = ProxyToGhc args | on "--help" = Output usage | on "--version" = Output versionInfo | otherwise = runRunOptionsParser args defaultRun {runMagicMode = True} $ do commonRunOptions parseFlag "--no-magic" (setMagicMode False) parseOptGhc where on option = option `elem` args type RunOptionsParser = RWS () (Endo Run) [String] () runRunOptionsParser :: [String] -> Run -> RunOptionsParser -> Result Run runRunOptionsParser args def parse = case execRWS parse () args of (xs, Endo setter) -> Result (setOptions xs $ setter def) commonRunOptions :: RunOptionsParser commonRunOptions = do parseFlag "--fast" (setFastMode True) parseFlag "--preserve-it" (setPreserveIt True) parseFlag "--verbose" (setVerbose True) parseFlag :: String -> (Run -> Run) -> RunOptionsParser parseFlag flag setter = do args <- RWS.get when (flag `elem` args) $ RWS.tell (Endo setter) RWS.put (discard flag args) parseOptGhc :: RunOptionsParser parseOptGhc = 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." discard :: String -> [String] -> [String] discard flag = filter (/= flag) doctest-0.22.6/src/PackageDBs.hs0000644000000000000000000000345507346545000014515 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Manage GHC package databases module PackageDBs ( getPackageDBArgs #ifdef TEST , PackageDBs (..) , getPackageDBsFromEnv #endif ) where import Imports 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.22.6/src/Parse.hs0000644000000000000000000001334107346545000013636 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Parse ( Module (..) , DocTest (..) , Expression , ExpectedResult , ExpectedLine (..) , LineChunk (..) , extractDocTests , parseModules #ifdef TEST , parseInteractions , parseProperties , mkLineChunks #endif ) where import Imports import Data.Char (isSpace) import Data.List (isPrefixOf, stripPrefix) 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. -- -- @ -- extractDocTests = fmap `parseModules` . `extract` -- @ extractDocTests :: [String] -> IO [Module [Located DocTest]] -- ^ Extracted 'DocTest's extractDocTests = fmap parseModules . extract 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.22.6/src/Property.hs0000644000000000000000000000432107346545000014406 0ustar0000000000000000{-# LANGUAGE CPP #-} module Property ( runProperty , PropertyResult (..) #ifdef TEST , freeVariables , parseNotInScope #endif ) where import Imports import Data.List 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.22.6/src/Run.hs0000644000000000000000000001125307346545000013330 0ustar0000000000000000{-# LANGUAGE CPP #-} module Run ( doctest , doctestWithRepl , Config(..) , defaultConfig , doctestWith , Result , Summary(..) , isSuccess , evaluateResult , doctestWithResult , runDocTests #ifdef TEST , expandDirs #endif ) where import Imports 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 hiding (Result(..)) import qualified Options import Runner import Location 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 = doctestWithRepl (repl defaultConfig) doctestWithRepl :: (String, [String]) -> [String] -> IO () doctestWithRepl repl args0 = case parseOptions args0 of Options.ProxyToGhc args -> rawSystem Interpreter.ghc args >>= E.throwIO Options.Output s -> putStr s Options.Result (Run warnings magicMode config) -> do mapM_ (hPutStrLn stderr) warnings hFlush stderr i <- Interpreter.interpreterSupported unless i $ do hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests" exitSuccess opts <- case magicMode of False -> return (ghcOptions config) True -> do expandedArgs <- concat <$> mapM expandDirs (ghcOptions config) packageDBArgs <- getPackageDBArgs addDistArgs <- getAddDistArgs return (addDistArgs $ packageDBArgs ++ expandedArgs) doctestWith config{repl, ghcOptions = opts} -- | 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 = fromMaybe "dist" $ lookup "HASKELL_DIST_DIR" env 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 doctestWith :: Config -> IO () doctestWith = doctestWithResult >=> evaluateResult type Result = Summary isSuccess :: Result -> Bool isSuccess s = sErrors s == 0 && sFailures s == 0 evaluateResult :: Result -> IO () evaluateResult r = unless (isSuccess r) exitFailure doctestWithResult :: Config -> IO Result doctestWithResult config = do (extractDocTests (ghcOptions config) >>= runDocTests config) `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 runDocTests :: Config -> [Module [Located DocTest]] -> IO Result runDocTests Config{..} modules = do Interpreter.withInterpreter ((<> ghcOptions) <$> repl) $ \ interpreter -> withCP65001 $ do runModules fastMode preserveIt verbose interpreter modules doctest-0.22.6/src/Runner.hs0000644000000000000000000001663707346545000014050 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://gitlab.haskell.org/ghc/ghc/-/issues/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] type Interaction = (Expression, ExpectedResult) -- | -- 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.22.6/src/Runner/0000755000000000000000000000000007346545000013477 5ustar0000000000000000doctest-0.22.6/src/Runner/Example.hs0000644000000000000000000001254607346545000015436 0ustar0000000000000000module Runner.Example ( Result (..) , mkResult ) where import Imports 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.22.6/src/Test/0000755000000000000000000000000007346545000013145 5ustar0000000000000000doctest-0.22.6/src/Test/DocTest.hs0000644000000000000000000000011107346545000015037 0ustar0000000000000000module Test.DocTest ( doctest ) where import Test.DocTest.Internal.Run doctest-0.22.6/src/Test/DocTest/Internal/0000755000000000000000000000000007346545000016266 5ustar0000000000000000doctest-0.22.6/src/Test/DocTest/Internal/Cabal.hs0000644000000000000000000000024707346545000017627 0ustar0000000000000000module Test.DocTest.Internal.Cabal ( doctest ) where import Imports import qualified Cabal doctest :: [String] -> IO () doctest = Cabal.externalCommand doctest-0.22.6/src/Test/DocTest/Internal/Extract.hs0000644000000000000000000000011707346545000020233 0ustar0000000000000000module Test.DocTest.Internal.Extract ( module Extract ) where import Extract doctest-0.22.6/src/Test/DocTest/Internal/Location.hs0000644000000000000000000000012207346545000020365 0ustar0000000000000000module Test.DocTest.Internal.Location ( module Location ) where import Location doctest-0.22.6/src/Test/DocTest/Internal/Parse.hs0000644000000000000000000000011107346545000017665 0ustar0000000000000000module Test.DocTest.Internal.Parse ( module Parse ) where import Parse doctest-0.22.6/src/Test/DocTest/Internal/Run.hs0000644000000000000000000000010307346545000017360 0ustar0000000000000000module Test.DocTest.Internal.Run ( module Run ) where import Run doctest-0.22.6/src/Util.hs0000644000000000000000000000134607346545000013503 0ustar0000000000000000module Util where import Imports 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.22.6/test/Cabal/0000755000000000000000000000000007346545000013420 5ustar0000000000000000doctest-0.22.6/test/Cabal/OptionsSpec.hs0000644000000000000000000000651507346545000016231 0ustar0000000000000000{-# LANGUAGE CPP #-} module Cabal.OptionsSpec (spec) where import Imports import Test.Hspec import System.IO import System.IO.Silently import System.Exit import System.Process import qualified Data.Set as Set import Cabal.Options spec :: Spec spec = do describe "pathOptions" $ do it "is the set of options that are unique to 'cabal path'" $ do build <- Set.fromList . lines <$> readProcess "cabal" ["build", "--list-options"] "" path <- Set.fromList . lines <$> readProcess "cabal" ["path", "--list-options"] "" map optionName pathOptions `shouldMatchList` Set.toList (Set.difference path build) describe "replOptions" $ do it "is the set of options that are unique to 'cabal repl'" $ do build <- Set.fromList . lines <$> readProcess "cabal" ["build", "--list-options"] "" repl <- Set.fromList . lines <$> readProcess "cabal" ["repl", "--list-options"] "" map optionName replOptions `shouldMatchList` Set.toList (Set.difference repl build) describe "rejectUnsupportedOptions" $ do it "produces error messages that are consistent with 'cabal repl'" $ do let shouldFail :: HasCallStack => String -> IO a -> Expectation shouldFail command action = do hCapture_ [stderr] (action `shouldThrow` (== ExitFailure 1)) `shouldReturn` "Error: cabal: unrecognized '" <> command <> "' option `--installdir'\n" #ifndef mingw32_HOST_OS shouldFail "repl" $ rawSystem "cabal" ["repl", "--installdir"] >>= exitWith #endif shouldFail "doctest" $ rejectUnsupportedOptions ["--installdir"] describe "shouldReject" $ do it "accepts --foo" $ do shouldReject "--foo" `shouldBe` False it "rejects --ignore-project" $ do shouldReject "--ignore-project" `shouldBe` True it "rejects -z" $ do shouldReject "-z" `shouldBe` True it "rejects --output-format" $ do shouldReject "--output-format" `shouldBe` True it "rejects --output-format=" $ do shouldReject "--output-format=json" `shouldBe` True it "rejects --installdir" $ do shouldReject "--installdir" `shouldBe` True describe "discardReplOptions" $ do it "discards 'cabal repl'-only options" $ do discardReplOptions [ "--foo" , "--build-depends=foo" , "--build-depends", "foo" , "-bfoo" , "-b", "foo" , "--bar" , "--enable-multi-repl" , "--repl-options", "foo" , "--repl-options=foo" , "--baz" ] `shouldBe` ["--foo", "--bar", "--baz"] describe "shouldDiscard" $ do it "keeps --foo" $ do shouldDiscard "--foo" `shouldBe` Keep it "discards --build-depends" $ do shouldDiscard "--build-depends" `shouldBe` DiscardWithArgument it "discards --build-depends=" $ do shouldDiscard "--build-depends=foo" `shouldBe` Discard it "discards -b" $ do shouldDiscard "-b" `shouldBe` DiscardWithArgument it "discards -bfoo" $ do shouldDiscard "-bfoo" `shouldBe` Discard it "discards --repl-options" $ do shouldDiscard "--repl-options" `shouldBe` DiscardWithArgument it "discards --repl-options=" $ do shouldDiscard "--repl-options=foo" `shouldBe` Discard it "discards --enable-multi-repl" $ do shouldDiscard "--enable-multi-repl" `shouldBe` Discard doctest-0.22.6/test/Cabal/PathsSpec.hs0000644000000000000000000000111707346545000015646 0ustar0000000000000000module Cabal.PathsSpec (spec) where import Imports import Test.Hspec import System.Directory import Cabal () import Cabal.Paths spec :: Spec spec = do describe "paths" $ do it "returns the path to 'ghc'" $ do (paths "cabal" [] >>= doesFileExist . ghc) `shouldReturn` True it "returns the path to 'ghc-pkg'" $ do (paths "cabal" [] >>= doesFileExist . ghcPkg) `shouldReturn` True it "returns the path to Cabal's cache directory" $ do (paths "cabal" [] >>= doesDirectoryExist . cache) `shouldReturn` True doctest-0.22.6/test/0000755000000000000000000000000007346545000012416 5ustar0000000000000000doctest-0.22.6/test/ExtractSpec.hs0000644000000000000000000000774407346545000015213 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} module ExtractSpec (main, spec) where import Imports 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 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.22.6/test/InfoSpec.hs0000644000000000000000000000055607346545000014466 0ustar0000000000000000module InfoSpec (spec) where import Imports 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.22.6/test/InterpreterSpec.hs0000644000000000000000000000305507346545000016073 0ustar0000000000000000module InterpreterSpec (spec) where import Imports import Test.Hspec import Interpreter (Interpreter, interpreterSupported, haveInterpreterKey, ghcInfo, ghc, safeEval, filterExpression) import qualified Interpreter withInterpreter :: (Interpreter -> IO a) -> IO a withInterpreter = Interpreter.withInterpreter (Interpreter.ghc, ["--interactive"]) 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.22.6/test/Language/Haskell/0000755000000000000000000000000007346545000015524 5ustar0000000000000000doctest-0.22.6/test/Language/Haskell/GhciWrapperSpec.hs0000644000000000000000000001127107346545000021110 0ustar0000000000000000{-# LANGUAGE CPP #-} module Language.Haskell.GhciWrapperSpec (main, spec) where import Imports import Test.Hspec import System.IO.Silently import Control.Exception import Data.List import Language.Haskell.GhciWrapper (Interpreter, Config(..), defaultConfig) import qualified Language.Haskell.GhciWrapper as Interpreter main :: IO () main = hspec spec withInterpreterConfig :: Config -> [String] -> (Interpreter -> IO a) -> IO a withInterpreterConfig config args = bracket (Interpreter.new config args) Interpreter.close withInterpreterArgs :: [String] -> ((String -> IO String) -> IO a) -> IO a withInterpreterArgs args action = withInterpreterConfig defaultConfig args $ action . Interpreter.eval withInterpreter :: ((String -> IO String) -> IO a) -> IO a withInterpreter = withInterpreterArgs [] spec :: Spec spec = do describe "evalEcho" $ do it "prints result to stdout" $ do withInterpreterConfig defaultConfig [] $ \ghci -> do (capture $ Interpreter.evalEcho ghci ("putStr" ++ show "foo\nbar")) `shouldReturn` ("foo\nbar", "foo\nbar") describe "evalIt" $ do it "preserves it" $ do withInterpreterConfig defaultConfig [] $ \ghci -> do Interpreter.evalIt ghci "23" `shouldReturn` "23\n" Interpreter.eval ghci "it" `shouldReturn` "23\n" describe "eval" $ do it "shows literals" $ withInterpreter $ \ghci -> do ghci "23" `shouldReturn` "23\n" it "shows string literals containing Unicode" $ withInterpreter $ \ghci -> do ghci "\"λ\"" `shouldReturn` "\"\\955\"\n" it "evaluates simple expressions" $ withInterpreter $ \ghci -> do ghci "23 + 42" `shouldReturn` "65\n" it "supports let bindings" $ withInterpreter $ \ghci -> do ghci "let x = 10" `shouldReturn` "" ghci "x" `shouldReturn` "10\n" it "allows import statements" $ withInterpreter $ \ghci -> do ghci "import Data.Maybe" `shouldReturn` "" ghci "fromJust (Just 20)" `shouldReturn` "20\n" it "captures stdout" $ withInterpreter $ \ghci -> do ghci "putStr \"foo\"" `shouldReturn` "foo" it "captures stdout (Unicode)" $ withInterpreter $ \ghci -> do ghci "putStrLn \"λ\"" `shouldReturn` "λ\n" it "captures stdout (empty line)" $ withInterpreter $ \ghci -> do ghci "putStrLn \"\"" `shouldReturn` "\n" it "captures stdout (multiple lines)" $ withInterpreter $ \ghci -> do ghci "putStrLn \"foo\" >> putStrLn \"bar\" >> putStrLn \"baz\"" `shouldReturn` "foo\nbar\nbaz\n" it "captures stderr" $ withInterpreter $ \ghci -> do ghci "import System.IO" `shouldReturn` "" ghci "hPutStrLn stderr \"foo\"" `shouldReturn` "foo\n" it "captures stderr (Unicode)" $ withInterpreter $ \ghci -> do ghci "import System.IO" `shouldReturn` "" ghci "hPutStrLn stderr \"λ\"" `shouldReturn` "λ\n" it "shows exceptions" $ withInterpreter $ \ghci -> do ghci "import Control.Exception" `shouldReturn` "" ghci "throwIO DivideByZero" `shouldReturn` "*** Exception: divide by zero\n" it "shows exceptions (ExitCode)" $ withInterpreter $ \ghci -> do ghci "import System.Exit" `shouldReturn` "" ghci "exitWith $ ExitFailure 10" `shouldReturn` "*** Exception: ExitFailure 10\n" it "gives an error message for identifiers that are not in scope" $ withInterpreter $ \ghci -> do #if __GLASGOW_HASKELL__ >= 800 ghci "foo" >>= (`shouldSatisfy` isInfixOf "Variable not in scope: foo") #elif __GLASGOW_HASKELL__ >= 707 ghci "foo" >>= (`shouldSatisfy` isSuffixOf "Not in scope: \8216foo\8217\n") #else ghci "foo" >>= (`shouldSatisfy` isSuffixOf "Not in scope: `foo'\n") #endif context "when configVerbose is True" $ do it "prints prompt" $ do withInterpreterConfig defaultConfig{configVerbose = True} [] $ \ghci -> do Interpreter.eval ghci "print 23" >>= (`shouldSatisfy` (`elem` [ "Prelude> 23\nPrelude> " , "ghci> 23\nghci> " ])) context "with -XOverloadedStrings, -Wall and -Werror" $ do it "does not fail on marker expression (bug fix)" $ withInterpreter $ \ghci -> do ghci ":seti -XOverloadedStrings -Wall -Werror" `shouldReturn` "" ghci "putStrLn \"foo\"" `shouldReturn` "foo\n" context "with NoImplicitPrelude" $ do it "works" $ withInterpreterArgs ["-XNoImplicitPrelude"] $ \ghci -> do ghci "putStrLn \"foo\"" >>= (`shouldContain` "Variable not in scope: putStrLn") ghci "23" `shouldReturn` "23\n" context "with a strange String type" $ do it "works" $ withInterpreter $ \ghci -> do ghci "type String = Int" `shouldReturn` "" ghci "putStrLn \"foo\"" `shouldReturn` "foo\n" doctest-0.22.6/test/LocationSpec.hs0000644000000000000000000000304307346545000015335 0ustar0000000000000000{-# LANGUAGE CPP #-} module LocationSpec (main, spec) where import Imports 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.22.6/test/MainSpec.hs0000644000000000000000000001356707346545000014465 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} module MainSpec (main, spec) where import Imports import Test.Hspec import Test.HUnit (assertEqual, Assertion) import Control.Exception import System.Directory (getCurrentDirectory, setCurrentDirectory) import System.FilePath 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 False doctestWithPreserveIt :: HasCallStack => Bool -> FilePath -> [String] -> Summary -> Assertion doctestWithPreserveIt preserveIt workingDir ghcOptions expected = do actual <- withCurrentDirectory ("test/integration" workingDir) (hSilence [stderr] $ doctestWithResult defaultConfig {ghcOptions, preserveIt}) assertEqual label expected actual where label = workingDir ++ " " ++ show ghcOptions 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.22.6/test/OptionsSpec.hs0000644000000000000000000000656507346545000015234 0ustar0000000000000000module OptionsSpec (spec) where import Imports import Data.List import Test.Hspec import Test.QuickCheck hiding (verbose) 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 run :: [String] -> Run run ghcOptions = defaultRun { runWarnings = ["WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."] , runMagicMode = True , runConfig = defaultConfig { ghcOptions } } it "strips --optghc" $ parseOptions ["--optghc", "foobar"] `shouldBe` Result (run ["foobar"]) it "strips --optghc=" $ parseOptions ["--optghc=foobar"] `shouldBe` Result (run ["foobar"]) context "with ghc options that are not valid with --interactive" $ do it "returns ProxyToGhc" $ do property $ \ (NonInteractive x) xs -> do let options = x : xs parseOptions options `shouldBe` ProxyToGhc 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 ghcOptions . runConfig <$> parseOptions options `shouldBe` Result ["--foo", "--bar"] it "accepts --fast" $ do fastMode . runConfig <$> parseOptions ("--fast" : options) `shouldBe` Result True 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 fastMode . runConfig <$> parseOptions [] `shouldBe` Result False context "with --fast" $ do it "enabled fast mode" $ do fastMode . runConfig <$> parseOptions ["--fast"] `shouldBe` Result True describe "--preserve-it" $ do context "without --preserve-it" $ do it "does not preserve the `it` variable" $ do preserveIt . runConfig <$> parseOptions [] `shouldBe` Result False context "with --preserve-it" $ do it "preserves the `it` variable" $ do preserveIt . runConfig <$> 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 verbose . runConfig <$> parseOptions [] `shouldBe` Result False context "with --verbose" $ do it "parses verbose option" $ do verbose . runConfig <$> parseOptions ["--verbose"] `shouldBe` Result True doctest-0.22.6/test/PackageDBsSpec.hs0000644000000000000000000000227407346545000015516 0ustar0000000000000000module PackageDBsSpec (main, spec) where import Imports import qualified Control.Exception as E import Data.List (intercalate) import PackageDBs import System.Environment 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.22.6/test/ParseSpec.hs0000644000000000000000000001346007346545000014643 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module ParseSpec (main, spec) where import Imports import Test.Hspec import Data.String import Data.String.Builder (Builder, build) import Control.Monad.Trans.Writer import Parse import Location 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 "extractDocTests" $ do it "extracts properties from a module" $ do extractDocTests ["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 extractDocTests ["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 extractDocTests ["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 extractDocTests ["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 extractDocTests ["test/parse/no-examples/Fib.hs"] >>= (`shouldBe` []) it "sets setup code to Nothing, if it does not contain any tests" $ do extractDocTests ["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 extractDocTests ["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.22.6/test/PropertySpec.hs0000644000000000000000000001232207346545000015411 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module PropertySpec (spec) where import Imports import Test.Hspec import Data.String.Builder import Property import Interpreter (Interpreter) import qualified Interpreter withInterpreter :: (Interpreter -> IO a) -> IO a withInterpreter = Interpreter.withInterpreter (Interpreter.ghc, ["--interactive"]) 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.22.6/test/RunSpec.hs0000644000000000000000000001335307346545000014336 0ustar0000000000000000{-# LANGUAGE CPP #-} module RunSpec (main, spec) where import Imports import Test.Hspec import System.Exit import qualified Control.Exception as E import System.FilePath import System.Directory (getCurrentDirectory, setCurrentDirectory) import Data.List (isPrefixOf, sort) import Data.Char import System.IO.Silently import System.IO (stderr) import qualified Options import Run 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 "doctestWithResult" $ do context "on parse error" $ do let action = withCurrentDirectory "test/integration/parse-error" $ do doctestWithResult defaultConfig { ghcOptions = ["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` unlines ( #if __GLASGOW_HASKELL__ < 910 "" : #endif #if __GLASGOW_HASKELL__ >= 906 [ "Foo.hs:6:1: error: [GHC-58481]" #else [ "Foo.hs:6:1: error:" #endif , " parse error (possibly incorrect indentation or mismatched brackets)" #if __GLASGOW_HASKELL__ >= 910 , "" #endif ]) describe "expandDirs" $ do it "expands a directory" $ do res <- expandDirs "example" sort res `shouldBe` [ "example" "src" "Example.hs" , "example" "test" "doctests.hs" ] it "ignores files" $ do res <- expandDirs "doctest.cabal" res `shouldBe` ["doctest.cabal"] it "ignores random things" $ do let x = "foo bar baz bin" res <- expandDirs x res `shouldBe` [x] 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.22.6/test/Runner/0000755000000000000000000000000007346545000013667 5ustar0000000000000000doctest-0.22.6/test/Runner/ExampleSpec.hs0000644000000000000000000001303407346545000016432 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Runner.ExampleSpec (main, spec) where import Imports 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.22.6/test/RunnerSpec.hs0000644000000000000000000000445307346545000015044 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module RunnerSpec (main, spec) where import Imports 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.22.6/test/Spec.hs0000644000000000000000000000005407346545000013643 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} doctest-0.22.6/test/UtilSpec.hs0000644000000000000000000000110307346545000014475 0ustar0000000000000000module UtilSpec (main, spec) where import Imports 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.22.6/test/extract/argument-list/0000755000000000000000000000000007346545000016663 5ustar0000000000000000doctest-0.22.6/test/extract/argument-list/Foo.hs0000644000000000000000000000014707346545000017744 0ustar0000000000000000module Foo where foo :: Int -- ^ doc for arg1 -> Int -- ^ doc for arg2 -> Int foo = undefined doctest-0.22.6/test/extract/comment-order/0000755000000000000000000000000007346545000016643 5ustar0000000000000000doctest-0.22.6/test/extract/comment-order/Foo.hs0000644000000000000000000000042107346545000017717 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.22.6/test/extract/declaration/0000755000000000000000000000000007346545000016355 5ustar0000000000000000doctest-0.22.6/test/extract/declaration/Foo.hs0000644000000000000000000000007607346545000017437 0ustar0000000000000000module Foo where -- | Some documentation foo :: Int foo = 23 doctest-0.22.6/test/extract/dos-line-endings/0000755000000000000000000000000007346545000017227 5ustar0000000000000000doctest-0.22.6/test/extract/dos-line-endings/Foo.hs0000644000000000000000000000011007346545000020276 0ustar0000000000000000module Foo where -- | -- foo -- bar -- baz foo :: Int foo = 23 doctest-0.22.6/test/extract/export-list/0000755000000000000000000000000007346545000016362 5ustar0000000000000000doctest-0.22.6/test/extract/export-list/Foo.hs0000644000000000000000000000020107346545000017432 0ustar0000000000000000module Foo ( -- * some heading -- | documentation from export list foo , bar ) where foo :: Int foo = 23 bar :: Int bar = 23 doctest-0.22.6/test/extract/imported-module/0000755000000000000000000000000007346545000017176 5ustar0000000000000000doctest-0.22.6/test/extract/imported-module/Bar.hs0000644000000000000000000000011507346545000020233 0ustar0000000000000000module Bar where import Baz -- | documentation for bar bar :: Int bar = 23 doctest-0.22.6/test/extract/imported-module/Baz.hs0000644000000000000000000000010107346545000020236 0ustar0000000000000000module Baz where -- | documentation for baz baz :: Int baz = 23 doctest-0.22.6/test/extract/module-header/0000755000000000000000000000000007346545000016603 5ustar0000000000000000doctest-0.22.6/test/extract/module-header/Foo.hs0000644000000000000000000000007607346545000017665 0ustar0000000000000000-- | Some documentation module Foo where foo :: Int foo = 23 doctest-0.22.6/test/extract/named-chunks/0000755000000000000000000000000007346545000016445 5ustar0000000000000000doctest-0.22.6/test/extract/named-chunks/Foo.hs0000644000000000000000000000020007346545000017514 0ustar0000000000000000module Foo ( foo , bar ) where -- $foo named chunk foo -- $bar -- named chunk bar foo :: Int foo = 23 bar :: Int bar = 23 doctest-0.22.6/test/extract/regression/0000755000000000000000000000000007346545000016250 5ustar0000000000000000doctest-0.22.6/test/extract/regression/Fixity.hs0000644000000000000000000000005607346545000020061 0ustar0000000000000000module Fixity where foo :: Int foo = 23 + 42 doctest-0.22.6/test/extract/regression/ForeignImport.hs0000644000000000000000000000037707346545000021377 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.22.6/test/extract/regression/ParallelListComp.hs0000644000000000000000000000017007346545000022011 0ustar0000000000000000{-# LANGUAGE ParallelListComp #-} module ParallelListComp where foo :: [Int] foo = [x+y | x <- [1,2,3] | y <- [4,5,6]] doctest-0.22.6/test/extract/regression/ParallelListCompClass.hs0000644000000000000000000000026207346545000023001 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.22.6/test/extract/regression/RewriteRules.hs0000644000000000000000000000023207346545000021235 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.22.6/test/extract/regression/RewriteRulesWithSigs.hs0000644000000000000000000000025607346545000022725 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.22.6/test/extract/setup/0000755000000000000000000000000007346545000015230 5ustar0000000000000000doctest-0.22.6/test/extract/setup/Foo.hs0000644000000000000000000000021107346545000016301 0ustar0000000000000000module Foo where -- $setup -- some setup code -- | foo foo :: Int foo = 42 -- | bar bar :: Int bar = 42 -- | baz baz :: Int baz = 42 doctest-0.22.6/test/extract/th/0000755000000000000000000000000007346545000014503 5ustar0000000000000000doctest-0.22.6/test/extract/th/Bar.hs0000644000000000000000000000016607346545000015546 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Bar where import Language.Haskell.TH.Lib (ExpQ) bar :: ExpQ bar = [| 23 |] doctest-0.22.6/test/extract/th/Foo.hs0000644000000000000000000000015707346545000015565 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Foo where import Bar -- | some documentation foo :: Int foo = $(bar) doctest-0.22.6/test/extract/type-class-args/0000755000000000000000000000000007346545000017106 5ustar0000000000000000doctest-0.22.6/test/extract/type-class-args/Foo.hs0000644000000000000000000000014407346545000020164 0ustar0000000000000000module Foo where class Foo a where bar :: a -- ^ foo -> Int -- ^ bar -> String doctest-0.22.6/test/extract/type-class/0000755000000000000000000000000007346545000016154 5ustar0000000000000000doctest-0.22.6/test/extract/type-class/Foo.hs0000644000000000000000000000015507346545000017234 0ustar0000000000000000module Foo where class ToString a where -- | Convert given value to a string. toString :: a -> String doctest-0.22.6/test/extract/type-families/0000755000000000000000000000000007346545000016640 5ustar0000000000000000doctest-0.22.6/test/extract/type-families/Foo.hs0000644000000000000000000000013707346545000017720 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} module Foo where type family Foo a type instance Foo Int = Int doctest-0.22.6/test/integration/bugfixImportHierarchical/0000755000000000000000000000000007346545000021717 5ustar0000000000000000doctest-0.22.6/test/integration/bugfixImportHierarchical/ModuleA.hs0000644000000000000000000000010207346545000023572 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import Foo.ModuleB doctest-0.22.6/test/integration/bugfixImportHierarchical/ModuleB.hs0000644000000000000000000000023407346545000023601 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.22.6/test/integration/bugfixMultipleModules/0000755000000000000000000000000007346545000021272 5ustar0000000000000000doctest-0.22.6/test/integration/bugfixMultipleModules/ModuleA.hs0000644000000000000000000000007607346545000023157 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import ModuleB doctest-0.22.6/test/integration/bugfixMultipleModules/ModuleB.hs0000644000000000000000000000035007346545000023153 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.22.6/test/integration/bugfixOutputToStdErr/0000755000000000000000000000000007346545000021075 5ustar0000000000000000doctest-0.22.6/test/integration/bugfixOutputToStdErr/Fib.hs0000644000000000000000000000027407346545000022134 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.22.6/test/integration/bugfixWorkingDirectory/0000755000000000000000000000000007346545000021453 5ustar0000000000000000doctest-0.22.6/test/integration/bugfixWorkingDirectory/Fib.hs0000644000000000000000000000022407346545000022505 0ustar0000000000000000module Fib where -- | Calculate Fibonacci number of given 'Num'. -- -- >>> bar -- 10 fib :: (Num t, Num t1) => t -> t1 fib _ = undefined bar = 10 doctest-0.22.6/test/integration/bugfixWorkingDirectory/description0000644000000000000000000000031207346545000023715 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.22.6/test/integration/bugfixWorkingDirectory/examples/0000755000000000000000000000000007346545000023271 5ustar0000000000000000doctest-0.22.6/test/integration/bugfixWorkingDirectory/examples/Fib.hs0000644000000000000000000000042507346545000024326 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.22.6/test/integration/color/0000755000000000000000000000000007346545000016057 5ustar0000000000000000doctest-0.22.6/test/integration/color/Foo.hs0000644000000000000000000000037107346545000017137 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.22.6/test/integration/custom-package-conf/0000755000000000000000000000000007346545000020567 5ustar0000000000000000doctest-0.22.6/test/integration/custom-package-conf/Bar.hs0000644000000000000000000000013207346545000021623 0ustar0000000000000000module Bar where import Foo -- | -- >>> import Foo -- >>> foo -- 23 bar :: Int bar = 42 doctest-0.22.6/test/integration/custom-package-conf/foo/0000755000000000000000000000000007346545000021352 5ustar0000000000000000doctest-0.22.6/test/integration/custom-package-conf/foo/Foo.hs0000644000000000000000000000004507346545000022430 0ustar0000000000000000module Foo where foo :: Int foo = 23 doctest-0.22.6/test/integration/custom-package-conf/foo/doctest-foo.cabal0000644000000000000000000000023207346545000024561 0ustar0000000000000000name: doctest-foo version: 0.0.0 build-type: Simple cabal-version: >= 1.8 library exposed-modules: Foo build-depends: base doctest-0.22.6/test/integration/dos-line-endings/0000755000000000000000000000000007346545000020100 5ustar0000000000000000doctest-0.22.6/test/integration/dos-line-endings/Fib.hs0000644000000000000000000000024507346545000021135 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.22.6/test/integration/failing-multiple/0000755000000000000000000000000007346545000020203 5ustar0000000000000000doctest-0.22.6/test/integration/failing-multiple/Foo.hs0000644000000000000000000000021507346545000021260 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> 23 -- 23 -- -- >>> 23 -- 42 -- -- >>> 23 -- 23 -- >>> 23 -- 23 test :: a test = undefined doctest-0.22.6/test/integration/failing/0000755000000000000000000000000007346545000016352 5ustar0000000000000000doctest-0.22.6/test/integration/failing/Foo.hs0000644000000000000000000000012707346545000017431 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> 23 -- 42 test :: a test = undefined doctest-0.22.6/test/integration/it/0000755000000000000000000000000007346545000015355 5ustar0000000000000000doctest-0.22.6/test/integration/it/Foo.hs0000644000000000000000000000026007346545000016432 0ustar0000000000000000module Foo where -- | -- -- >>> :t 'a' -- 'a' :: Char -- -- >>> "foo" -- "foo" -- -- >>> length it -- 3 -- -- >>> it * it -- 9 -- -- >>> :t it -- it :: Int -- foo = undefined doctest-0.22.6/test/integration/it/Setup.hs0000644000000000000000000000031007346545000017003 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.22.6/test/integration/local-stderr-binding/0000755000000000000000000000000007346545000020744 5ustar0000000000000000doctest-0.22.6/test/integration/local-stderr-binding/A.hs0000644000000000000000000000015007346545000021454 0ustar0000000000000000module A where stderr :: Bool stderr = True stdout :: String stdout = "hello" -- | -- >>> 3 + 3 -- 6 doctest-0.22.6/test/integration/multiline/0000755000000000000000000000000007346545000016743 5ustar0000000000000000doctest-0.22.6/test/integration/multiline/Multiline.hs0000644000000000000000000000114207346545000021237 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.22.6/test/integration/parse-error/0000755000000000000000000000000007346545000017202 5ustar0000000000000000doctest-0.22.6/test/integration/parse-error/Foo.hs0000644000000000000000000000007307346545000020261 0ustar0000000000000000module Foo where -- | Some documentation foo :: Int foo = doctest-0.22.6/test/integration/property-bool-with-type-signature/0000755000000000000000000000000007346545000023505 5ustar0000000000000000doctest-0.22.6/test/integration/property-bool-with-type-signature/Foo.hs0000644000000000000000000000007507346545000024566 0ustar0000000000000000module Foo where -- | -- prop> True :: Bool foo = undefined doctest-0.22.6/test/integration/property-bool/0000755000000000000000000000000007346545000017556 5ustar0000000000000000doctest-0.22.6/test/integration/property-bool/Foo.hs0000644000000000000000000000006507346545000020636 0ustar0000000000000000module Foo where -- | -- prop> True foo = undefined doctest-0.22.6/test/integration/property-failing/0000755000000000000000000000000007346545000020234 5ustar0000000000000000doctest-0.22.6/test/integration/property-failing/Foo.hs0000644000000000000000000000007307346545000021313 0ustar0000000000000000module Foo where -- | -- prop> abs x == x foo = undefined doctest-0.22.6/test/integration/property-implicitly-quantified/0000755000000000000000000000000007346545000023131 5ustar0000000000000000doctest-0.22.6/test/integration/property-implicitly-quantified/Foo.hs0000644000000000000000000000010507346545000024204 0ustar0000000000000000module Foo where -- | -- prop> abs x == abs (abs x) foo = undefined doctest-0.22.6/test/integration/property-quantified/0000755000000000000000000000000007346545000020754 5ustar0000000000000000doctest-0.22.6/test/integration/property-quantified/Foo.hs0000644000000000000000000000011307346545000022026 0ustar0000000000000000module Foo where -- | -- prop> \x -> abs x == abs (abs x) foo = undefined doctest-0.22.6/test/integration/property-setup/0000755000000000000000000000000007346545000017763 5ustar0000000000000000doctest-0.22.6/test/integration/property-setup/Foo.hs0000644000000000000000000000024507346545000021043 0ustar0000000000000000module Foo where -- $setup -- >>> import Test.QuickCheck -- >>> let arbitraryEven = (* 2) `fmap` arbitrary -- | -- prop> forAll arbitraryEven even foo = undefined doctest-0.22.6/test/integration/setup-skip-on-failure/0000755000000000000000000000000007346545000021104 5ustar0000000000000000doctest-0.22.6/test/integration/setup-skip-on-failure/Foo.hs0000644000000000000000000000017707346545000022170 0ustar0000000000000000module Foo where -- $setup -- >>> x -- 23 -- | -- >>> foo -- 42 foo :: Int foo = 42 -- | -- >>> y -- 42 bar :: Int bar = 42 doctest-0.22.6/test/integration/setup/0000755000000000000000000000000007346545000016101 5ustar0000000000000000doctest-0.22.6/test/integration/setup/Foo.hs0000644000000000000000000000014407346545000017157 0ustar0000000000000000module Foo where -- $setup -- >>> let x = 23 :: Int -- | -- >>> x + foo -- 65 foo :: Int foo = 42 doctest-0.22.6/test/integration/system-io-imported/0000755000000000000000000000000007346545000020513 5ustar0000000000000000doctest-0.22.6/test/integration/system-io-imported/A.hs0000644000000000000000000000036307346545000021231 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.22.6/test/integration/template-haskell-bugfix/0000755000000000000000000000000007346545000021457 5ustar0000000000000000doctest-0.22.6/test/integration/template-haskell-bugfix/Main.hs0000644000000000000000000000042707346545000022702 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.22.6/test/integration/template-haskell-bugfix/Printf.hs0000644000000000000000000000077507346545000023266 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.22.6/test/integration/template-haskell/0000755000000000000000000000000007346545000020175 5ustar0000000000000000doctest-0.22.6/test/integration/template-haskell/Foo.hs0000644000000000000000000000061407346545000021255 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.22.6/test/integration/test-options/0000755000000000000000000000000007346545000017411 5ustar0000000000000000doctest-0.22.6/test/integration/test-options/Foo.hs0000644000000000000000000000015607346545000020472 0ustar0000000000000000module Foo where -- | -- Examples: -- -- >>> foo -- 23 foo :: Int #ifdef FOO foo = 23 #else foo = 42 #endif doctest-0.22.6/test/integration/testBlankline/0000755000000000000000000000000007346545000017540 5ustar0000000000000000doctest-0.22.6/test/integration/testBlankline/Fib.hs0000644000000000000000000000026307346545000020575 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.22.6/test/integration/testCPP/0000755000000000000000000000000007346545000016263 5ustar0000000000000000doctest-0.22.6/test/integration/testCPP/Foo.hs0000644000000000000000000000015607346545000017344 0ustar0000000000000000module Foo where -- | -- Examples: -- -- >>> foo -- 23 foo :: Int #ifdef FOO foo = 23 #else foo = 42 #endif doctest-0.22.6/test/integration/testCombinedExample/0000755000000000000000000000000007346545000020675 5ustar0000000000000000doctest-0.22.6/test/integration/testCombinedExample/Fib.hs0000644000000000000000000000046607346545000021737 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.22.6/test/integration/testCommentLocation/0000755000000000000000000000000007346545000020734 5ustar0000000000000000doctest-0.22.6/test/integration/testCommentLocation/Foo.hs0000644000000000000000000000260307346545000022014 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.22.6/test/integration/testDocumentationForArguments/0000755000000000000000000000000007346545000023007 5ustar0000000000000000doctest-0.22.6/test/integration/testDocumentationForArguments/Fib.hs0000644000000000000000000000014607346545000024044 0ustar0000000000000000module Fib where fib :: Int -- ^ -- >>> 23 -- 23 -> Int fib _ = undefined doctest-0.22.6/test/integration/testFailOnMultiline/0000755000000000000000000000000007346545000020674 5ustar0000000000000000doctest-0.22.6/test/integration/testFailOnMultiline/Fib.hs0000644000000000000000000000034707346545000021734 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.22.6/test/integration/testImport/0000755000000000000000000000000007346545000017113 5ustar0000000000000000doctest-0.22.6/test/integration/testImport/ModuleA.hs0000644000000000000000000000007607346545000021000 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import ModuleB doctest-0.22.6/test/integration/testImport/ModuleB.hs0000644000000000000000000000023007346545000020771 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.22.6/test/integration/testPutStr/0000755000000000000000000000000007346545000017102 5ustar0000000000000000doctest-0.22.6/test/integration/testPutStr/Fib.hs0000644000000000000000000000032107346545000020132 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.22.6/test/integration/testSimple/0000755000000000000000000000000007346545000017072 5ustar0000000000000000doctest-0.22.6/test/integration/testSimple/Fib.hs0000644000000000000000000000023307346545000020124 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.22.6/test/integration/trailing-whitespace/0000755000000000000000000000000007346545000020704 5ustar0000000000000000doctest-0.22.6/test/integration/trailing-whitespace/Foo.hs0000644000000000000000000000014707346545000021765 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> putStrLn "foo " -- foo test :: a test = undefined doctest-0.22.6/test/integration/with-cbits/0000755000000000000000000000000007346545000017016 5ustar0000000000000000doctest-0.22.6/test/integration/with-cbits/Bar.hs0000644000000000000000000000020507346545000020053 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module Bar where import Foreign.C -- | -- >>> foo -- 23 foreign import ccall foo :: CInt doctest-0.22.6/test/integration/with-cbits/foo.c0000644000000000000000000000003307346545000017741 0ustar0000000000000000int foo() { return 23; } doctest-0.22.6/test/parse/multiple-examples/0000755000000000000000000000000007346545000017177 5ustar0000000000000000doctest-0.22.6/test/parse/multiple-examples/Foo.hs0000644000000000000000000000012107346545000020250 0ustar0000000000000000module Foo where -- | -- >>> foo -- 23 foo = 23 -- | -- >>> bar -- 42 bar = 42 doctest-0.22.6/test/parse/no-examples/0000755000000000000000000000000007346545000015760 5ustar0000000000000000doctest-0.22.6/test/parse/no-examples/Fib.hs0000644000000000000000000000020607346545000017012 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- @ -- some code -- @ -- -- foobar 23 fib :: Int -> Int -> Int fib _ = undefined doctest-0.22.6/test/parse/non-exported/0000755000000000000000000000000007346545000016152 5ustar0000000000000000doctest-0.22.6/test/parse/non-exported/Fib.hs0000644000000000000000000000035407346545000017210 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.22.6/test/parse/property/0000755000000000000000000000000007346545000015414 5ustar0000000000000000doctest-0.22.6/test/parse/property/Fib.hs0000644000000000000000000000026407346545000016452 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.22.6/test/parse/setup-empty/0000755000000000000000000000000007346545000016024 5ustar0000000000000000doctest-0.22.6/test/parse/setup-empty/Foo.hs0000644000000000000000000000013207346545000017077 0ustar0000000000000000module Foo where -- $setup -- some setup code -- | -- >>> foo -- 23 foo :: Int foo = 23 doctest-0.22.6/test/parse/setup-only/0000755000000000000000000000000007346545000015647 5ustar0000000000000000doctest-0.22.6/test/parse/setup-only/Foo.hs0000644000000000000000000000013207346545000016722 0ustar0000000000000000module Foo where -- $setup -- >>> foo -- 23 -- | some documentation foo :: Int foo = 23 doctest-0.22.6/test/parse/simple/0000755000000000000000000000000007346545000015021 5ustar0000000000000000doctest-0.22.6/test/parse/simple/Fib.hs0000644000000000000000000000027207346545000016056 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- -- >>> putStrLn "foo" -- foo -- >>> putStr "bar" -- bar -- -- >>> putStrLn "baz" -- baz fib :: Int -> Int -> Int fib _ = undefined