doctest-0.24.2/0000755000000000000000000000000007346545000011435 5ustar0000000000000000doctest-0.24.2/CHANGES.markdown0000644000000000000000000001363507346545000014261 0ustar0000000000000000Changes in 0.24.2 - Use `GHC.ResponseFile.expandResponse` Changes in 0.24.1 - Interpret GHC response files Changes in 0.24.0 - cabal-doctest: Add support for cabal-install 3.14.* Changes in 0.23.0 - Add `--fail-fast` Changes in 0.22.10 - Make progress reporting more robust Changes in 0.22.9 - Use `-fprint-error-index-links=never` for GHC `>=9.10` Changes in 0.22.8 - cabal-doctest: Fix handling of options with optional arguments Changes in 0.22.7 - cabal-doctest: Accept component - cabal-doctest: Get rid of separate `cabal build` step - cabal-doctest: Add support for `--list-options` Changes in 0.22.6 - cabal-doctest: Take `with-compiler:` from `cabal-project` into account - cabal-doctest: Add support for `--with-compiler` - cabal-doctest: Fix `ghc-pkg` discovery logic - cabal-doctest: Cache `doctest` executables Changes 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.24.2/LICENSE0000644000000000000000000000206707346545000012447 0ustar0000000000000000Copyright (c) 2009-2025 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.24.2/README.md0000644000000000000000000003676407346545000012734 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.24.2/Setup.lhs0000644000000000000000000000011407346545000013241 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain doctest-0.24.2/doctest.cabal0000644000000000000000000002075107346545000014073 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack name: doctest version: 0.24.2 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-2025 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/fail-fast/Bar.hs test/integration/fail-fast/Foo.hs test/integration/fail-fast/SetupBar.hs test/integration/fail-fast/SetupFoo.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 Cabal.ReplOptions Extract GhcUtil Imports Info Interpreter Language.Haskell.GhciWrapper Location Options PackageDBs Parse Property Run Runner Runner.Example Util Paths_doctest build-depends: base >=4.12 && <5 , code-page >=0.1 , containers , deepseq , directory , exceptions , filepath , ghc >=8.6 && <9.14 , ghc-paths >=0.1.0.9 , process , syb >=0.3 , temporary , 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.12 && <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.12 && <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 Cabal.ReplOptionsSpec ExtractSpec InfoSpec InterpreterSpec Language.Haskell.GhciWrapperSpec LocationSpec MainSpec OptionsSpec PackageDBsSpec ParseSpec PropertySpec Runner.ExampleSpec RunnerSpec RunSpec UtilSpec Cabal Cabal.Options Cabal.Paths Cabal.ReplOptions 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.12 && <5 , code-page >=0.1 , containers , deepseq , directory , exceptions , filepath , ghc >=8.6 && <9.14 , 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 , temporary , 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.24.2/driver/0000755000000000000000000000000007346545000012730 5ustar0000000000000000doctest-0.24.2/driver/cabal-doctest.hs0000644000000000000000000000030707346545000015771 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.24.2/driver/doctest.hs0000644000000000000000000000025107346545000014727 0ustar0000000000000000module Main (main) where import Prelude import Test.DocTest import System.Environment (getArgs) main :: IO () main = getArgs >>= doctest doctest-0.24.2/example/0000755000000000000000000000000007346545000013070 5ustar0000000000000000doctest-0.24.2/example/example.cabal0000644000000000000000000000056607346545000015516 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.24.2/example/src/0000755000000000000000000000000007346545000013657 5ustar0000000000000000doctest-0.24.2/example/src/Example.hs0000644000000000000000000000012507346545000015604 0ustar0000000000000000module Example where -- | -- >>> foo -- 23 foo = 23 -- | -- >>> bar -- 42 bar = 42 doctest-0.24.2/example/test/0000755000000000000000000000000007346545000014047 5ustar0000000000000000doctest-0.24.2/example/test/doctests.hs0000644000000000000000000000015307346545000016232 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["-isrc", "src/Example.hs"] doctest-0.24.2/src/0000755000000000000000000000000007346545000012224 5ustar0000000000000000doctest-0.24.2/src/Cabal.hs0000644000000000000000000000441607346545000013567 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} module Cabal (externalCommand) where import Imports import Data.List import Data.Version (makeVersion) import System.IO import System.IO.Temp import System.Environment 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 ] doesFileExist script >>= \ case True -> pass False -> writeFileAtomically script ":seti -w -Wdefault" callProcess doctest ["--version"] let repl extraArgs = call cabal ("repl" : "--build-depends=QuickCheck" : "--build-depends=template-haskell" : ("--repl-options=-ghci-script=" <> script) : args ++ extraArgs) case ghcVersion < makeVersion [9,4] of True -> do callProcess cabal ("build" : "--only-dependencies" : discardReplOptions args) repl ["--with-compiler", doctest, "--with-hc-pkg", ghcPkg] False -> do withSystemTempDirectory "cabal-doctest" $ \ dir -> do repl ["--keep-temp-files", "--repl-multi-file", dir] files <- filter (isSuffixOf "-inplace") <$> listDirectory dir options <- concat <$> mapM (fmap lines . readFile . combine dir) files call doctest ("--no-magic" : options) 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.24.2/src/Cabal/0000755000000000000000000000000007346545000013226 5ustar0000000000000000doctest-0.24.2/src/Cabal/Options.hs0000644000000000000000000000440207346545000015215 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Cabal.Options ( rejectUnsupportedOptions , discardReplOptions #ifdef TEST , replOnlyOptions #endif ) where import Imports import System.Exit import System.Console.GetOpt import Data.Set (Set) import qualified Data.Set as Set import qualified Cabal.ReplOptions as Repl replOnlyOptions :: Set String replOnlyOptions = Set.fromList [ "-z" , "--ignore-project" , "--repl-no-load" , "--repl-options" , "--repl-multi-file" , "-b" , "--build-depends" , "--no-transitive-deps" , "--enable-multi-repl" , "--disable-multi-repl" , "--keep-temp-files" ] rejectUnsupportedOptions :: [String] -> IO () rejectUnsupportedOptions args = case getOpt' Permute options args of (xs, _, _, _) | ListOptions `elem` xs -> do let names :: [String] names = concat [map (\ c -> ['-', c]) short ++ map ("--" <> ) long | Option short long _ _ <- documentedOptions] putStr (unlines names) exitSuccess (_, _, unsupported : _, _) -> do die $ "Error: cabal: unrecognized 'doctest' option `" <> unsupported <> "'" _ -> pass data Argument = Argument String (Maybe String) | ListOptions deriving (Eq, Show) options :: [OptDescr Argument] options = Option [] ["list-options"] (NoArg ListOptions) "" : documentedOptions documentedOptions :: [OptDescr Argument] documentedOptions = map toOptDescr Repl.options where toOptDescr :: Repl.Option -> OptDescr Argument toOptDescr (Repl.Option long short arg help) = Option (maybeToList short) [long] (toArgDescr long arg) help toArgDescr :: String -> Repl.Argument -> ArgDescr Argument toArgDescr long = \ case Repl.Argument name -> ReqArg (argument . Just) name Repl.NoArgument -> NoArg (argument Nothing) Repl.OptionalArgument name -> OptArg argument name where argument :: Maybe String -> Argument argument value = Argument ("--" <> long) value discardReplOptions :: [String] -> [String] discardReplOptions args = case getOpt Permute options args of (xs, _, _) -> [renderArgument name value | Argument name value <- xs, Set.notMember name replOnlyOptions] where renderArgument name = \ case Nothing -> name Just value -> name <> "=" <> value doctest-0.24.2/src/Cabal/Paths.hs0000644000000000000000000000553607346545000014652 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE StrictData #-} 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 { ghcVersion :: Version , 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" ghcVersionString <- strip <$> readProcess ghc ["--numeric-version"] "" ghcVersion <- case parseVersion ghcVersionString of Nothing -> die $ "Cannot determine GHC version from '" <> ghcVersionString <> "'." Just version -> return version let ghcPkg :: FilePath ghcPkg = takeDirectory ghc "ghc-pkg-" <> ghcVersionString #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-" <> ghcVersionString <> "-" <> abi createDirectoryIfMissing True cache return Paths { ghcVersion , 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 parseVersion :: String -> Maybe Version parseVersion = lookup "" . map swap . readP_to_S Version.parseVersion doctest-0.24.2/src/Cabal/ReplOptions.hs0000644000000000000000000005145407346545000016051 0ustar0000000000000000module Cabal.ReplOptions ( Option(..) , Argument(..) , options ) where import Imports data Option = Option { optionName :: String , optionShortName :: Maybe Char , optionArgument :: Argument , optionHelp :: String } deriving (Eq, Show) data Argument = Argument String | NoArgument | OptionalArgument String deriving (Eq, Show) options :: [Option] options = [ Option "help" (Just 'h') NoArgument "Show this help text" , Option "verbose" (Just 'v') (OptionalArgument "n") "Control verbosity (n is 0--3, default verbosity level is 1)" , Option "builddir" Nothing (Argument "DIR") "The directory where Cabal puts generated build files (default dist)" , Option "ghc" (Just 'g') NoArgument "compile with GHC" , Option "ghcjs" Nothing NoArgument "compile with GHCJS" , Option "uhc" Nothing NoArgument "compile with UHC" , Option "haskell-suite" Nothing NoArgument "compile with a haskell-suite compiler" , Option "with-compiler" (Just 'w') (Argument "PATH") "give the path to a particular compiler" , Option "with-hc-pkg" Nothing (Argument "PATH") "give the path to the package tool" , Option "prefix" Nothing (Argument "DIR") "bake this prefix in preparation of installation" , Option "bindir" Nothing (Argument "DIR") "installation directory for executables" , Option "libdir" Nothing (Argument "DIR") "installation directory for libraries" , Option "libsubdir" Nothing (Argument "DIR") "subdirectory of libdir in which libs are installed" , Option "dynlibdir" Nothing (Argument "DIR") "installation directory for dynamic libraries" , Option "libexecdir" Nothing (Argument "DIR") "installation directory for program executables" , Option "libexecsubdir" Nothing (Argument "DIR") "subdirectory of libexecdir in which private executables are installed" , Option "datadir" Nothing (Argument "DIR") "installation directory for read-only data" , Option "datasubdir" Nothing (Argument "DIR") "subdirectory of datadir in which data files are installed" , Option "docdir" Nothing (Argument "DIR") "installation directory for documentation" , Option "htmldir" Nothing (Argument "DIR") "installation directory for HTML documentation" , Option "haddockdir" Nothing (Argument "DIR") "installation directory for haddock interfaces" , Option "sysconfdir" Nothing (Argument "DIR") "installation directory for configuration files" , Option "program-prefix" Nothing (Argument "PREFIX") "prefix to be applied to installed executables" , Option "program-suffix" Nothing (Argument "SUFFIX") "suffix to be applied to installed executables" , Option "enable-library-vanilla" Nothing NoArgument "Enable Vanilla libraries" , Option "disable-library-vanilla" Nothing NoArgument "Disable Vanilla libraries" , Option "enable-library-profiling" (Just 'p') NoArgument "Enable Library profiling" , Option "disable-library-profiling" Nothing NoArgument "Disable Library profiling" , Option "enable-shared" Nothing NoArgument "Enable Shared library" , Option "disable-shared" Nothing NoArgument "Disable Shared library" , Option "enable-static" Nothing NoArgument "Enable Static library" , Option "disable-static" Nothing NoArgument "Disable Static library" , Option "enable-executable-dynamic" Nothing NoArgument "Enable Executable dynamic linking" , Option "disable-executable-dynamic" Nothing NoArgument "Disable Executable dynamic linking" , Option "enable-executable-static" Nothing NoArgument "Enable Executable fully static linking" , Option "disable-executable-static" Nothing NoArgument "Disable Executable fully static linking" , Option "enable-profiling" Nothing NoArgument "Enable Executable and library profiling" , Option "disable-profiling" Nothing NoArgument "Disable Executable and library profiling" , Option "enable-profiling-shared" Nothing NoArgument "Enable Build profiling shared libraries" , Option "disable-profiling-shared" Nothing NoArgument "Disable Build profiling shared libraries" , Option "enable-executable-profiling" Nothing NoArgument "Enable Executable profiling (DEPRECATED)" , Option "disable-executable-profiling" Nothing NoArgument "Disable Executable profiling (DEPRECATED)" , Option "profiling-detail" Nothing (Argument "level") "Profiling detail level for executable and library (default, none, exported-functions, toplevel-functions, all-functions, late)." , Option "library-profiling-detail" Nothing (Argument "level") "Profiling detail level for libraries only." , Option "enable-optimization" (Just 'O') (OptionalArgument "n") "Build with optimization (n is 0--2, default is 1)" , Option "disable-optimization" Nothing NoArgument "Build without optimization" , Option "enable-debug-info" Nothing (OptionalArgument "n") "Emit debug info (n is 0--3, default is 0)" , Option "disable-debug-info" Nothing NoArgument "Don't emit debug info" , Option "enable-build-info" Nothing NoArgument "Enable build information generation during project building" , Option "disable-build-info" Nothing NoArgument "Disable build information generation during project building" , Option "enable-library-for-ghci" Nothing NoArgument "Enable compile library for use with GHCi" , Option "disable-library-for-ghci" Nothing NoArgument "Disable compile library for use with GHCi" , Option "enable-split-sections" Nothing NoArgument "Enable compile library code such that unneeded definitions can be dropped from the final executable (GHC 7.8+)" , Option "disable-split-sections" Nothing NoArgument "Disable compile library code such that unneeded definitions can be dropped from the final executable (GHC 7.8+)" , Option "enable-split-objs" Nothing NoArgument "Enable split library into smaller objects to reduce binary sizes (GHC 6.6+)" , Option "disable-split-objs" Nothing NoArgument "Disable split library into smaller objects to reduce binary sizes (GHC 6.6+)" , Option "enable-executable-stripping" Nothing NoArgument "Enable strip executables upon installation to reduce binary sizes" , Option "disable-executable-stripping" Nothing NoArgument "Disable strip executables upon installation to reduce binary sizes" , Option "enable-library-stripping" Nothing NoArgument "Enable strip libraries upon installation to reduce binary sizes" , Option "disable-library-stripping" Nothing NoArgument "Disable strip libraries upon installation to reduce binary sizes" , Option "configure-option" Nothing (Argument "OPT") "Extra option for configure" , Option "user" Nothing NoArgument "Enable doing a per-user installation" , Option "global" Nothing NoArgument "Disable doing a per-user installation" , Option "package-db" Nothing (Argument "DB") "Append the given package database to the list of package databases used (to satisfy dependencies and register into). May be a specific file, 'global' or 'user'. The initial list is ['global'], ['global', 'user'], or ['global', $sandbox], depending on context. Use 'clear' to reset the list to empty. See the user guide for details." , Option "flags" (Just 'f') (Argument "FLAGS") "Force values for the given flags in Cabal conditionals in the .cabal file. E.g., --flags=\"debug -usebytestrings\" forces the flag \"debug\" to true and \"usebytestrings\" to false." , Option "extra-include-dirs" Nothing (Argument "PATH") "A list of directories to search for header files" , Option "enable-deterministic" Nothing NoArgument "Enable Try to be as deterministic as possible (used by the test suite)" , Option "disable-deterministic" Nothing NoArgument "Disable Try to be as deterministic as possible (used by the test suite)" , Option "ipid" Nothing (Argument "IPID") "Installed package ID to compile this package as" , Option "cid" Nothing (Argument "CID") "Installed component ID to compile this component as" , Option "extra-lib-dirs" Nothing (Argument "PATH") "A list of directories to search for external libraries" , Option "extra-lib-dirs-static" Nothing (Argument "PATH") "A list of directories to search for external libraries when linking fully static executables" , Option "extra-framework-dirs" Nothing (Argument "PATH") "A list of directories to search for external frameworks (OS X only)" , Option "extra-prog-path" Nothing (Argument "PATH") "A list of directories to search for required programs (in addition to the normal search locations)" , Option "instantiate-with" Nothing (Argument "NAME=MOD") "A mapping of signature names to concrete module instantiations." , Option "enable-tests" Nothing NoArgument "Enable dependency checking and compilation for test suites listed in the package description file." , Option "disable-tests" Nothing NoArgument "Disable dependency checking and compilation for test suites listed in the package description file." , Option "enable-coverage" Nothing NoArgument "Enable build package with Haskell Program Coverage. (GHC only)" , Option "disable-coverage" Nothing NoArgument "Disable build package with Haskell Program Coverage. (GHC only)" , Option "enable-library-coverage" Nothing NoArgument "Enable build package with Haskell Program Coverage. (GHC only) (DEPRECATED)" , Option "disable-library-coverage" Nothing NoArgument "Disable build package with Haskell Program Coverage. (GHC only) (DEPRECATED)" , Option "enable-benchmarks" Nothing NoArgument "Enable dependency checking and compilation for benchmarks listed in the package description file." , Option "disable-benchmarks" Nothing NoArgument "Disable dependency checking and compilation for benchmarks listed in the package description file." , Option "enable-relocatable" Nothing NoArgument "Enable building a package that is relocatable. (GHC only)" , Option "disable-relocatable" Nothing NoArgument "Disable building a package that is relocatable. (GHC only)" , Option "disable-response-files" Nothing NoArgument "enable workaround for old versions of programs like \"ar\" that do not support @file arguments" , Option "allow-depending-on-private-libs" Nothing NoArgument "Allow depending on private libraries. If set, the library visibility check MUST be done externally." , Option "coverage-for" Nothing (Argument "UNITID") "A list of unit-ids of libraries to include in the Haskell Program Coverage report." , Option "ignore-build-tools" Nothing NoArgument "Ignore build tool dependencies. If set, declared build tools needn't be found for compilation to proceed." , Option "cabal-lib-version" Nothing (Argument "VERSION") "Select which version of the Cabal lib to use to build packages (useful for testing)." , Option "enable-append" Nothing NoArgument "Enable appending the new config to the old config file" , Option "disable-append" Nothing NoArgument "Disable appending the new config to the old config file" , Option "enable-backup" Nothing NoArgument "Enable the backup of the config file before any alterations" , Option "disable-backup" Nothing NoArgument "Disable the backup of the config file before any alterations" , Option "constraint" (Just 'c') (Argument "CONSTRAINT") "Specify constraints on a package (version, installed/source, flags)" , Option "preference" Nothing (Argument "CONSTRAINT") "Specify preferences (soft constraints) on the version of a package" , Option "solver" Nothing (Argument "SOLVER") "Select dependency solver to use (default: modular). Choices: modular." , Option "allow-older" Nothing (OptionalArgument "DEPS") "Ignore lower bounds in all dependencies or DEPS" , Option "allow-newer" Nothing (OptionalArgument "DEPS") "Ignore upper bounds in all dependencies or DEPS" , Option "write-ghc-environment-files" Nothing (Argument "always|never|ghc8.4.4+") "Whether to create a .ghc.environment file after a successful build (v2-build only)" , Option "enable-documentation" Nothing NoArgument "Enable building of documentation" , Option "disable-documentation" Nothing NoArgument "Disable building of documentation" , Option "doc-index-file" Nothing (Argument "TEMPLATE") "A central index of haddock API documentation (template cannot use $pkgid)" , Option "dry-run" Nothing NoArgument "Do not install anything, only print what would be installed." , Option "only-download" Nothing NoArgument "Do not build anything, only fetch the packages." , Option "max-backjumps" Nothing (Argument "NUM") "Maximum number of backjumps allowed while solving (default: 4000). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely." , Option "reorder-goals" Nothing NoArgument "Try to reorder goals according to certain heuristics. Slows things down on average, but may make backtracking faster for some packages." , Option "count-conflicts" Nothing NoArgument "Try to speed up solving by preferring goals that are involved in a lot of conflicts (default)." , Option "fine-grained-conflicts" Nothing NoArgument "Skip a version of a package if it does not resolve the conflicts encountered in the last version, as a solver optimization (default)." , Option "minimize-conflict-set" Nothing NoArgument "When there is no solution, try to improve the error message by finding a minimal conflict set (default: false). May increase run time significantly." , Option "independent-goals" Nothing NoArgument "Treat several goals on the command line as independent. If several goals depend on the same package, different versions can be chosen." , Option "prefer-oldest" Nothing NoArgument "Prefer the oldest (instead of the latest) versions of packages available. Useful to determine lower bounds in the build-depends section." , Option "shadow-installed-packages" Nothing NoArgument "If multiple package instances of the same version are installed, treat all but one as shadowed." , Option "strong-flags" Nothing NoArgument "Do not defer flag choices (this used to be the default in cabal-install <= 1.20)." , Option "allow-boot-library-installs" Nothing NoArgument "Allow cabal to install base, ghc-prim, integer-simple, integer-gmp, and template-haskell." , Option "reject-unconstrained-dependencies" Nothing (Argument "none|all") "Require these packages to have constraints on them if they are to be selected (default: none)." , Option "reinstall" Nothing NoArgument "Install even if it means installing the same version again." , Option "avoid-reinstalls" Nothing NoArgument "Do not select versions that would destructively overwrite installed packages." , Option "force-reinstalls" Nothing NoArgument "Reinstall packages even if they will most likely break other installed packages." , Option "upgrade-dependencies" Nothing NoArgument "Pick the latest version for all dependencies, rather than trying to pick an installed version." , Option "only-dependencies" Nothing NoArgument "Install only the dependencies necessary to build the given packages" , Option "dependencies-only" Nothing NoArgument "A synonym for --only-dependencies" , Option "index-state" Nothing (Argument "STATE") "Use source package index state as it existed at a previous time. Accepts unix-timestamps (e.g. '@1474732068'), ISO8601 UTC timestamps (e.g. '2016-09-24T17:47:48Z'), or 'HEAD' (default: 'HEAD')." , Option "root-cmd" Nothing (Argument "COMMAND") "(No longer supported, do not use.)" , Option "build-summary" Nothing (Argument "TEMPLATE") "Save build summaries to file (name template can use $pkgid, $compiler, $os, $arch)" , Option "build-log" Nothing (Argument "TEMPLATE") "Log all builds to file (name template can use $pkgid, $compiler, $os, $arch)" , Option "remote-build-reporting" Nothing (Argument "LEVEL") "Generate build reports to send to a remote server (none, anonymous or detailed)." , Option "report-planning-failure" Nothing NoArgument "Generate build reports when the dependency solver fails. This is used by the Hackage build bot." , Option "enable-per-component" Nothing NoArgument "Enable Per-component builds when possible" , Option "disable-per-component" Nothing NoArgument "Disable Per-component builds when possible" , Option "run-tests" Nothing NoArgument "Run package test suites during installation." , Option "semaphore" Nothing NoArgument "Use a semaphore so GHC can compile components in parallel" , Option "jobs" (Just 'j') (OptionalArgument "NUM") "Run NUM jobs simultaneously (or '$ncpus' if no NUM is given)." , Option "keep-going" Nothing NoArgument "After a build failure, continue to build other unaffected packages." , Option "offline" Nothing NoArgument "Don't download packages from the Internet." , Option "haddock-hoogle" Nothing NoArgument "Generate a hoogle database" , Option "haddock-html" Nothing NoArgument "Generate HTML documentation (the default)" , Option "haddock-html-location" Nothing (Argument "URL") "Location of HTML documentation for pre-requisite packages" , Option "haddock-for-hackage" Nothing NoArgument "Collection of flags to generate documentation suitable for upload to hackage" , Option "haddock-executables" Nothing NoArgument "Run haddock for Executables targets" , Option "haddock-tests" Nothing NoArgument "Run haddock for Test Suite targets" , Option "haddock-benchmarks" Nothing NoArgument "Run haddock for Benchmark targets" , Option "haddock-all" Nothing NoArgument "Run haddock for all targets" , Option "haddock-internal" Nothing NoArgument "Run haddock for internal modules and include all symbols" , Option "haddock-css" Nothing (Argument "PATH") "Use PATH as the haddock stylesheet" , Option "haddock-hyperlink-source" Nothing NoArgument "Hyperlink the documentation to the source code" , Option "haddock-quickjump" Nothing NoArgument "Generate an index for interactive documentation navigation" , Option "haddock-hscolour-css" Nothing (Argument "PATH") "Use PATH as the HsColour stylesheet" , Option "haddock-contents-location" Nothing (Argument "URL") "Bake URL in as the location for the contents page" , Option "haddock-base-url" Nothing (Argument "URL") "Base URL for static files." , Option "haddock-resources-dir" Nothing (Argument "DIR") "location of Haddocks static / auxiliary files" , Option "haddock-output-dir" Nothing (Argument "DIR") "Generate haddock documentation into this directory. This flag is provided as a technology preview and is subject to change in the next releases." , Option "haddock-use-unicode" Nothing NoArgument "Pass --use-unicode option to haddock" , Option "test-log" Nothing (Argument "TEMPLATE") "Log all test suite results to file (name template can use $pkgid, $compiler, $os, $arch, $test-suite, $result)" , Option "test-machine-log" Nothing (Argument "TEMPLATE") "Produce a machine-readable log file (name template can use $pkgid, $compiler, $os, $arch, $result)" , Option "test-show-details" Nothing (Argument "FILTER") "'always': always show results of individual test cases. 'never': never show results of individual test cases. 'failures': show results of failing test cases. 'streaming': show results of test cases in real time.'direct': send results of test cases in real time; no log file." , Option "test-keep-tix-files" Nothing NoArgument "keep .tix files for HPC between test runs" , Option "test-wrapper" Nothing (Argument "FILE") "Run test through a wrapper." , Option "test-fail-when-no-test-suites" Nothing NoArgument "Exit with failure when no test suites are found." , Option "test-options" Nothing (Argument "TEMPLATES") "give extra options to test executables (name templates can use $pkgid, $compiler, $os, $arch, $test-suite)" , Option "test-option" Nothing (Argument "TEMPLATE") "give extra option to test executables (no need to quote options containing spaces, name template can use $pkgid, $compiler, $os, $arch, $test-suite)" , Option "benchmark-options" Nothing (Argument "TEMPLATES") "give extra options to benchmark executables (name templates can use $pkgid, $compiler, $os, $arch, $benchmark)" , Option "benchmark-option" Nothing (Argument "TEMPLATE") "give extra option to benchmark executables (no need to quote options containing spaces, name template can use $pkgid, $compiler, $os, $arch, $benchmark)" , Option "project-dir" Nothing (Argument "DIR") "Set the path of the project directory" , Option "project-file" Nothing (Argument "FILE") "Set the path of the cabal.project file (relative to the project directory when relative)" , Option "ignore-project" (Just 'z') NoArgument "Ignore local project configuration (unless --project-dir or --project-file is also set)" , Option "repl-no-load" Nothing NoArgument "Disable loading of project modules at REPL startup." , Option "repl-options" Nothing (Argument "FLAG") "Use the option(s) for the repl" , Option "repl-multi-file" Nothing (Argument "DIR") "Write repl options to this directory rather than starting repl mode" , Option "build-depends" (Just 'b') (Argument "DEPENDENCIES") "Include additional packages in the environment presented to GHCi." , Option "no-transitive-deps" Nothing NoArgument "Don't automatically include transitive dependencies of requested packages." , Option "enable-multi-repl" Nothing NoArgument "Enable multi-component repl sessions" , Option "disable-multi-repl" Nothing NoArgument "Disable multi-component repl sessions" , Option "keep-temp-files" Nothing NoArgument "Keep temporary files" ] doctest-0.24.2/src/Extract.hs0000644000000000000000000002274407346545000014203 0ustar0000000000000000{-# LANGUAGE CPP #-} module Extract (Module(..), extract) where import Imports hiding (mod, concat) 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 import System.Posix.Internals (c_getpid) import GhcUtil (withGhc) import Location hiding (unLoc) import Util (convertDosLineEndings) import PackageDBs (getPackageDBArgs) #if __GLASGOW_HASKELL__ < 900 import DynamicLoading (initializePlugins) #else import GHC.Runtime.Loader (initializePlugins) #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 #if __GLASGOW_HASKELL__ < 912 deriving Typeable #endif 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` () -- | 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] } -- 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 -- | 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 | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source) ] 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. DocD _ x -> 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__ < 901 locA :: SrcSpan -> SrcSpan locA = id #endif doctest-0.24.2/src/GhcUtil.hs0000644000000000000000000000416307346545000014123 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) -- 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] handleStaticFlags flags = return $ map noLoc $ flags 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.24.2/src/Imports.hs0000644000000000000000000000166007346545000014220 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Imports (module Imports) where import Prelude as Imports import Data.Monoid as Imports import Data.Maybe as Imports import Control.Monad as Imports hiding (forM_) import Control.Exception as Imports import Data.Foldable as Imports (forM_) import Control.Arrow as Imports import Data.Char import System.Exit import System.Process import Data.Functor as Imports ((<&>)) pass :: Monad m => m () pass = return () equals :: Eq a => a -> a -> Bool equals = (==) strip :: String -> String strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace call :: FilePath -> [FilePath] -> IO () call name args = rawSystem name args >>= \ case ExitSuccess -> pass err -> exitWith err exec :: FilePath -> [FilePath] -> IO () exec name args = rawSystem name args >>= exitWith doctest-0.24.2/src/Info.hs0000644000000000000000000000216207346545000013454 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.24.2/src/Interpreter.hs0000644000000000000000000000503307346545000015064 0ustar0000000000000000{-# LANGUAGE CPP #-} module Interpreter ( Interpreter , PreserveIt(..) , safeEval , safeEvalWith , withInterpreter , ghc , interpreterSupported -- exported for testing , ghcInfo , haveInterpreterKey , filterExpression ) where import Imports import System.Process import System.Directory (getPermissions, executable) 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 , "-fdiagnostics-color=never" , "-fno-diagnostics-show-caret" #if __GLASGOW_HASKELL__ >= 810 && __GLASGOW_HASKELL__ < 904 , "-Wno-unused-packages" #endif #if __GLASGOW_HASKELL__ >= 910 , "-fprint-error-index-links=never" #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 = safeEvalWith NoPreserveIt safeEvalWith :: PreserveIt -> Interpreter -> String -> IO (Either String String) safeEvalWith preserveIt repl = either (return . Left) (fmap Right . evalWith preserveIt 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" 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.24.2/src/Language/Haskell/0000755000000000000000000000000007346545000015332 5ustar0000000000000000doctest-0.24.2/src/Language/Haskell/GhciWrapper.hs0000644000000000000000000001211207346545000020076 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} module Language.Haskell.GhciWrapper ( Interpreter , Config(..) , defaultConfig , PreserveIt(..) , new , close , eval , evalWith , evalEcho ) where import Imports import System.IO hiding (stdin, stdout, stderr) import System.Process import System.Exit 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 } data PreserveIt = NoPreserveIt | PreserveIt deriving Eq -- | 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 -> PreserveIt -> String -> IO () putExpression Interpreter{hIn = stdin} (equals PreserveIt -> 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 = evalWith NoPreserveIt -- | Like 'eval', but try to preserve the @it@ variable evalWith :: PreserveIt -> Interpreter -> String -> IO String evalWith preserveIt repl expr = do putExpression repl preserveIt expr getResult False repl -- | Evaluate an expression evalEcho :: Interpreter -> String -> IO String evalEcho repl expr = do putExpression repl NoPreserveIt expr getResult True repl doctest-0.24.2/src/Location.hs0000644000000000000000000000413707346545000014335 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.24.2/src/Options.hs0000644000000000000000000001106507346545000014216 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 | --fail-fast | --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" , " --fail-fast abort on first failure" , " --no-magic disable magic mode" , " --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 , failFast :: Bool , verbose :: Bool , repl :: (String, [String]) } deriving (Eq, Show) defaultConfig :: Config defaultConfig = Config { ghcOptions = [] , fastMode = False , preserveIt = False , failFast = 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 } } setFailFastMode :: Bool -> Run -> Run setFailFastMode failFast run@Run{..} = run { runConfig = runConfig { failFast } } 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 "--fail-fast" (setFailFastMode 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.24.2/src/PackageDBs.hs0000644000000000000000000000345507346545000014513 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.24.2/src/Parse.hs0000644000000000000000000001312607346545000013635 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 doctest-0.24.2/src/Property.hs0000644000000000000000000000432107346545000014404 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.24.2/src/Run.hs0000644000000000000000000001151307346545000013325 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Run ( doctest , doctestWithRepl , Config(..) , defaultConfig , doctestWith , Result , Summary(..) , formatSummary , isSuccess , evaluateResult , doctestWithResult , runDocTests #ifdef TEST , expandDirs #endif ) where import Imports import GHC.ResponseFile (expandResponse) 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 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 = expandResponse >=> \ args0 -> case parseOptions args0 of Options.ProxyToGhc args -> exec Interpreter.ghc args 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 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 (if fastMode then FastMode else NoFastMode) (if preserveIt then PreserveIt else NoPreserveIt) (if failFast then FailFast else NoFailFast) (if verbose then Verbose else NonVerbose) interpreter modules doctest-0.24.2/src/Runner.hs0000644000000000000000000002022007346545000014025 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Runner ( runModules , FastMode(..) , PreserveIt(..) , FailFast(..) , Verbose(..) , Summary(..) , isSuccess , formatSummary #ifdef TEST , Report , ReportState(..) , runReport , Interactive(..) , report , reportTransient #endif ) where import Prelude () import Imports hiding (putStr, putStrLn, error) import Text.Printf (printf) import System.IO hiding (putStr, putStrLn) import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Control.Monad.Trans.State (StateT, evalStateT) import qualified Control.Monad.Trans.State as State import Control.Monad.IO.Class import Data.IORef import Interpreter (Interpreter, PreserveIt(..), safeEvalWith) 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 instance Show Summary where show = formatSummary isSuccess :: Summary -> Bool isSuccess s = sErrors s == 0 && sFailures s == 0 formatSummary :: Summary -> String formatSummary (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 instance Semigroup Summary where Summary x1 x2 x3 x4 <> Summary y1 y2 y3 y4 = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4) withLineBuffering :: Handle -> IO c -> IO c withLineBuffering h action = bracket (hGetBuffering h) (hSetBuffering h) $ \ _ -> do hSetBuffering h LineBuffering action -- | Run all examples from a list of modules. runModules :: FastMode -> PreserveIt -> FailFast -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary runModules fastMode preserveIt failFast verbose repl modules = withLineBuffering stderr $ do interactive <- hIsTerminalDevice stderr <&> \ case False -> NonInteractive True -> Interactive summary <- newIORef mempty {sExamples = n} let reportFinalResult :: IO () reportFinalResult = do final <- readIORef summary hPutStrLn stderr (formatSummary final) run :: IO () run = runReport (ReportState interactive failFast verbose summary) $ do reportProgress forM_ modules $ runModule fastMode preserveIt repl verboseReport "# Final summary:" run `finally` reportFinalResult readIORef summary where n :: Int n = sum (map countExpressions modules) countExpressions :: Module [Located DocTest] -> Int countExpressions (Module _ setup tests) = sum (map length tests) + maybe 0 length setup type Report = MaybeT (StateT ReportState IO) data Interactive = NonInteractive | Interactive data FastMode = NoFastMode | FastMode data FailFast = NoFailFast | FailFast data Verbose = NonVerbose | Verbose data ReportState = ReportState { reportStateInteractive :: Interactive , reportStateFailFast :: FailFast , reportStateVerbose :: Verbose , reportStateSummary :: IORef Summary } runReport :: ReportState -> Report () -> IO () runReport st = void . flip evalStateT st . runMaybeT getSummary :: Report Summary getSummary = gets reportStateSummary >>= liftIO . readIORef gets :: (ReportState -> a) -> Report a gets = lift . State.gets -- | Add output to the report. report :: String -> Report () report = liftIO . hPutStrLn stderr -- | Add intermediate output to the report. -- -- This will be overwritten by subsequent calls to `report`/`report_`. -- Intermediate out may not contain any newlines. reportTransient :: String -> Report () reportTransient msg = gets reportStateInteractive >>= \ case NonInteractive -> pass Interactive -> liftIO $ do hPutStr stderr msg hFlush stderr hPutStr stderr $ '\r' : (replicate (length msg) ' ') ++ "\r" -- | Run all examples from given module. runModule :: FastMode -> PreserveIt -> Interpreter -> Module [Located DocTest] -> Report () runModule fastMode preserveIt repl (Module module_ setup examples) = do Summary _ _ e0 f0 <- getSummary forM_ setup $ runTestGroup preserveIt repl reload Summary _ _ e1 f1 <- getSummary -- 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 case fastMode of NoFastMode -> void $ Interpreter.safeEval repl ":reload" FastMode -> pass void $ Interpreter.safeEval repl $ ":m *" ++ module_ case preserveIt of NoPreserveIt -> pass PreserveIt -> do -- Evaluate a dumb expression to populate the 'it' variable. -- -- NOTE: This is one reason why we cannot just always use PreserveIt: -- '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 msg = gets reportStateVerbose >>= \ case NonVerbose -> pass Verbose -> report msg updateSummary :: Summary -> Report () updateSummary summary = do ref <- gets reportStateSummary liftIO $ modifyIORef' ref $ mappend summary reportProgress gets reportStateFailFast >>= \ case NoFailFast -> pass FailFast -> unless (isSuccess summary) abort abort :: Report () abort = MaybeT $ return Nothing reportProgress :: Report () reportProgress = gets reportStateVerbose >>= \ case NonVerbose -> do summary <- getSummary reportTransient (formatSummary summary) Verbose -> pass -- | 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 :: PreserveIt -> Interpreter -> IO () -> [Located DocTest] -> Report () runTestGroup preserveIt repl setup tests = do 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 :: PreserveIt -> 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 () doctest-0.24.2/src/Runner/0000755000000000000000000000000007346545000013475 5ustar0000000000000000doctest-0.24.2/src/Runner/Example.hs0000644000000000000000000001254607346545000015434 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.24.2/src/Test/0000755000000000000000000000000007346545000013143 5ustar0000000000000000doctest-0.24.2/src/Test/DocTest.hs0000644000000000000000000000011107346545000015035 0ustar0000000000000000module Test.DocTest ( doctest ) where import Test.DocTest.Internal.Run doctest-0.24.2/src/Test/DocTest/Internal/0000755000000000000000000000000007346545000016264 5ustar0000000000000000doctest-0.24.2/src/Test/DocTest/Internal/Cabal.hs0000644000000000000000000000024707346545000017625 0ustar0000000000000000module Test.DocTest.Internal.Cabal ( doctest ) where import Imports import qualified Cabal doctest :: [String] -> IO () doctest = Cabal.externalCommand doctest-0.24.2/src/Test/DocTest/Internal/Extract.hs0000644000000000000000000000011707346545000020231 0ustar0000000000000000module Test.DocTest.Internal.Extract ( module Extract ) where import Extract doctest-0.24.2/src/Test/DocTest/Internal/Location.hs0000644000000000000000000000012207346545000020363 0ustar0000000000000000module Test.DocTest.Internal.Location ( module Location ) where import Location doctest-0.24.2/src/Test/DocTest/Internal/Parse.hs0000644000000000000000000000011107346545000017663 0ustar0000000000000000module Test.DocTest.Internal.Parse ( module Parse ) where import Parse doctest-0.24.2/src/Test/DocTest/Internal/Run.hs0000644000000000000000000000010307346545000017356 0ustar0000000000000000module Test.DocTest.Internal.Run ( module Run ) where import Run doctest-0.24.2/src/Util.hs0000644000000000000000000000134607346545000013501 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.24.2/test/Cabal/0000755000000000000000000000000007346545000013416 5ustar0000000000000000doctest-0.24.2/test/Cabal/OptionsSpec.hs0000644000000000000000000000437207346545000016226 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 Data.Set ((\\)) import qualified Data.Set as Set import qualified Cabal.ReplOptionsSpec as Repl import Cabal.Options spec :: Spec spec = do describe "replOnlyOptions" $ 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"] "" Set.toList replOnlyOptions `shouldMatchList` Set.toList (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" $ call "cabal" ["repl", "--installdir"] #endif shouldFail "doctest" $ rejectUnsupportedOptions ["--installdir"] context "with --list-options" $ do it "lists supported command-line options" $ do repl <- Set.fromList . lines <$> readProcess "cabal" ["repl", "--list-options"] "" doctest <- Set.fromList . lines <$> capture_ (rejectUnsupportedOptions ["--list-options"] `shouldThrow` (== ExitSuccess)) Set.toList (doctest \\ repl) `shouldMatchList` [] Set.toList (repl \\ doctest) `shouldMatchList` Set.toList Repl.unsupported describe "discardReplOptions" $ do it "discards 'cabal repl'-only options" $ do discardReplOptions [ "-w", "ghc-9.10" , "--build-depends=foo" , "--build-depends", "foo" , "-bfoo" , "-b", "foo" , "--disable-optimization" , "--enable-multi-repl" , "--repl-options", "foo" , "--repl-options=foo" , "--allow-newer" ] `shouldBe` ["--with-compiler=ghc-9.10", "--disable-optimization", "--allow-newer"] doctest-0.24.2/test/Cabal/PathsSpec.hs0000644000000000000000000000111707346545000015644 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.24.2/test/Cabal/ReplOptionsSpec.hs0000644000000000000000000000641707346545000017053 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} module Cabal.ReplOptionsSpec (spec, unsupported) where import Imports import Test.Hspec import Data.List import System.Process import Data.Set (Set) import qualified Data.Set as Set import Cabal.ReplOptions phony :: [String] phony = [ "with-PROG" , "PROG-option" , "PROG-options" ] undocumented :: Set String undocumented = Set.fromList [ "--enable-optimisation" , "--disable-optimisation" , "--haddock-hyperlink-sources" , "--haddock-hyperlinked-source" ] unsupported :: Set String unsupported = undocumented <> Set.fromList (map ("--" <>) phony) spec :: Spec spec = do describe "options" $ do it "is the list of documented 'repl' options" $ do documentedOptions <- parseOptions <$> readProcess "cabal" ["help", "repl"] "" options `shouldBe` filter (optionName >>> (`notElem` phony)) documentedOptions it "is consistent with 'cabal repl --list-options'" $ do let optionNames :: Option -> [String] optionNames option = reverse $ "--" <> optionName option : case optionShortName option of Nothing -> [] Just c -> [['-', c]] repl <- filter (`Set.notMember` unsupported) . lines <$> readProcess "cabal" ["repl", "--list-options"] "" concatMap optionNames options `shouldBe` repl parseOptions :: String -> [Option] parseOptions = map parseOption . takeOptions where parseOption :: String -> Option parseOption input = case input of longAndHelp@('-':'-':_) -> parseLongOption Nothing longAndHelp '-':short:',':' ':longAndHelp -> parseLongOption (Just short) longAndHelp '-':short:'[':(breakOn ']' -> (_arg, ']':',':' ':longAndHelp)) -> parseLongOption (Just short) longAndHelp '-':short:' ':(breakOn ' ' -> (arg, ' ':'o':'r':' ':(stripPrefix ('-':short:arg) -> Just (',':' ':longAndHelp)))) -> parseLongOption (Just short) longAndHelp _ -> err where parseLongOption :: Maybe Char -> String -> Option parseLongOption short longAndHelp = case breakOnAny " [=" longAndHelp of ('-':'-':long, ' ':help) -> accept long NoArgument help ('-':'-':long, '[':'=': (breakOn ']' -> (arg, ']':help))) -> accept long (OptionalArgument arg) help ('-':'-':long, '=':(breakOn ' ' -> (arg, ' ':help))) -> accept long (Argument arg) help _ -> err where accept :: String -> Argument -> String -> Option accept long arg help = Option long short arg (strip help) err :: HasCallStack => Option err = error input breakOn c = break (== c) breakOnAny xs = break (`elem` xs) takeOptions :: String -> [String] takeOptions input = map strip . joinLines $ case break (== "Flags for repl:") (lines input) of (_, "Flags for repl:" : xs) -> case break (== "") xs of (ys, "" : _) -> ys _ -> undefined _ -> undefined joinLines :: [String] -> [String] joinLines = go where go = \ case x : y : ys | isOption y -> x : go (y : ys) x : y : ys -> go $ (x ++ ' ' : strip y) : ys x : xs -> x : xs [] -> [] isOption = isPrefixOf " -" doctest-0.24.2/test/0000755000000000000000000000000007346545000012414 5ustar0000000000000000doctest-0.24.2/test/ExtractSpec.hs0000644000000000000000000000774407346545000015211 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.24.2/test/InfoSpec.hs0000644000000000000000000000055607346545000014464 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.24.2/test/InterpreterSpec.hs0000644000000000000000000000305507346545000016071 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.24.2/test/Language/Haskell/0000755000000000000000000000000007346545000015522 5ustar0000000000000000doctest-0.24.2/test/Language/Haskell/GhciWrapperSpec.hs0000644000000000000000000001132307346545000021104 0ustar0000000000000000{-# LANGUAGE CPP #-} module Language.Haskell.GhciWrapperSpec (main, spec) where import Imports import Test.Hspec import System.IO.Silently import Data.List import Language.Haskell.GhciWrapper (Interpreter, Config(..), defaultConfig, PreserveIt(..)) 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 "evalWith" $ do context "with PreserveIt" $ do it "preserves it" $ do withInterpreterConfig defaultConfig [] $ \ghci -> do Interpreter.evalWith PreserveIt 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` "" #if __GLASGOW_HASKELL__ >= 912 ghci "throwIO DivideByZero" `shouldReturn` "*** Exception: divide by zero\n\nHasCallStack backtrace:\n throwIO, called at :25:1 in interactive:Ghci22\n\n" #else ghci "throwIO DivideByZero" `shouldReturn` "*** Exception: divide by zero\n" #endif 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 ghci "foo" >>= (`shouldSatisfy` isInfixOf "Variable not in scope: foo") 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.24.2/test/LocationSpec.hs0000644000000000000000000000304307346545000015333 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.24.2/test/MainSpec.hs0000644000000000000000000001512607346545000014454 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} module MainSpec (main, spec) where import Imports import Test.Hspec import Test.HUnit (assertEqual, Assertion) import System.Directory (getCurrentDirectory, setCurrentDirectory) import System.FilePath import Run hiding (doctest, doctestWith) import System.IO.Silently import System.IO withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory workingDir action = do bracket getCurrentDirectory setCurrentDirectory $ \_ -> do setCurrentDirectory workingDir action doctest :: HasCallStack => FilePath -> [String] -> Summary -> Assertion doctest = doctestWith False False doctestWithPreserveIt :: HasCallStack => FilePath -> [String] -> Summary -> Assertion doctestWithPreserveIt = doctestWith True False doctestWithFailFast :: HasCallStack => FilePath -> [String] -> Summary -> Assertion doctestWithFailFast = doctestWith False True doctestWith :: HasCallStack => Bool -> Bool -> FilePath -> [String] -> Summary -> Assertion doctestWith preserveIt failFast workingDir ghcOptions expected = do actual <- withCurrentDirectory ("test/integration" workingDir) (hSilence [stderr] $ doctestWithResult defaultConfig {ghcOptions, preserveIt, failFast}) assertEqual label (formatSummary expected) (formatSummary 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 "." ["it/Foo.hs"] (cases 5) it "it-variable in $setup" $ do doctestWithPreserveIt "." ["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" $ do doctest "." ["failing-multiple/Foo.hs"] (cases 4) {sTried = 2, sFailures = 1} context "without --fail-fast" $ do it "continuous even if some tests fail" $ do doctest "fail-fast" ["Foo.hs"] (cases 4) {sTried = 4, sFailures = 1} context "with --fail-fast" $ do it "stops after the first failure" $ do doctestWithFailFast "fail-fast" ["Foo.hs"] (cases 4) {sTried = 2, sFailures = 1} it "stops after failures in $setup" $ do doctestWithFailFast "fail-fast" ["SetupFoo.hs"] (cases 6) {sTried = 1, 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.24.2/test/OptionsSpec.hs0000644000000000000000000000733307346545000015224 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 "enables 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 describe "--fail-fast" $ do context "without --fail-fast" $ do it "disables fail-fast mode" $ do failFast . runConfig <$> parseOptions [] `shouldBe` Result False context "with --fail-fast" $ do it "enables fail-fast mode" $ do failFast . runConfig <$> parseOptions ["--fail-fast"] `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.24.2/test/PackageDBsSpec.hs0000644000000000000000000000227407346545000015514 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.24.2/test/ParseSpec.hs0000644000000000000000000001346007346545000014641 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.24.2/test/PropertySpec.hs0000644000000000000000000001232207346545000015407 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.24.2/test/RunSpec.hs0000644000000000000000000001427007346545000014333 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 System.IO.Temp (withSystemTempDirectory) 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 verboseFibOutput :: String verboseFibOutput = unlines [ "### Started execution at test/integration/testSimple/Fib.hs:5." , "### example:" , "fib 10" , "### Successful!" , "" , "# Final summary:" , "Examples: 1 Tried: 1 Errors: 0 Failures: 0" ] 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 "interprets GHC response files" $ do withSystemTempDirectory "hspec" $ \ dir -> do let file = dir "response-file" writeFile file $ unlines [ "--verbose" , "test/integration/testSimple/Fib.hs" ] (r, ()) <- hCapture [stderr] $ doctest ['@':file] removeLoadedPackageEnvironment r `shouldBe` verboseFibOutput it "prints verbose description of a specification" $ do (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/testSimple/Fib.hs"] removeLoadedPackageEnvironment r `shouldBe` verboseFibOutput 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.24.2/test/Runner/0000755000000000000000000000000007346545000013665 5ustar0000000000000000doctest-0.24.2/test/Runner/ExampleSpec.hs0000644000000000000000000001303407346545000016430 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.24.2/test/RunnerSpec.hs0000644000000000000000000000234607346545000015041 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module RunnerSpec (spec) where import Imports import Test.Hspec import Data.IORef import System.IO import System.IO.Silently (hCapture_) import Runner capture :: Interactive -> Report () -> IO String capture interactive action = do ref <- newIORef mempty hCapture_ [stderr] (runReport (ReportState interactive NoFailFast NonVerbose ref) action) spec :: Spec spec = do describe "report" $ do context "when mode is interactive" $ do it "writes to stderr" $ do capture Interactive $ do report "foobar" `shouldReturn` "foobar\n" context "when mode is non-interactive" $ do it "writes to stderr" $ do capture NonInteractive $ do report "foobar" `shouldReturn` "foobar\n" describe "report_" $ do context "when mode is interactive" $ do it "writes transient output to stderr" $ do capture Interactive $ do reportTransient "foobar" `shouldReturn` "foobar\r \r" context "when mode is non-interactive" $ do it "is ignored" $ do capture NonInteractive $ do reportTransient "foobar" `shouldReturn` "" doctest-0.24.2/test/Spec.hs0000644000000000000000000000005407346545000013641 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} doctest-0.24.2/test/UtilSpec.hs0000644000000000000000000000110307346545000014473 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.24.2/test/extract/argument-list/0000755000000000000000000000000007346545000016661 5ustar0000000000000000doctest-0.24.2/test/extract/argument-list/Foo.hs0000644000000000000000000000014707346545000017742 0ustar0000000000000000module Foo where foo :: Int -- ^ doc for arg1 -> Int -- ^ doc for arg2 -> Int foo = undefined doctest-0.24.2/test/extract/comment-order/0000755000000000000000000000000007346545000016641 5ustar0000000000000000doctest-0.24.2/test/extract/comment-order/Foo.hs0000644000000000000000000000042107346545000017715 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.24.2/test/extract/declaration/0000755000000000000000000000000007346545000016353 5ustar0000000000000000doctest-0.24.2/test/extract/declaration/Foo.hs0000644000000000000000000000007607346545000017435 0ustar0000000000000000module Foo where -- | Some documentation foo :: Int foo = 23 doctest-0.24.2/test/extract/dos-line-endings/0000755000000000000000000000000007346545000017225 5ustar0000000000000000doctest-0.24.2/test/extract/dos-line-endings/Foo.hs0000644000000000000000000000011007346545000020274 0ustar0000000000000000module Foo where -- | -- foo -- bar -- baz foo :: Int foo = 23 doctest-0.24.2/test/extract/export-list/0000755000000000000000000000000007346545000016360 5ustar0000000000000000doctest-0.24.2/test/extract/export-list/Foo.hs0000644000000000000000000000020107346545000017430 0ustar0000000000000000module Foo ( -- * some heading -- | documentation from export list foo , bar ) where foo :: Int foo = 23 bar :: Int bar = 23 doctest-0.24.2/test/extract/imported-module/0000755000000000000000000000000007346545000017174 5ustar0000000000000000doctest-0.24.2/test/extract/imported-module/Bar.hs0000644000000000000000000000011507346545000020231 0ustar0000000000000000module Bar where import Baz -- | documentation for bar bar :: Int bar = 23 doctest-0.24.2/test/extract/imported-module/Baz.hs0000644000000000000000000000010107346545000020234 0ustar0000000000000000module Baz where -- | documentation for baz baz :: Int baz = 23 doctest-0.24.2/test/extract/module-header/0000755000000000000000000000000007346545000016601 5ustar0000000000000000doctest-0.24.2/test/extract/module-header/Foo.hs0000644000000000000000000000007607346545000017663 0ustar0000000000000000-- | Some documentation module Foo where foo :: Int foo = 23 doctest-0.24.2/test/extract/named-chunks/0000755000000000000000000000000007346545000016443 5ustar0000000000000000doctest-0.24.2/test/extract/named-chunks/Foo.hs0000644000000000000000000000020007346545000017512 0ustar0000000000000000module Foo ( foo , bar ) where -- $foo named chunk foo -- $bar -- named chunk bar foo :: Int foo = 23 bar :: Int bar = 23 doctest-0.24.2/test/extract/regression/0000755000000000000000000000000007346545000016246 5ustar0000000000000000doctest-0.24.2/test/extract/regression/Fixity.hs0000644000000000000000000000005607346545000020057 0ustar0000000000000000module Fixity where foo :: Int foo = 23 + 42 doctest-0.24.2/test/extract/regression/ForeignImport.hs0000644000000000000000000000037707346545000021375 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.24.2/test/extract/regression/ParallelListComp.hs0000644000000000000000000000017007346545000022007 0ustar0000000000000000{-# LANGUAGE ParallelListComp #-} module ParallelListComp where foo :: [Int] foo = [x+y | x <- [1,2,3] | y <- [4,5,6]] doctest-0.24.2/test/extract/regression/ParallelListCompClass.hs0000644000000000000000000000026207346545000022777 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.24.2/test/extract/regression/RewriteRules.hs0000644000000000000000000000023207346545000021233 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.24.2/test/extract/regression/RewriteRulesWithSigs.hs0000644000000000000000000000025607346545000022723 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.24.2/test/extract/setup/0000755000000000000000000000000007346545000015226 5ustar0000000000000000doctest-0.24.2/test/extract/setup/Foo.hs0000644000000000000000000000021107346545000016277 0ustar0000000000000000module Foo where -- $setup -- some setup code -- | foo foo :: Int foo = 42 -- | bar bar :: Int bar = 42 -- | baz baz :: Int baz = 42 doctest-0.24.2/test/extract/th/0000755000000000000000000000000007346545000014501 5ustar0000000000000000doctest-0.24.2/test/extract/th/Bar.hs0000644000000000000000000000016607346545000015544 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Bar where import Language.Haskell.TH.Lib (ExpQ) bar :: ExpQ bar = [| 23 |] doctest-0.24.2/test/extract/th/Foo.hs0000644000000000000000000000015707346545000015563 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Foo where import Bar -- | some documentation foo :: Int foo = $(bar) doctest-0.24.2/test/extract/type-class-args/0000755000000000000000000000000007346545000017104 5ustar0000000000000000doctest-0.24.2/test/extract/type-class-args/Foo.hs0000644000000000000000000000014407346545000020162 0ustar0000000000000000module Foo where class Foo a where bar :: a -- ^ foo -> Int -- ^ bar -> String doctest-0.24.2/test/extract/type-class/0000755000000000000000000000000007346545000016152 5ustar0000000000000000doctest-0.24.2/test/extract/type-class/Foo.hs0000644000000000000000000000015507346545000017232 0ustar0000000000000000module Foo where class ToString a where -- | Convert given value to a string. toString :: a -> String doctest-0.24.2/test/extract/type-families/0000755000000000000000000000000007346545000016636 5ustar0000000000000000doctest-0.24.2/test/extract/type-families/Foo.hs0000644000000000000000000000013707346545000017716 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} module Foo where type family Foo a type instance Foo Int = Int doctest-0.24.2/test/integration/bugfixImportHierarchical/0000755000000000000000000000000007346545000021715 5ustar0000000000000000doctest-0.24.2/test/integration/bugfixImportHierarchical/ModuleA.hs0000644000000000000000000000010207346545000023570 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import Foo.ModuleB doctest-0.24.2/test/integration/bugfixImportHierarchical/ModuleB.hs0000644000000000000000000000023407346545000023577 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.24.2/test/integration/bugfixMultipleModules/0000755000000000000000000000000007346545000021270 5ustar0000000000000000doctest-0.24.2/test/integration/bugfixMultipleModules/ModuleA.hs0000644000000000000000000000007607346545000023155 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import ModuleB doctest-0.24.2/test/integration/bugfixMultipleModules/ModuleB.hs0000644000000000000000000000035007346545000023151 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.24.2/test/integration/bugfixOutputToStdErr/0000755000000000000000000000000007346545000021073 5ustar0000000000000000doctest-0.24.2/test/integration/bugfixOutputToStdErr/Fib.hs0000644000000000000000000000027407346545000022132 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.24.2/test/integration/bugfixWorkingDirectory/0000755000000000000000000000000007346545000021451 5ustar0000000000000000doctest-0.24.2/test/integration/bugfixWorkingDirectory/Fib.hs0000644000000000000000000000022407346545000022503 0ustar0000000000000000module Fib where -- | Calculate Fibonacci number of given 'Num'. -- -- >>> bar -- 10 fib :: (Num t, Num t1) => t -> t1 fib _ = undefined bar = 10 doctest-0.24.2/test/integration/bugfixWorkingDirectory/description0000644000000000000000000000031207346545000023713 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.24.2/test/integration/bugfixWorkingDirectory/examples/0000755000000000000000000000000007346545000023267 5ustar0000000000000000doctest-0.24.2/test/integration/bugfixWorkingDirectory/examples/Fib.hs0000644000000000000000000000042507346545000024324 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.24.2/test/integration/color/0000755000000000000000000000000007346545000016055 5ustar0000000000000000doctest-0.24.2/test/integration/color/Foo.hs0000644000000000000000000000037107346545000017135 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.24.2/test/integration/custom-package-conf/0000755000000000000000000000000007346545000020565 5ustar0000000000000000doctest-0.24.2/test/integration/custom-package-conf/Bar.hs0000644000000000000000000000013207346545000021621 0ustar0000000000000000module Bar where import Foo -- | -- >>> import Foo -- >>> foo -- 23 bar :: Int bar = 42 doctest-0.24.2/test/integration/custom-package-conf/foo/0000755000000000000000000000000007346545000021350 5ustar0000000000000000doctest-0.24.2/test/integration/custom-package-conf/foo/Foo.hs0000644000000000000000000000004507346545000022426 0ustar0000000000000000module Foo where foo :: Int foo = 23 doctest-0.24.2/test/integration/custom-package-conf/foo/doctest-foo.cabal0000644000000000000000000000023207346545000024557 0ustar0000000000000000name: doctest-foo version: 0.0.0 build-type: Simple cabal-version: >= 1.8 library exposed-modules: Foo build-depends: base doctest-0.24.2/test/integration/dos-line-endings/0000755000000000000000000000000007346545000020076 5ustar0000000000000000doctest-0.24.2/test/integration/dos-line-endings/Fib.hs0000644000000000000000000000024507346545000021133 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.24.2/test/integration/fail-fast/0000755000000000000000000000000007346545000016605 5ustar0000000000000000doctest-0.24.2/test/integration/fail-fast/Bar.hs0000644000000000000000000000012207346545000017640 0ustar0000000000000000module Bar where -- | bar -- a passing test -- >>> bar -- 42 bar :: Int bar = 42 doctest-0.24.2/test/integration/fail-fast/Foo.hs0000644000000000000000000000037307346545000017667 0ustar0000000000000000module Foo where import Bar -- | A passing example -- -- >>> 23 -- 23 test1 :: a test1 = undefined -- | A failing example -- -- >>> 23 -- 42 test2 :: a test2 = undefined -- | Another passing example -- -- >>> 23 -- 23 test3 :: a test3 = undefined doctest-0.24.2/test/integration/fail-fast/SetupBar.hs0000644000000000000000000000016207346545000020665 0ustar0000000000000000module SetupBar where -- $setup -- >>> 23 -- 23 -- | bar -- a passing test -- >>> bar -- 42 bar :: Int bar = 42 doctest-0.24.2/test/integration/fail-fast/SetupFoo.hs0000644000000000000000000000044107346545000020704 0ustar0000000000000000module SetupFoo where import SetupBar -- $setup -- >>> 24 -- 23 -- | A passing example -- -- >>> 23 -- 23 test1 :: a test1 = undefined -- | A failing example -- -- >>> 23 -- 42 test2 :: a test2 = undefined -- | Another passing example -- -- >>> 23 -- 23 test3 :: a test3 = undefined doctest-0.24.2/test/integration/failing-multiple/0000755000000000000000000000000007346545000020201 5ustar0000000000000000doctest-0.24.2/test/integration/failing-multiple/Foo.hs0000644000000000000000000000021507346545000021256 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> 23 -- 23 -- -- >>> 23 -- 42 -- -- >>> 23 -- 23 -- >>> 23 -- 23 test :: a test = undefined doctest-0.24.2/test/integration/failing/0000755000000000000000000000000007346545000016350 5ustar0000000000000000doctest-0.24.2/test/integration/failing/Foo.hs0000644000000000000000000000012707346545000017427 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> 23 -- 42 test :: a test = undefined doctest-0.24.2/test/integration/it/0000755000000000000000000000000007346545000015353 5ustar0000000000000000doctest-0.24.2/test/integration/it/Foo.hs0000644000000000000000000000026007346545000016430 0ustar0000000000000000module Foo where -- | -- -- >>> :t 'a' -- 'a' :: Char -- -- >>> "foo" -- "foo" -- -- >>> length it -- 3 -- -- >>> it * it -- 9 -- -- >>> :t it -- it :: Int -- foo = undefined doctest-0.24.2/test/integration/it/Setup.hs0000644000000000000000000000031007346545000017001 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.24.2/test/integration/local-stderr-binding/0000755000000000000000000000000007346545000020742 5ustar0000000000000000doctest-0.24.2/test/integration/local-stderr-binding/A.hs0000644000000000000000000000015007346545000021452 0ustar0000000000000000module A where stderr :: Bool stderr = True stdout :: String stdout = "hello" -- | -- >>> 3 + 3 -- 6 doctest-0.24.2/test/integration/multiline/0000755000000000000000000000000007346545000016741 5ustar0000000000000000doctest-0.24.2/test/integration/multiline/Multiline.hs0000644000000000000000000000114207346545000021235 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.24.2/test/integration/parse-error/0000755000000000000000000000000007346545000017200 5ustar0000000000000000doctest-0.24.2/test/integration/parse-error/Foo.hs0000644000000000000000000000007307346545000020257 0ustar0000000000000000module Foo where -- | Some documentation foo :: Int foo = doctest-0.24.2/test/integration/property-bool-with-type-signature/0000755000000000000000000000000007346545000023503 5ustar0000000000000000doctest-0.24.2/test/integration/property-bool-with-type-signature/Foo.hs0000644000000000000000000000007507346545000024564 0ustar0000000000000000module Foo where -- | -- prop> True :: Bool foo = undefined doctest-0.24.2/test/integration/property-bool/0000755000000000000000000000000007346545000017554 5ustar0000000000000000doctest-0.24.2/test/integration/property-bool/Foo.hs0000644000000000000000000000006507346545000020634 0ustar0000000000000000module Foo where -- | -- prop> True foo = undefined doctest-0.24.2/test/integration/property-failing/0000755000000000000000000000000007346545000020232 5ustar0000000000000000doctest-0.24.2/test/integration/property-failing/Foo.hs0000644000000000000000000000007307346545000021311 0ustar0000000000000000module Foo where -- | -- prop> abs x == x foo = undefined doctest-0.24.2/test/integration/property-implicitly-quantified/0000755000000000000000000000000007346545000023127 5ustar0000000000000000doctest-0.24.2/test/integration/property-implicitly-quantified/Foo.hs0000644000000000000000000000010507346545000024202 0ustar0000000000000000module Foo where -- | -- prop> abs x == abs (abs x) foo = undefined doctest-0.24.2/test/integration/property-quantified/0000755000000000000000000000000007346545000020752 5ustar0000000000000000doctest-0.24.2/test/integration/property-quantified/Foo.hs0000644000000000000000000000011307346545000022024 0ustar0000000000000000module Foo where -- | -- prop> \x -> abs x == abs (abs x) foo = undefined doctest-0.24.2/test/integration/property-setup/0000755000000000000000000000000007346545000017761 5ustar0000000000000000doctest-0.24.2/test/integration/property-setup/Foo.hs0000644000000000000000000000024507346545000021041 0ustar0000000000000000module Foo where -- $setup -- >>> import Test.QuickCheck -- >>> let arbitraryEven = (* 2) `fmap` arbitrary -- | -- prop> forAll arbitraryEven even foo = undefined doctest-0.24.2/test/integration/setup-skip-on-failure/0000755000000000000000000000000007346545000021102 5ustar0000000000000000doctest-0.24.2/test/integration/setup-skip-on-failure/Foo.hs0000644000000000000000000000017707346545000022166 0ustar0000000000000000module Foo where -- $setup -- >>> x -- 23 -- | -- >>> foo -- 42 foo :: Int foo = 42 -- | -- >>> y -- 42 bar :: Int bar = 42 doctest-0.24.2/test/integration/setup/0000755000000000000000000000000007346545000016077 5ustar0000000000000000doctest-0.24.2/test/integration/setup/Foo.hs0000644000000000000000000000014407346545000017155 0ustar0000000000000000module Foo where -- $setup -- >>> let x = 23 :: Int -- | -- >>> x + foo -- 65 foo :: Int foo = 42 doctest-0.24.2/test/integration/system-io-imported/0000755000000000000000000000000007346545000020511 5ustar0000000000000000doctest-0.24.2/test/integration/system-io-imported/A.hs0000644000000000000000000000036307346545000021227 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.24.2/test/integration/template-haskell-bugfix/0000755000000000000000000000000007346545000021455 5ustar0000000000000000doctest-0.24.2/test/integration/template-haskell-bugfix/Main.hs0000644000000000000000000000042707346545000022700 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.24.2/test/integration/template-haskell-bugfix/Printf.hs0000644000000000000000000000077507346545000023264 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.24.2/test/integration/template-haskell/0000755000000000000000000000000007346545000020173 5ustar0000000000000000doctest-0.24.2/test/integration/template-haskell/Foo.hs0000644000000000000000000000061407346545000021253 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.24.2/test/integration/test-options/0000755000000000000000000000000007346545000017407 5ustar0000000000000000doctest-0.24.2/test/integration/test-options/Foo.hs0000644000000000000000000000015607346545000020470 0ustar0000000000000000module Foo where -- | -- Examples: -- -- >>> foo -- 23 foo :: Int #ifdef FOO foo = 23 #else foo = 42 #endif doctest-0.24.2/test/integration/testBlankline/0000755000000000000000000000000007346545000017536 5ustar0000000000000000doctest-0.24.2/test/integration/testBlankline/Fib.hs0000644000000000000000000000026307346545000020573 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.24.2/test/integration/testCPP/0000755000000000000000000000000007346545000016261 5ustar0000000000000000doctest-0.24.2/test/integration/testCPP/Foo.hs0000644000000000000000000000015607346545000017342 0ustar0000000000000000module Foo where -- | -- Examples: -- -- >>> foo -- 23 foo :: Int #ifdef FOO foo = 23 #else foo = 42 #endif doctest-0.24.2/test/integration/testCombinedExample/0000755000000000000000000000000007346545000020673 5ustar0000000000000000doctest-0.24.2/test/integration/testCombinedExample/Fib.hs0000644000000000000000000000046607346545000021735 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.24.2/test/integration/testCommentLocation/0000755000000000000000000000000007346545000020732 5ustar0000000000000000doctest-0.24.2/test/integration/testCommentLocation/Foo.hs0000644000000000000000000000260307346545000022012 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.24.2/test/integration/testDocumentationForArguments/0000755000000000000000000000000007346545000023005 5ustar0000000000000000doctest-0.24.2/test/integration/testDocumentationForArguments/Fib.hs0000644000000000000000000000014607346545000024042 0ustar0000000000000000module Fib where fib :: Int -- ^ -- >>> 23 -- 23 -> Int fib _ = undefined doctest-0.24.2/test/integration/testFailOnMultiline/0000755000000000000000000000000007346545000020672 5ustar0000000000000000doctest-0.24.2/test/integration/testFailOnMultiline/Fib.hs0000644000000000000000000000034707346545000021732 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.24.2/test/integration/testImport/0000755000000000000000000000000007346545000017111 5ustar0000000000000000doctest-0.24.2/test/integration/testImport/ModuleA.hs0000644000000000000000000000007607346545000020776 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import ModuleB doctest-0.24.2/test/integration/testImport/ModuleB.hs0000644000000000000000000000023007346545000020767 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.24.2/test/integration/testPutStr/0000755000000000000000000000000007346545000017100 5ustar0000000000000000doctest-0.24.2/test/integration/testPutStr/Fib.hs0000644000000000000000000000032107346545000020130 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.24.2/test/integration/testSimple/0000755000000000000000000000000007346545000017070 5ustar0000000000000000doctest-0.24.2/test/integration/testSimple/Fib.hs0000644000000000000000000000023307346545000020122 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.24.2/test/integration/trailing-whitespace/0000755000000000000000000000000007346545000020702 5ustar0000000000000000doctest-0.24.2/test/integration/trailing-whitespace/Foo.hs0000644000000000000000000000014707346545000021763 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> putStrLn "foo " -- foo test :: a test = undefined doctest-0.24.2/test/integration/with-cbits/0000755000000000000000000000000007346545000017014 5ustar0000000000000000doctest-0.24.2/test/integration/with-cbits/Bar.hs0000644000000000000000000000020507346545000020051 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module Bar where import Foreign.C -- | -- >>> foo -- 23 foreign import ccall foo :: CInt doctest-0.24.2/test/integration/with-cbits/foo.c0000644000000000000000000000003307346545000017737 0ustar0000000000000000int foo() { return 23; } doctest-0.24.2/test/parse/multiple-examples/0000755000000000000000000000000007346545000017175 5ustar0000000000000000doctest-0.24.2/test/parse/multiple-examples/Foo.hs0000644000000000000000000000012107346545000020246 0ustar0000000000000000module Foo where -- | -- >>> foo -- 23 foo = 23 -- | -- >>> bar -- 42 bar = 42 doctest-0.24.2/test/parse/no-examples/0000755000000000000000000000000007346545000015756 5ustar0000000000000000doctest-0.24.2/test/parse/no-examples/Fib.hs0000644000000000000000000000020607346545000017010 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- @ -- some code -- @ -- -- foobar 23 fib :: Int -> Int -> Int fib _ = undefined doctest-0.24.2/test/parse/non-exported/0000755000000000000000000000000007346545000016150 5ustar0000000000000000doctest-0.24.2/test/parse/non-exported/Fib.hs0000644000000000000000000000035407346545000017206 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.24.2/test/parse/property/0000755000000000000000000000000007346545000015412 5ustar0000000000000000doctest-0.24.2/test/parse/property/Fib.hs0000644000000000000000000000026407346545000016450 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.24.2/test/parse/setup-empty/0000755000000000000000000000000007346545000016022 5ustar0000000000000000doctest-0.24.2/test/parse/setup-empty/Foo.hs0000644000000000000000000000013207346545000017075 0ustar0000000000000000module Foo where -- $setup -- some setup code -- | -- >>> foo -- 23 foo :: Int foo = 23 doctest-0.24.2/test/parse/setup-only/0000755000000000000000000000000007346545000015645 5ustar0000000000000000doctest-0.24.2/test/parse/setup-only/Foo.hs0000644000000000000000000000013207346545000016720 0ustar0000000000000000module Foo where -- $setup -- >>> foo -- 23 -- | some documentation foo :: Int foo = 23 doctest-0.24.2/test/parse/simple/0000755000000000000000000000000007346545000015017 5ustar0000000000000000doctest-0.24.2/test/parse/simple/Fib.hs0000644000000000000000000000027207346545000016054 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- -- >>> putStrLn "foo" -- foo -- >>> putStr "bar" -- bar -- -- >>> putStrLn "baz" -- baz fib :: Int -> Int -> Int fib _ = undefined