doctest-0.16.3/0000755000000000000000000000000007346545000011437 5ustar0000000000000000doctest-0.16.3/CHANGES0000755000000000000000000000670307346545000012443 0ustar0000000000000000Changes 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.16.3/LICENSE0000644000000000000000000000206707346545000012451 0ustar0000000000000000Copyright (c) 2009-2018 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.16.3/README.markdown0000755000000000000000000002566507346545000014161 0ustar0000000000000000# Doctest: Test interactive Haskell examples `doctest` is a small program, that checks [examples in Haddock comments](http://www.haskell.org/haddock/doc/html/ch03s08.html#id566093). It is similar to the [popular Python module with the same name](http://docs.python.org/library/doctest.html). ## Installation `doctest` is available from [Hackage](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/doctest). Install it, by typing: cabal install doctest Make sure that Cabal's `bindir` is on your `PATH`. On Linux: export PATH="$HOME/.cabal/bin:$PATH" On Mac OS X: export PATH="$HOME/Library/Haskell/bin:$PATH" On Windows: set PATH="%AppData%\cabal\bin\;%PATH%" For more information, see the [section on paths in the Cabal User Guide](http://www.haskell.org/cabal/users-guide/installing-packages.html#paths-in-the-simple-build-system). ## Usage Below is a small Haskell module. The module contains a Haddock comment with some examples of interaction. The examples demonstrate how the module is supposed to be used. ```haskell module Fib where -- | Compute Fibonacci numbers -- -- Examples: -- -- >>> fib 10 -- 55 -- -- >>> fib 5 -- 5 fib :: Int -> Int fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) ``` (A comment line starting with `>>>` denotes an _expression_. All comment lines following an expression denote the _result_ of that expression. Result is defined by what a [REPL](http://en.wikipedia.org/wiki/Read-eval-print_loop) (e.g. ghci) prints to `stdout` and `stderr` when evaluating that expression.) With `doctest` you may check whether the implementation satisfies the given examples, by typing: doctest Fib.hs You may produce Haddock documentation for that module with: haddock -h Fib.hs -o doc/ `doctest` will fail on comments that `haddock` also doesn't like. Sometimes (e.g., (https://github.com/sol/doctest/issues/251)[#251]), this means that `doctest` will fail on input that GHC accepts. `doctest` likes UTF-8. If you are running it with, e.g., `LC_ALL=C`, you may need to invoke `doctest` with `LC_ALL=C.UTF-8`. ### Example groups Examples from a single Haddock comment are grouped together and share the same scope. E.g. the following works: ```haskell -- | -- >>> let x = 23 -- >>> x + 42 -- 65 ``` If an example fails, subsequent examples from the same group are skipped. E.g. for ```haskell -- | -- >>> let x = 23 -- >>> let n = x + y -- >>> print n ``` `print n` is not tried, because `let n = x + y` fails (`y` is not in scope!). #### A note on performance By default, `doctest` calls `:reload` between each group to clear GHCi's scope of any local definitions. This ensures that previous examples cannot influence later ones. However, it can lead to performance penalties if you are using `doctest` in a project with many modules. One possible remedy is to pass the `--fast` flag to `doctest`, which disables calling `:reload` between groups. If `doctest`s are running too slowly, you might consider using `--fast`. (With the caveat that the order in which groups appear now matters!) However, note that due to a [bug on GHC 8.2.1 or later](https://ghc.haskell.org/trac/ghc/ticket/14052), the performance of `--fast` suffers significantly when combined with the `--preserve-it` flag (which keeps the value of GHCi's `it` value between examples). ### Setup code You can put setup code in a [named chunk][named-chunks] with the name `$setup`. The setup code is run before each example group. If the setup code produces any errors/failures, all tests from that module are skipped. Here is an example: ```haskell module Foo where import Bar.Baz -- $setup -- >>> let x = 23 :: Int -- | -- >>> foo + x -- 65 foo :: Int foo = 42 ``` Note that you should not place setup code inbetween the module header (`module ... where`) and import declarations. GHC will not be able to parse it ([issue #167](https://github.com/sol/doctest/issues/167)). It is best to place setup code right after import declarations, but due to its declarative nature you can place it anywhere inbetween top level declarations as well. ### Multi-line input GHCi supports commands which span multiple lines, and the same syntax works for doctest: ```haskell -- | -- >>> :{ -- let -- x = 1 -- y = 2 -- in x + y + multiline -- :} -- 6 multiline = 3 ``` Note that `>>>` can be left off for the lines following the first: this is so that haddock does not strip leading whitespace. The expected output has whitespace stripped relative to the :}. Some peculiarities on the ghci side mean that whitespace at the very start is lost. This breaks the example `broken`, since the 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 (since version 2.13.0) has markup support for properties. Doctest can verify properties with QuickCheck. A simple property looks like this: ```haskell -- | -- prop> \xs -> sort xs == (sort . sort) (xs :: [Int]) ``` The lambda abstraction is optional and can be omitted: ```haskell -- | -- prop> sort xs == (sort . sort) (xs :: [Int]) ``` A complete example that uses setup code is below: ```haskell module Fib where -- $setup -- >>> import Control.Applicative -- >>> import Test.QuickCheck -- >>> newtype Small = Small Int deriving Show -- >>> instance Arbitrary Small where arbitrary = Small . (`mod` 10) <$> arbitrary -- | Compute Fibonacci numbers -- -- The following property holds: -- -- prop> \(Small n) -> fib n == fib (n + 2) - fib (n + 1) fib :: Int -> Int fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) ``` If you see an error like the following, ensure that [QuickCheck](http://hackage.haskell.org/package/QuickCheck) is a dependency of the test-suite or executable running `doctest`. ```haskell :39:3: Not in scope: ‘polyQuickCheck’ In the splice: $(polyQuickCheck (mkName "doctest_prop")) :39:3: GHC stage restriction: ‘polyQuickCheck’ is used in a top-level splice or annotation, and must be imported, not defined locally In the expression: polyQuickCheck (mkName "doctest_prop") In the splice: $(polyQuickCheck (mkName "doctest_prop")) ``` ### Hiding examples from Haddock You can put examples into [named chunks][named-chunks], and not refer to them in the export list. That way they will not be part of the generated Haddock documentation, but Doctest will still find them. ```haskell -- $ -- >>> 1 + 1 -- 2 ``` [named-chunks]: http://www.haskell.org/haddock/doc/html/ch03s05.html ### Using GHC extensions There's two sets of GHC extensions involved when running Doctest: 1. The set of GHC extensions that are active when compiling the module code (excluding the doctest examples). The easiest way to specify these extensions is through [LANGUAGE pragmas][language-pragma] in your source files. (Doctest will not look at your cabal file.) 2. The set of GHC extensions that are active when executing the Doctest examples. (These are not influenced by the LANGUAGE pragmas in the file.) The recommended way to enable extensions for Doctest examples is to switch them on like this: ```haskell -- | -- >>> :set -XTupleSections -- >>> fst' $ (1,) 2 -- 1 fst' :: (a, b) -> a fst' = fst ``` Alternatively you can pass any GHC options to Doctest, e.g.: doctest -XCPP Foo.hs These options will affect both the loading of the module and the execution of the Doctest examples. If you want to omit the information which language extensions are enabled from the Doctest examples you can use the method described in [Hiding examples from Haddock](#hiding-examples-from-haddock), e.g.: ```haskell -- $ -- >>> :set -XTupleSections ``` [language-pragma]: http://www.haskell.org/ghc/docs/latest/html/users_guide/pragmas.html#language-pragma ### Cabal integration Doctest provides both, an executable and a library. The library exposes a function `doctest` of type: ```haskell doctest :: [String] -> IO () ``` Doctest's own `main` is simply: ```haskell main = getArgs >>= doctest ``` Consequently, it is possible to create a custom executable for a project, by passing all command-line arguments that are required for that project to `doctest`. A simple example looks like this: ```haskell -- file doctests.hs import Test.DocTest main = doctest ["-isrc", "src/Main.hs"] ``` And a corresponding Cabal test suite section like this: test-suite doctests type: exitcode-stdio-1.0 ghc-options: -threaded main-is: doctests.hs build-depends: base, doctest >= 0.8 ## Doctest in the wild You can find real world examples of `Doctest` being used below: * [base Data/Maybe.hs](https://github.com/ghc/ghc/blob/669cbef03c220de43b0f88f2b2238bf3c02ed64c/libraries/base/Data/Maybe.hs#L36-L79) * [base Data/Functor.hs](https://github.com/ghc/ghc/blob/669cbef03c220de43b0f88f2b2238bf3c02ed64c/libraries/base/Data/Functor.hs#L34-L64) ## Doctest extensions * [doctest-discover](https://github.com/karun012/doctest-discover) ## Development [![Build Status](https://secure.travis-ci.org/sol/doctest.png)](http://travis-ci.org/sol/doctest) Join in at `#hspec` on freenode. Discuss your ideas first, ideally by opening an issue on GitHub. Add tests for new features, and make sure that the test suite passes with your changes. cabal configure --enable-tests && cabal build && cabal exec cabal test ## Contributors * Adam Vogt * Anders Persson * Ankit Ahuja * Edward Kmett * Hiroki Hattori * Joachim Breitner * João Cristóvão * Julian Arni * Kazu Yamamoto * Levent Erkok * Luke Murphy * Matvey Aksenov * Michael Orlitzky * Michael Snoyman * Nick Smallbone * Sakari Jokinen * Simon Hengel * Sönke Hahn doctest-0.16.3/Setup.lhs0000644000000000000000000000011407346545000013243 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain doctest-0.16.3/doctest.cabal0000644000000000000000000001551607346545000014100 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- -- hash: 4cde762c2c650b42498854666c00b2d44f751e196c9b0dd779fcb055b388414f name: doctest version: 0.16.3 synopsis: Test interactive Haskell examples description: The doctest program checks examples in source code comments. It is modeled after doctest for Python (). . 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-2018 Simon Hengel author: Simon Hengel maintainer: quasicomputational build-type: Simple extra-source-files: example/example.cabal example/src/Example.hs example/test/doctests.hs test/parse/multiple-examples/Foo.hs test/parse/no-examples/Fib.hs test/parse/non-exported/Fib.hs test/parse/property/Fib.hs test/parse/setup-empty/Foo.hs test/parse/setup-only/Foo.hs test/parse/simple/Fib.hs test/extract/argument-list/Foo.hs test/extract/comment-order/Foo.hs test/extract/declaration/Foo.hs test/extract/dos-line-endings/Foo.hs test/extract/export-list/Foo.hs test/extract/imported-module/Bar.hs test/extract/imported-module/Baz.hs test/extract/module-header/Foo.hs test/extract/named-chunks/Foo.hs test/extract/regression/Fixity.hs test/extract/regression/ForeignImport.hs test/extract/regression/ParallelListComp.hs test/extract/regression/ParallelListCompClass.hs test/extract/regression/RewriteRules.hs test/extract/regression/RewriteRulesWithSigs.hs test/extract/setup/Foo.hs test/extract/th/Bar.hs test/extract/th/Foo.hs test/extract/type-class-args/Foo.hs test/extract/type-class/Foo.hs test/extract/type-families/Foo.hs test/integration/bugfixImportHierarchical/ModuleA.hs test/integration/bugfixImportHierarchical/ModuleB.hs test/integration/bugfixMultipleModules/ModuleA.hs test/integration/bugfixMultipleModules/ModuleB.hs test/integration/bugfixOutputToStdErr/Fib.hs test/integration/bugfixWorkingDirectory/description test/integration/bugfixWorkingDirectory/examples/Fib.hs test/integration/bugfixWorkingDirectory/Fib.hs test/integration/color/Foo.hs test/integration/custom-package-conf/Bar.hs test/integration/custom-package-conf/foo/doctest-foo.cabal test/integration/custom-package-conf/foo/Foo.hs test/integration/dos-line-endings/Fib.hs test/integration/failing-multiple/Foo.hs test/integration/failing/Foo.hs test/integration/it/Foo.hs test/integration/it/Setup.hs test/integration/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/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 test/sandbox/bad.config test/sandbox/cabal.sandbox.config CHANGES README.markdown source-repository head type: git location: https://github.com/sol/doctest library ghc-options: -Wall hs-source-dirs: src ghci-wrapper/src exposed-modules: Test.DocTest other-modules: Extract GhcUtil Interpreter Location Options PackageDBs Parse Property Run Runner Runner.Example Sandbox Util Language.Haskell.GhciWrapper Paths_doctest build-depends: base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq , directory , filepath , ghc >=7.0 && <8.11 , ghc-paths >=0.1.0.9 , process , syb >=0.3 , transformers default-language: Haskell2010 executable doctest main-is: Main.hs other-modules: Paths_doctest ghc-options: -Wall -threaded hs-source-dirs: driver build-depends: base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq , directory , doctest , filepath , ghc >=7.0 && <8.11 , ghc-paths >=0.1.0.9 , process , syb >=0.3 , transformers default-language: Haskell2010 test-suite doctests main-is: doctests.hs type: exitcode-stdio-1.0 ghc-options: -Wall -threaded hs-source-dirs: test build-depends: base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq , directory , doctest , filepath , ghc >=7.0 && <8.11 , ghc-paths >=0.1.0.9 , process , syb >=0.3 , transformers default-language: Haskell2010 test-suite spec main-is: Spec.hs other-modules: ExtractSpec InterpreterSpec LocationSpec MainSpec OptionsSpec Orphans PackageDBsSpec ParseSpec PropertySpec Runner.ExampleSpec RunnerSpec RunSpec SandboxSpec UtilSpec Extract GhcUtil Interpreter Location Options PackageDBs Parse Property Run Runner Runner.Example Sandbox Test.DocTest Util Language.Haskell.GhciWrapper Paths_doctest type: exitcode-stdio-1.0 ghc-options: -Wall -threaded cpp-options: -DTEST hs-source-dirs: test src ghci-wrapper/src c-sources: test/integration/with-cbits/foo.c build-depends: HUnit , QuickCheck >=2.13.1 , base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq , directory , filepath , ghc >=7.0 && <8.11 , ghc-paths >=0.1.0.9 , hspec >=2.3.0 , hspec-core >=2.3.0 , mockery , process , setenv , silently >=1.2.4 , stringbuilder >=0.4 , syb >=0.3 , transformers default-language: Haskell2010 doctest-0.16.3/driver/0000755000000000000000000000000007346545000012732 5ustar0000000000000000doctest-0.16.3/driver/Main.hs0000644000000000000000000000021707346545000014152 0ustar0000000000000000module Main (main) where import Test.DocTest import System.Environment (getArgs) main :: IO () main = getArgs >>= doctest doctest-0.16.3/example/0000755000000000000000000000000007346545000013072 5ustar0000000000000000doctest-0.16.3/example/example.cabal0000755000000000000000000000056607346545000015523 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.16.3/example/src/0000755000000000000000000000000007346545000013661 5ustar0000000000000000doctest-0.16.3/example/src/Example.hs0000755000000000000000000000012507346545000015611 0ustar0000000000000000module Example where -- | -- >>> foo -- 23 foo = 23 -- | -- >>> bar -- 42 bar = 42 doctest-0.16.3/example/test/0000755000000000000000000000000007346545000014051 5ustar0000000000000000doctest-0.16.3/example/test/doctests.hs0000755000000000000000000000015307346545000016237 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["-isrc", "src/Example.hs"] doctest-0.16.3/ghci-wrapper/src/Language/Haskell/0000755000000000000000000000000007346545000017724 5ustar0000000000000000doctest-0.16.3/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs0000644000000000000000000001072707346545000022502 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Language.Haskell.GhciWrapper ( Interpreter , Config(..) , defaultConfig , new , close , eval , evalIt , evalEcho ) where import System.IO hiding (stdin, stdout, stderr) import System.Process import System.Exit import Control.Monad import Control.Exception import Data.List import Data.Maybe data Config = Config { configGhci :: String , configVerbose :: Bool , configIgnoreDotGhci :: Bool } deriving (Eq, Show) defaultConfig :: Config defaultConfig = Config { configGhci = "ghci" , configVerbose = False , configIgnoreDotGhci = True } -- | Truly random marker, used to separate expressions. -- -- IMPORTANT: This module relies upon the fact that this marker is unique. It -- has been obtained from random.org. Do not expect this module to work -- properly, if you reuse it for any purpose! marker :: String marker = show "dcbd2a1e20ae519a1c7714df2859f1890581d57fac96ba3f499412b2f5c928a1" itMarker :: String itMarker = "d42472243a0e6fc481e7514cbc9eb08812ed48daa29ca815844d86010b1d113a" data Interpreter = Interpreter { hIn :: Handle , hOut :: Handle , process :: ProcessHandle } new :: Config -> [String] -> IO Interpreter new Config{..} args_ = do (Just stdin_, Just stdout_, Nothing, processHandle ) <- createProcess $ (proc configGhci args) {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit} setMode stdin_ setMode stdout_ let interpreter = Interpreter {hIn = stdin_, hOut = stdout_, process = processHandle} _ <- eval interpreter "import System.IO" _ <- eval interpreter "import GHC.IO.Handle" -- The buffering of stdout and stderr is NoBuffering _ <- eval interpreter "hDuplicateTo stdout stderr" -- Now the buffering of stderr is BlockBuffering Nothing -- In this situation, GHC 7.7 does not flush the buffer even when -- error happens. _ <- eval interpreter "hSetBuffering stdout LineBuffering" _ <- eval interpreter "hSetBuffering stderr LineBuffering" -- this is required on systems that don't use utf8 as default encoding (e.g. -- Windows) _ <- eval interpreter "hSetEncoding stdout utf8" _ <- eval interpreter "hSetEncoding stderr utf8" _ <- eval interpreter ":m - System.IO" _ <- eval 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 close :: Interpreter -> IO () close repl = do hClose $ hIn repl -- It is crucial not to close `hOut` before calling `waitForProcess`, -- otherwise ghci may not cleanly terminate on SIGINT (ctrl-c) and hang -- around consuming 100% CPU. This happens when ghci tries to print -- something to stdout in its signal handler (e.g. when it is blocked in -- threadDelay it writes "Interrupted." on SIGINT). e <- waitForProcess $ process repl hClose $ hOut repl when (e /= ExitSuccess) $ do throwIO (userError $ "Language.Haskell.GhciWrapper.close: Interpreter exited with an error (" ++ show e ++ ")") putExpression :: Interpreter -> Bool -> String -> IO () putExpression Interpreter{hIn = stdin} preserveIt e = do hPutStrLn stdin e when preserveIt $ hPutStrLn stdin $ "let " ++ itMarker ++ " = it" hPutStrLn stdin marker when preserveIt $ hPutStrLn stdin $ "let it = " ++ itMarker hFlush stdin getResult :: Bool -> Interpreter -> IO String getResult echoMode Interpreter{hOut = stdout} = go where go = do line <- hGetLine stdout if marker `isSuffixOf` line then do let xs = stripMarker line echo xs return xs else do echo (line ++ "\n") result <- go return (line ++ "\n" ++ result) stripMarker l = take (length l - length marker) l echo :: String -> IO () echo | echoMode = putStr | otherwise = (const $ return ()) -- | Evaluate an expression eval :: Interpreter -> String -> IO String eval repl expr = do putExpression repl False expr getResult False repl -- | Like 'eval', but try to preserve the @it@ variable evalIt :: Interpreter -> String -> IO String evalIt repl expr = do putExpression repl True expr getResult False repl -- | Evaluate an expression evalEcho :: Interpreter -> String -> IO String evalEcho repl expr = do putExpression repl True expr getResult True repl doctest-0.16.3/src/0000755000000000000000000000000007346545000012226 5ustar0000000000000000doctest-0.16.3/src/Extract.hs0000644000000000000000000002404507346545000014201 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-} module Extract (Module(..), extract) where import Prelude hiding (mod, concat) import Control.Monad #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Control.Exception import Data.List (partition, isSuffixOf) import Data.Maybe #if __GLASGOW_HASKELL__ < 710 import Data.Foldable (concat) #endif import Control.DeepSeq (deepseq, NFData(rnf)) import Data.Generics #if __GLASGOW_HASKELL__ < 707 import GHC hiding (flags, Module, Located) import MonadUtils (liftIO, MonadIO) #else import GHC hiding (Module, Located) import DynFlags import MonadUtils (liftIO) #endif import Exception (ExceptionMonad) import System.Directory import System.FilePath #if __GLASGOW_HASKELL__ < 710 import NameSet (NameSet) import Coercion (Coercion) #endif #if __GLASGOW_HASKELL__ < 805 import FastString (unpackFS) #endif import Digraph (flattenSCCs) import System.Posix.Internals (c_getpid) import GhcUtil (withGhc) import Location hiding (unLoc) import Util (convertDosLineEndings) import PackageDBs (getPackageDBArgs) #if __GLASGOW_HASKELL__ >= 806 import DynamicLoading (initializePlugins) #endif -- | A wrapper around `SomeException`, to allow for a custom `Show` instance. newtype ExtractError = ExtractError SomeException deriving Typeable instance Show ExtractError where show (ExtractError e) = unlines [ "Ouch! Hit an error thunk in GHC's AST while extracting documentation." , "" , " " ++ msg , "" , "This is most likely a bug in doctest." , "" , "Please report it here: https://github.com/sol/doctest/issues/new" ] where msg = case fromException e of Just (Panic s) -> "GHC panic: " ++ s _ -> show e instance Exception ExtractError -- | Documentation for a module grouped together with the modules name. data Module a = Module { moduleName :: String , moduleSetup :: Maybe a , moduleContent :: [a] } deriving (Eq, Functor) instance NFData a => NFData (Module a) where rnf (Module name setup content) = name `deepseq` setup `deepseq` content `deepseq` () #if __GLASGOW_HASKELL__ < 803 type GhcPs = RdrName needsTemplateHaskellOrQQ :: ModuleGraph -> Bool needsTemplateHaskellOrQQ = needsTemplateHaskell mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph mapMG = map #endif #if __GLASGOW_HASKELL__ < 805 addQuoteInclude :: [String] -> [String] -> [String] addQuoteInclude includes new = new ++ includes #endif -- | Parse a list of modules. parse :: [String] -> IO [TypecheckedModule] parse args = withGhc args $ \modules_ -> withTempOutputDir $ do -- ignore additional object files let modules = filter (not . isSuffixOf ".o") modules_ mapM (`guessTarget` Nothing) modules >>= setTargets mods <- depanal [] False mods' <- if needsTemplateHaskellOrQQ mods then enableCompilation mods else return mods let sortedMods = flattenSCCs (topSortModuleGraph False mods' Nothing) reverse <$> mapM (loadModPlugins >=> parseModule >=> typecheckModule >=> loadModule) sortedMods where -- copied from Haddock/Interface.hs enableCompilation :: ModuleGraph -> Ghc ModuleGraph enableCompilation modGraph = do #if __GLASGOW_HASKELL__ < 707 let enableComp d = d { hscTarget = defaultObjectTarget } #elif __GLASGOW_HASKELL__ < 809 let enableComp d = let platform = targetPlatform d in d { hscTarget = defaultObjectTarget platform } #else let enableComp d = d { hscTarget = defaultObjectTarget d } #endif modifySessionDynFlags enableComp -- We need to update the DynFlags of the ModSummaries as well. let upd m = m { ms_hspp_opts = enableComp (ms_hspp_opts m) } let modGraph' = mapMG upd modGraph return modGraph' -- copied from Haddock/GhcUtils.hs modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc () modifySessionDynFlags f = do dflags <- getSessionDynFlags #if __GLASGOW_HASKELL__ < 707 _ <- setSessionDynFlags (f dflags) #else -- 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') #endif 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 gbracket_ before_ after thing = gbracket before_ (const after) (const thing) setOutputDir f d = d { objectDir = Just f , hiDir = Just f , stubDir = Just f , includePaths = addQuoteInclude (includePaths d) [f] } #if __GLASGOW_HASKELL__ >= 806 -- Since GHC 8.6, plugins are initialized on a per module basis loadModPlugins modsum = do hsc_env <- getSession dynflags' <- liftIO (initializePlugins hsc_env (GHC.ms_hspp_opts modsum)) return $ modsum { ms_hspp_opts = dynflags' } #else loadModPlugins = return #endif -- | Extract all docstrings from given list of files/modules. -- -- This includes the docstrings of all local modules that are imported from -- those modules (possibly indirect). extract :: [String] -> IO [Module (Located String)] extract args = do packageDBArgs <- getPackageDBArgs let args' = args ++ packageDBArgs mods <- parse args' let docs = map (fmap (fmap convertDosLineEndings) . extractFromModule . tm_parsed_module) 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 -- | 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 = 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. header = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]] #if __GLASGOW_HASKELL__ < 710 exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- concat (hsmodExports source)] #elif __GLASGOW_HASKELL__ < 805 exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)] #else exports = [(Nothing, L loc doc) | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)] #endif decls = extractDocStrings (hsmodDecls source) type Selector a = a -> ([(Maybe String, LHsDocString)], Bool) #if __GLASGOW_HASKELL__ < 710 -- | Ignore a subtree. ignore :: Selector a ignore = const ([], True) #endif -- | Collect given value and descend into subtree. select :: a -> ([a], Bool) select x = ([x], False) -- | Extract all docstrings from given value. extractDocStrings :: Data a => a -> [(Maybe String, LHsDocString)] extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl `extQ` fromLDocDecl `extQ` fromLHsDocString #if __GLASGOW_HASKELL__ < 710 `extQ` (ignore :: Selector NameSet) `extQ` (ignore :: Selector PostTcKind) -- HsExpr never contains any documentation, but it may contain error thunks. -- -- Problematic are (non comprehensive): -- -- * parallel list comprehensions -- * infix operators -- `extQ` (ignore :: Selector (HsExpr RdrName)) -- undefined before type checking `extQ` (ignore :: Selector Coercion) #if __GLASGOW_HASKELL__ >= 706 -- hswb_kvs and hswb_tvs may be error thunks `extQ` (ignore :: Selector (HsWithBndrs [LHsType RdrName])) `extQ` (ignore :: Selector (HsWithBndrs [LHsType Name])) `extQ` (ignore :: Selector (HsWithBndrs (LHsType RdrName))) `extQ` (ignore :: Selector (HsWithBndrs (LHsType Name))) #endif #endif ) where fromLHsDecl :: Selector (LHsDecl GhcPs) fromLHsDecl (L loc decl) = case decl of -- Top-level documentation has to be treated separately, because it has -- no location information attached. The location information is -- attached to HsDecl instead. #if __GLASGOW_HASKELL__ < 805 DocD x -> select (fromDocDecl loc x) #else DocD _ x -> select (fromDocDecl loc x) #endif _ -> (extractDocStrings decl, True) fromLDocDecl :: Selector LDocDecl fromLDocDecl (L loc x) = select (fromDocDecl 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) #if __GLASGOW_HASKELL__ < 805 -- | Convert a docstring to a plain string. unpackHDS :: HsDocString -> String unpackHDS (HsDocString s) = unpackFS s #endif doctest-0.16.3/src/GhcUtil.hs0000644000000000000000000000562407346545000014130 0ustar0000000000000000{-# LANGUAGE CPP #-} module GhcUtil (withGhc) where import GHC.Paths (libdir) #if __GLASGOW_HASKELL__ < 707 import Control.Exception import GHC hiding (flags) import DynFlags (dopt_set) #else import GHC import DynFlags (gopt_set) #endif import Panic (throwGhcException) import MonadUtils (liftIO) import System.Exit (exitFailure) #if __GLASGOW_HASKELL__ < 702 import StaticFlags (v_opt_C_ready) import Data.IORef (writeIORef) #elif __GLASGOW_HASKELL__ < 707 import StaticFlags (saveStaticFlagGlobals, restoreStaticFlagGlobals) #elif __GLASGOW_HASKELL__ < 801 import StaticFlags (discardStaticFlags) #endif -- | Save static flag globals, run action, and restore them. bracketStaticFlags :: IO a -> IO a #if __GLASGOW_HASKELL__ < 702 -- GHC < 7.2 does not provide saveStaticFlagGlobals/restoreStaticFlagGlobals, -- so we need to modifying v_opt_C_ready directly bracketStaticFlags action = action `finally` writeIORef v_opt_C_ready False #elif __GLASGOW_HASKELL__ < 707 bracketStaticFlags action = bracket saveStaticFlagGlobals restoreStaticFlagGlobals (const action) #else bracketStaticFlags action = action #endif -- Catch GHC source errors, print them and exit. handleSrcErrors :: Ghc a -> Ghc a handleSrcErrors action' = flip handleSourceError action' $ \err -> do #if __GLASGOW_HASKELL__ < 702 printExceptionAndWarnings err #else printException err #endif liftIO exitFailure -- | Run a GHC action in Haddock mode withGhc :: [String] -> ([String] -> Ghc a) -> IO a withGhc flags action = bracketStaticFlags $ do flags_ <- handleStaticFlags flags runGhc (Just libdir) $ do handleDynamicFlags flags_ >>= handleSrcErrors . action handleStaticFlags :: [String] -> IO [Located String] #if __GLASGOW_HASKELL__ < 707 handleStaticFlags flags = fst `fmap` parseStaticFlags (map noLoc flags) #elif __GLASGOW_HASKELL__ < 801 handleStaticFlags flags = return $ map noLoc $ discardStaticFlags flags #else handleStaticFlags flags = return $ map noLoc $ flags #endif handleDynamicFlags :: GhcMonad m => [Located String] -> m [String] handleDynamicFlags flags = do (dynflags, locSrcs, _) <- (setHaddockMode `fmap` getSessionDynFlags) >>= flip 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 #if __GLASGOW_HASKELL__ < 707 setHaddockMode dynflags = (dopt_set dynflags Opt_Haddock) { #else setHaddockMode dynflags = (gopt_set dynflags Opt_Haddock) { #endif hscTarget = HscNothing , ghcMode = CompManager , ghcLink = NoLink } doctest-0.16.3/src/Interpreter.hs0000644000000000000000000000464607346545000015077 0ustar0000000000000000{-# LANGUAGE CPP #-} module Interpreter ( Interpreter , safeEval , safeEvalIt , withInterpreter , ghc , interpreterSupported -- exported for testing , ghcInfo , haveInterpreterKey ) where import System.Process import System.Directory (getPermissions, executable) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Control.Monad import Control.Exception hiding (handle) import Data.Char import GHC.Paths (ghc) import Language.Haskell.GhciWrapper haveInterpreterKey :: String haveInterpreterKey = "Have interpreter" ghcInfo :: IO [(String, String)] ghcInfo = read <$> readProcess ghc ["--info"] [] interpreterSupported :: IO Bool interpreterSupported = do -- in a perfect world this permission check should never fail, but I know of -- at least one case where it did.. x <- getPermissions ghc unless (executable x) $ do fail $ ghc ++ " is not executable!" maybe False (== "YES") . lookup haveInterpreterKey <$> ghcInfo -- | Run an interpreter session. -- -- Example: -- -- >>> withInterpreter [] $ \i -> eval i "23 + 42" -- "65\n" withInterpreter :: [String] -- ^ List of flags, passed to GHC -> (Interpreter -> IO a) -- ^ Action to run -> IO a -- ^ Result of action withInterpreter flags action = do let args = flags ++ [ "--interactive" #if __GLASGOW_HASKELL__ >= 802 , "-fdiagnostics-color=never" , "-fno-diagnostics-show-caret" #endif ] bracket (new defaultConfig{configGhci = ghc} args) close action -- | Evaluate an expression; return a Left value on exceptions. -- -- An exception may e.g. be caused on unterminated multiline expressions. safeEval :: Interpreter -> String -> IO (Either String String) safeEval repl = either (return . Left) (fmap Right . eval repl) . filterExpression safeEvalIt :: Interpreter -> String -> IO (Either String String) safeEvalIt repl = either (return . Left) (fmap Right . evalIt repl) . filterExpression filterExpression :: String -> Either String String filterExpression e = case lines e of [] -> Right e l -> if firstLine == ":{" && lastLine /= ":}" then fail_ else Right e where firstLine = strip $ head l lastLine = strip $ last l fail_ = Left "unterminated multiline command" where strip :: String -> String strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse doctest-0.16.3/src/Location.hs0000644000000000000000000000376107346545000014341 0ustar0000000000000000{-# LANGUAGE CPP, DeriveFunctor #-} module Location where import Control.DeepSeq (deepseq, NFData(rnf)) import SrcLoc hiding (Located) import qualified SrcLoc as GHC import FastString (unpackFS) #if __GLASGOW_HASKELL__ < 702 import Outputable (showPpr) #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__ < 702 toLocation loc | isGoodSrcLoc start = Location (unpackFS $ srcLocFile start) (srcLocLine start) | otherwise = (UnhelpfulLocation . showPpr) start where start = srcSpanStart loc #else toLocation loc = case loc of UnhelpfulSpan str -> UnhelpfulLocation (unpackFS str) RealSrcSpan sp -> Location (unpackFS . srcSpanFile $ sp) (srcSpanStartLine sp) #endif doctest-0.16.3/src/Options.hs0000644000000000000000000000675107346545000014226 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} module Options ( Result(..) , Run(..) , defaultMagic , defaultFastMode , defaultPreserveIt , defaultVerbose , parseOptions #ifdef TEST , usage , info , versionInfo #endif ) where import Prelude () import Prelude.Compat import Data.List.Compat import Data.Maybe import qualified Paths_doctest import Data.Version (showVersion) import Config as GHC import Interpreter (ghc) usage :: String usage = unlines [ "Usage:" , " doctest [ --fast | --preserve-it | --no-magic | --verbose | GHC OPTION | MODULE ]..." , " doctest --help" , " doctest --version" , " doctest --info" , "" , "Options:" , " --fast disable :reload between example groups" , " --preserve-it preserve the `it` variable between examples" , " --verbose print each test as it is run" , " --help display this help and exit" , " --version output version information and exit" , " --info output machine-readable version information and exit" ] version :: String version = showVersion Paths_doctest.version ghcVersion :: String ghcVersion = GHC.cProjectVersion versionInfo :: String versionInfo = unlines [ "doctest version " ++ version , "using version " ++ ghcVersion ++ " of the GHC API" , "using " ++ ghc ] info :: String info = "[ " ++ (intercalate "\n, " . map show $ [ ("version", version) , ("ghc_version", ghcVersion) , ("ghc", ghc) ]) ++ "\n]\n" data Result a = Output String | Result a deriving (Eq, Show, Functor) type Warning = String data Run = Run { runWarnings :: [Warning] , runOptions :: [String] , runMagicMode :: Bool , runFastMode :: Bool , runPreserveIt :: Bool , runVerbose :: Bool } deriving (Eq, Show) defaultMagic :: Bool defaultMagic = True defaultFastMode :: Bool defaultFastMode = False defaultPreserveIt :: Bool defaultPreserveIt = False defaultVerbose :: Bool defaultVerbose = False parseOptions :: [String] -> Result Run parseOptions args | "--help" `elem` args = Output usage | "--info" `elem` args = Output info | "--version" `elem` args = Output versionInfo | otherwise = case fmap (fmap (fmap stripOptGhc)) . fmap (fmap stripVerbose) . fmap stripPreserveIt . stripFast <$> stripNoMagic args of (magicMode, (fastMode, (preserveIt, (verbose, (warning, xs))))) -> Result (Run (maybeToList warning) xs magicMode fastMode preserveIt verbose) stripNoMagic :: [String] -> (Bool, [String]) stripNoMagic = stripFlag (not defaultMagic) "--no-magic" stripFast :: [String] -> (Bool, [String]) stripFast = stripFlag (not defaultFastMode) "--fast" stripPreserveIt :: [String] -> (Bool, [String]) stripPreserveIt = stripFlag (not defaultPreserveIt) "--preserve-it" stripVerbose :: [String] -> (Bool, [String]) stripVerbose = stripFlag (not defaultVerbose) "--verbose" stripFlag :: Bool -> String -> [String] -> (Bool, [String]) stripFlag enableIt flag args = ((flag `elem` args) == enableIt, filter (/= flag) args) stripOptGhc :: [String] -> (Maybe Warning, [String]) stripOptGhc = go where go args = case args of [] -> (Nothing, []) "--optghc" : opt : rest -> (Just warning, opt : snd (go rest)) opt : rest -> maybe (fmap (opt :)) (\x (_, xs) -> (Just warning, x : xs)) (stripPrefix "--optghc=" opt) (go rest) warning = "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly." doctest-0.16.3/src/PackageDBs.hs0000644000000000000000000000644507346545000014517 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} -- | Manage GHC package databases module PackageDBs ( PackageDBs (..) , ArgStyle (..) , dbArgs , buildArgStyle , getPackageDBsFromEnv , getPackageDBArgs ) where import System.Environment (getEnvironment) import System.FilePath (splitSearchPath, searchPathSeparator) import qualified Sandbox import Control.Exception (try, SomeException) import System.Directory (getCurrentDirectory) -- | Full stack of GHC package databases data PackageDBs = PackageDBs { includeUser :: Bool -- | Unsupported on GHC < 7.6 , includeGlobal :: Bool , extraDBs :: [FilePath] } deriving (Show, Eq) -- | Package database handling switched between GHC 7.4 and 7.6 data ArgStyle = Pre76 | Post76 deriving (Show, Eq) -- | Determine command line arguments to be passed to GHC to set databases correctly -- -- >>> dbArgs Post76 (PackageDBs False True []) -- ["-no-user-package-db"] -- -- >>> dbArgs Pre76 (PackageDBs True True ["somedb"]) -- ["-package-conf","somedb"] dbArgs :: ArgStyle -> PackageDBs -> [String] dbArgs Post76 (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 dbArgs Pre76 (PackageDBs _ False _) = error "Global package database must be included with GHC < 7.6" dbArgs Pre76 (PackageDBs user True extras) = (if user then id else ("-no-user-package-conf":)) $ concatMap (\extra -> ["-package-conf", extra]) extras -- | The argument style to be used with the current GHC version buildArgStyle :: ArgStyle #if __GLASGOW_HASKELL__ >= 706 buildArgStyle = Post76 #else buildArgStyle = Pre76 #endif -- | Determine the PackageDBs based on the environment and cabal sandbox -- information getPackageDBsFromEnv :: IO PackageDBs getPackageDBsFromEnv = do env <- getEnvironment case () of () | Just sandboxes <- lookup "HASKELL_PACKAGE_SANDBOXES" env -> return $ fromEnvMulti sandboxes | Just extra <- lookup "HASKELL_PACKAGE_SANDBOX" env -> return PackageDBs { includeUser = True , includeGlobal = True , extraDBs = [extra] } | Just sandboxes <- lookup "GHC_PACKAGE_PATH" env -> return $ fromEnvMulti sandboxes | otherwise -> do eres <- try $ getCurrentDirectory >>= Sandbox.getSandboxConfigFile >>= Sandbox.getPackageDbDir return $ case eres :: Either SomeException FilePath of Left _ -> PackageDBs True True [] Right db -> PackageDBs False True [db] 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 buildArgStyle dbs doctest-0.16.3/src/Parse.hs0000644000000000000000000001336107346545000013640 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Parse ( Module (..) , DocTest (..) , Interaction , Expression , ExpectedResult , ExpectedLine (..) , LineChunk (..) , getDocTests -- * exported for testing , parseInteractions , parseProperties , mkLineChunks ) where import Data.Char (isSpace) import Data.List import Data.Maybe import Data.String #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Extract import Location data DocTest = Example Expression ExpectedResult | Property Expression deriving (Eq, Show) data LineChunk = LineChunk String | WildCardChunk deriving (Show, Eq) instance IsString LineChunk where fromString = LineChunk data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine deriving (Show, Eq) instance IsString ExpectedLine where fromString = ExpectedLine . return . LineChunk type Expression = String type ExpectedResult = [ExpectedLine] type Interaction = (Expression, ExpectedResult) -- | -- Extract 'DocTest's from all given modules and all modules included by the -- given modules. getDocTests :: [String] -> IO [Module [Located DocTest]] -- ^ Extracted 'DocTest's getDocTests args = parseModules <$> extract args parseModules :: [Module (Located String)] -> [Module [Located DocTest]] parseModules = filter (not . isEmpty) . map parseModule where isEmpty (Module _ setup tests) = null tests && isNothing setup -- | Convert documentation to `Example`s. parseModule :: Module (Located String) -> Module [Located DocTest] parseModule m = case parseComment <$> m of Module name setup tests -> Module name setup_ (filter (not . null) tests) where setup_ = case setup of Just [] -> Nothing _ -> setup parseComment :: Located String -> [Located DocTest] parseComment c = properties ++ examples where examples = map (fmap $ uncurry Example) (parseInteractions c) properties = map (fmap Property) (parseProperties c) -- | Extract all properties from given Haddock comment. parseProperties :: Located String -> [Located Expression] parseProperties (Located loc input) = go $ zipWith Located (enumerate loc) (lines input) where isPrompt :: Located String -> Bool isPrompt = isPrefixOf "prop>" . dropWhile isSpace . unLoc go xs = case dropWhile (not . isPrompt) xs of prop:rest -> stripPrompt `fmap` prop : go rest [] -> [] stripPrompt = strip . drop 5 . dropWhile isSpace -- | Extract all interactions from given Haddock comment. parseInteractions :: Located String -> [Located Interaction] parseInteractions (Located loc input) = go $ zipWith Located (enumerate loc) (lines input) where isPrompt :: Located String -> Bool isPrompt = isPrefixOf ">>>" . dropWhile isSpace . unLoc isBlankLine :: Located String -> Bool isBlankLine = null . dropWhile isSpace . unLoc isEndOfInteraction :: Located String -> Bool isEndOfInteraction x = isPrompt x || isBlankLine x go :: [Located String] -> [Located Interaction] go xs = case dropWhile (not . isPrompt) xs of prompt:rest | ":{" : _ <- words (drop 3 (dropWhile isSpace (unLoc prompt))), (ys,zs) <- break isBlankLine rest -> toInteraction prompt ys : go zs | otherwise -> let (ys,zs) = break isEndOfInteraction rest in toInteraction prompt ys : go zs [] -> [] -- | Create an `Interaction`, strip superfluous whitespace as appropriate. -- -- also merge lines between :{ and :}, preserving whitespace inside -- the block (since this is useful for avoiding {;}). toInteraction :: Located String -> [Located String] -> Located Interaction toInteraction (Located loc x) xs = Located loc $ ( (strip cleanedE) -- we do not care about leading and trailing -- whitespace in expressions, so drop them , map mkExpectedLine result_ ) where -- 1. drop trailing whitespace from the prompt, remember the prefix (prefix, e) = span isSpace x (ePrompt, eRest) = splitAt 3 e -- 2. drop, if possible, the exact same sequence of whitespace -- characters from each result line unindent pre = map (tryStripPrefix pre . unLoc) cleanBody line = fromMaybe (unLoc line) (stripPrefix ePrompt (dropWhile isSpace (unLoc line))) (cleanedE, result_) | (body , endLine : rest) <- break ( (==) [":}"] . take 1 . words . cleanBody) xs = (unlines (eRest : map cleanBody body ++ [dropWhile isSpace (cleanBody endLine)]), unindent (takeWhile isSpace (unLoc endLine)) rest) | otherwise = (eRest, unindent prefix xs) tryStripPrefix :: String -> String -> String tryStripPrefix prefix ys = fromMaybe ys $ stripPrefix prefix ys mkExpectedLine :: String -> ExpectedLine mkExpectedLine x = case x of "" -> "" "..." -> WildCardLine _ -> ExpectedLine $ mkLineChunks x mkLineChunks :: String -> [LineChunk] mkLineChunks = finish . foldr go (0, [], []) where mkChunk :: String -> [LineChunk] mkChunk "" = [] mkChunk x = [LineChunk x] go :: Char -> (Int, String, [LineChunk]) -> (Int, String, [LineChunk]) go '.' (count, acc, res) = if count == 2 then (0, "", WildCardChunk : mkChunk acc ++ res) else (count + 1, acc, res) go c (count, acc, res) = if count > 0 then (0, c : replicate count '.' ++ acc, res) else (0, c : acc, res) finish (count, acc, res) = mkChunk (replicate count '.' ++ acc) ++ res -- | Remove leading and trailing whitespace. strip :: String -> String strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse doctest-0.16.3/src/Property.hs0000644000000000000000000000452207346545000014411 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} module Property ( runProperty , PropertyResult (..) #ifdef TEST , freeVariables , parseNotInScope #endif ) where import Data.List import Data.Maybe import Data.Foldable import Util import Interpreter (Interpreter) import qualified Interpreter import Parse -- | The result of evaluating an interaction. data PropertyResult = Success | Failure String | Error String deriving (Eq, Show) runProperty :: Interpreter -> Expression -> IO PropertyResult runProperty repl expression = do _ <- Interpreter.safeEval repl "import Test.QuickCheck ((==>))" _ <- Interpreter.safeEval repl "import Test.QuickCheck.All (polyQuickCheck)" _ <- Interpreter.safeEval repl "import Language.Haskell.TH (mkName)" _ <- Interpreter.safeEval repl ":set -XTemplateHaskell" 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 #if __GLASGOW_HASKELL__ >= 707 unquote ('\8216':xs) = init xs #endif unquote xs = xs doctest-0.16.3/src/Run.hs0000644000000000000000000001014207346545000013324 0ustar0000000000000000{-# LANGUAGE CPP #-} module Run ( doctest #ifdef TEST , doctestWithOptions , Summary , expandDirs #endif ) where import Prelude () import Prelude.Compat import Control.Monad (when, unless) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.Environment (getEnvironment) import System.Exit (exitFailure, exitSuccess) import System.FilePath ((), takeExtension) import System.IO import System.IO.CodePage (withCP65001) import qualified Control.Exception as E import Panic import PackageDBs import Parse import Options import Runner import qualified Interpreter -- | Run doctest with given list of arguments. -- -- Example: -- -- >>> doctest ["-iexample/src", "example/src/Example.hs"] -- Examples: 2 Tried: 2 Errors: 0 Failures: 0 -- -- This can be used to create a Cabal test suite that runs doctest for your -- project. -- -- If a directory is given, it is traversed to find all .hs and .lhs files -- inside of it, ignoring hidden entries. doctest :: [String] -> IO () doctest args0 = case parseOptions args0 of Output s -> putStr s Result (Run warnings args_ magicMode fastMode preserveIt verbose) -> do mapM_ (hPutStrLn stderr) warnings hFlush stderr i <- Interpreter.interpreterSupported unless i $ do hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests" exitSuccess args <- case magicMode of False -> return args_ True -> do expandedArgs <- concat <$> mapM expandDirs args_ packageDBArgs <- getPackageDBArgs addDistArgs <- getAddDistArgs return (addDistArgs $ packageDBArgs ++ expandedArgs) r <- doctestWithOptions fastMode preserveIt verbose args `E.catch` \e -> do case fromException e of Just (UsageError err) -> do hPutStrLn stderr ("doctest: " ++ err) hPutStrLn stderr "Try `doctest --help' for more information." exitFailure _ -> E.throwIO e when (not $ isSuccess r) exitFailure -- | Expand a reference to a directory to all .hs and .lhs files within it. expandDirs :: String -> IO [String] expandDirs fp0 = do isDir <- doesDirectoryExist fp0 if isDir then findHaskellFiles fp0 else return [fp0] where findHaskellFiles dir = do contents <- getDirectoryContents dir concat <$> mapM go (filter (not . hidden) contents) where go name = do isDir <- doesDirectoryExist fp if isDir then findHaskellFiles fp else if isHaskellFile fp then return [fp] else return [] where fp = dir name hidden ('.':_) = True hidden _ = False isHaskellFile fp = takeExtension fp `elem` [".hs", ".lhs"] -- | Get the necessary arguments to add the @cabal_macros.h@ file and autogen -- directory, if present. getAddDistArgs :: IO ([String] -> [String]) getAddDistArgs = do env <- getEnvironment let dist = case lookup "HASKELL_DIST_DIR" env of Nothing -> "dist" Just x -> x autogen = dist ++ "/build/autogen/" cabalMacros = autogen ++ "cabal_macros.h" dirExists <- doesDirectoryExist autogen if dirExists then do fileExists <- doesFileExist cabalMacros return $ \rest -> concat ["-i", dist, "/build/autogen/"] : "-optP-include" : (if fileExists then (concat ["-optP", dist, "/build/autogen/cabal_macros.h"]:) else id) rest else return id isSuccess :: Summary -> Bool isSuccess s = sErrors s == 0 && sFailures s == 0 doctestWithOptions :: Bool -> Bool -> Bool -> [String] -> IO Summary doctestWithOptions fastMode preserveIt verbose args = do -- get examples from Haddock comments modules <- getDocTests args Interpreter.withInterpreter args $ \repl -> withCP65001 $ do runModules fastMode preserveIt verbose repl modules doctest-0.16.3/src/Runner.hs0000644000000000000000000001673707346545000014051 0ustar0000000000000000{-# LANGUAGE CPP #-} module Runner ( runModules , Summary(..) #ifdef TEST , Report , ReportState (..) , report , report_ #endif ) where import Prelude hiding (putStr, putStrLn, error) #if __GLASGOW_HASKELL__ < 710 import Data.Monoid hiding ((<>)) import Control.Applicative #endif import Control.Monad hiding (forM_) import Text.Printf (printf) import System.IO (hPutStrLn, hPutStr, stderr, hIsTerminalDevice) import Data.Foldable (forM_) import Control.Monad.Trans.State import Control.Monad.IO.Class import Interpreter (Interpreter) import qualified Interpreter import Parse import Location import Property import Runner.Example -- | Summary of a test run. data Summary = Summary { sExamples :: Int , sTried :: Int , sErrors :: Int , sFailures :: Int } deriving Eq -- | Format a summary. instance Show Summary where show (Summary examples tried errors failures) = printf "Examples: %d Tried: %d Errors: %d Failures: %d" examples tried errors failures -- | Sum up summaries. instance Monoid Summary where mempty = Summary 0 0 0 0 #if MIN_VERSION_base(4,11,0) instance Semigroup Summary where (<>) #else mappend #endif (Summary x1 x2 x3 x4) (Summary y1 y2 y3 y4) = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4) -- | Run all examples from a list of modules. runModules :: Bool -> Bool -> Bool -> Interpreter -> [Module [Located DocTest]] -> IO Summary runModules fastMode preserveIt verbose repl modules = do isInteractive <- hIsTerminalDevice stderr ReportState _ _ _ s <- (`execStateT` ReportState 0 isInteractive verbose mempty {sExamples = c}) $ do forM_ modules $ runModule fastMode preserveIt repl verboseReport "# Final summary:" gets (show . reportStateSummary) >>= report return s where c = (sum . map count) modules -- | Count number of expressions in given module. count :: Module [Located DocTest] -> Int count (Module _ setup tests) = sum (map length tests) + maybe 0 length setup -- | A monad for generating test reports. type Report = StateT ReportState IO data ReportState = ReportState { reportStateCount :: Int -- ^ characters on the current line , reportStateInteractive :: Bool -- ^ should intermediate results be printed? , reportStateVerbose :: Bool , reportStateSummary :: Summary -- ^ test summary } -- | Add output to the report. report :: String -> Report () report msg = do overwrite msg -- add a newline, this makes the output permanent liftIO $ hPutStrLn stderr "" modify (\st -> st {reportStateCount = 0}) -- | Add intermediate output to the report. -- -- This will be overwritten by subsequent calls to `report`/`report_`. -- Intermediate out may not contain any newlines. report_ :: String -> Report () report_ msg = do f <- gets reportStateInteractive when f $ do overwrite msg modify (\st -> st {reportStateCount = length msg}) -- | Add output to the report, overwrite any intermediate out. overwrite :: String -> Report () overwrite msg = do n <- gets reportStateCount let str | 0 < n = "\r" ++ msg ++ replicate (n - length msg) ' ' | otherwise = msg liftIO (hPutStr stderr str) -- | Run all examples from given module. runModule :: Bool -> Bool -> Interpreter -> Module [Located DocTest] -> Report () runModule fastMode preserveIt repl (Module module_ setup examples) = do Summary _ _ e0 f0 <- gets reportStateSummary forM_ setup $ runTestGroup preserveIt repl reload Summary _ _ e1 f1 <- gets reportStateSummary -- only run tests, if setup does not produce any errors/failures when (e0 == e1 && f0 == f1) $ forM_ examples $ runTestGroup preserveIt repl setup_ where reload :: IO () reload = do unless fastMode $ -- NOTE: It is important to do the :reload first! See -- https://ghc.haskell.org/trac/ghc/ticket/5904, which results in a -- panic on GHC 7.4.1 if you do the :reload second. void $ Interpreter.safeEval repl ":reload" void $ Interpreter.safeEval repl $ ":m *" ++ module_ when preserveIt $ -- Evaluate a dumb expression to populate the 'it' variable NOTE: This is -- one reason why we cannot have safeEval = safeEvalIt: 'it' isn't set in -- a fresh GHCi session. void $ Interpreter.safeEval repl $ "()" setup_ :: IO () setup_ = do reload forM_ setup $ \l -> forM_ l $ \(Located _ x) -> case x of Property _ -> return () Example e _ -> void $ safeEvalWith preserveIt repl e reportStart :: Location -> Expression -> String -> Report () reportStart loc expression testType = do verboseReport (printf "### Started execution at %s.\n### %s:\n%s" (show loc) testType expression) reportFailure :: Location -> Expression -> [String] -> Report () reportFailure loc expression err = do report (printf "%s: failure in expression `%s'" (show loc) expression) mapM_ report err report "" updateSummary (Summary 0 1 0 1) reportError :: Location -> Expression -> String -> Report () reportError loc expression err = do report (printf "%s: error in expression `%s'" (show loc) expression) report err report "" updateSummary (Summary 0 1 1 0) reportSuccess :: Report () reportSuccess = do verboseReport "### Successful!\n" updateSummary (Summary 0 1 0 0) verboseReport :: String -> Report () verboseReport xs = do verbose <- gets reportStateVerbose when verbose $ report xs updateSummary :: Summary -> Report () updateSummary summary = do ReportState n f v s <- get put (ReportState n f v $ s `mappend` summary) reportProgress :: Report () reportProgress = do verbose <- gets reportStateVerbose when (not verbose) $ gets (show . reportStateSummary) >>= report_ -- | Run given test group. -- -- The interpreter state is zeroed with @:reload@ first. This means that you -- can reuse the same 'Interpreter' for several test groups. runTestGroup :: Bool -> Interpreter -> IO () -> [Located DocTest] -> Report () runTestGroup preserveIt repl setup tests = do reportProgress liftIO setup runExampleGroup preserveIt repl examples forM_ properties $ \(loc, expression) -> do r <- do liftIO setup reportStart loc expression "property" liftIO $ runProperty repl expression case r of Success -> reportSuccess Error err -> do reportError loc expression err Failure msg -> do reportFailure loc expression [msg] where properties = [(loc, p) | Located loc (Property p) <- tests] examples :: [Located Interaction] examples = [Located loc (e, r) | Located loc (Example e r) <- tests] -- | -- Execute all expressions from given example in given 'Interpreter' and verify -- the output. runExampleGroup :: Bool -> Interpreter -> [Located Interaction] -> Report () runExampleGroup preserveIt repl = go where go ((Located loc (expression, expected)) : xs) = do reportStart loc expression "example" r <- fmap lines <$> liftIO (safeEvalWith preserveIt repl expression) case r of Left err -> do reportError loc expression err Right actual -> case mkResult expected actual of NotEqual err -> do reportFailure loc expression err Equal -> do reportSuccess go xs go [] = return () safeEvalWith :: Bool -> Interpreter -> String -> IO (Either String String) safeEvalWith preserveIt | preserveIt = Interpreter.safeEvalIt | otherwise = Interpreter.safeEval doctest-0.16.3/src/Runner/0000755000000000000000000000000007346545000013477 5ustar0000000000000000doctest-0.16.3/src/Runner/Example.hs0000644000000000000000000001247707346545000015441 0ustar0000000000000000module Runner.Example ( Result (..) , mkResult ) where import Data.Char import Data.List 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.16.3/src/Sandbox.hs0000644000000000000000000000575307346545000014172 0ustar0000000000000000{-# LANGUAGE CPP, BangPatterns #-} module Sandbox ( getSandboxArguments , getPackageDbDir , getSandboxConfigFile ) where #if __GLASGOW_HASKELL__ < 710 import Data.Functor ((<$>)) #endif import Control.Exception as E (catch, SomeException, throwIO) import Data.Char (isSpace) import Data.List (isPrefixOf, tails) import System.Directory (getCurrentDirectory, doesFileExist) import System.FilePath ((), takeDirectory, takeFileName) configFile :: String configFile = "cabal.sandbox.config" pkgDbKey :: String pkgDbKey = "package-db:" pkgDbKeyLen :: Int pkgDbKeyLen = length pkgDbKey getSandboxArguments :: IO [String] getSandboxArguments = (sandboxArguments <$> getPkgDb) `E.catch` handler where getPkgDb = getCurrentDirectory >>= getSandboxConfigFile >>= getPackageDbDir handler :: SomeException -> IO [String] handler _ = return [] -- | Find a sandbox config file by tracing ancestor directories. -- Exception is thrown if not found getSandboxConfigFile :: FilePath -> IO FilePath getSandboxConfigFile dir = do let cfile = dir configFile exist <- doesFileExist cfile if exist then return cfile else do let dir' = takeDirectory dir if dir == dir' then throwIO $ userError "sandbox config file not found" else getSandboxConfigFile dir' -- | Extract a package db directory from the sandbox config file. -- Exception is thrown if the sandbox config file is broken. getPackageDbDir :: FilePath -> IO FilePath getPackageDbDir sconf = do -- Be strict to ensure that an error can be caught. !path <- extractValue . parse <$> readFile sconf return path where parse = head . filter ("package-db:" `isPrefixOf`) . lines extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen -- | Adding necessary GHC options to the package db. -- Exception is thrown if the string argument is incorrect. -- -- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d" -- ["-no-user-package-db","-package-db","/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"] -- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d" -- ["-no-user-package-conf","-package-conf","/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"] sandboxArguments :: FilePath -> [String] sandboxArguments pkgDb = [noUserPkgDbOpt, pkgDbOpt, pkgDb] where ver = extractGhcVer pkgDb (pkgDbOpt,noUserPkgDbOpt) | ver < 706 = ("-package-conf","-no-user-package-conf") | otherwise = ("-package-db", "-no-user-package-db") -- | Extracting GHC version from the path of package db. -- Exception is thrown if the string argument is incorrect. -- -- >>> extractGhcVer "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d" -- 706 extractGhcVer :: String -> Int extractGhcVer dir = ver where file = takeFileName dir findVer = drop 4 . head . filter ("ghc-" `isPrefixOf`) . tails (verStr1,_:left) = break (== '.') $ findVer file (verStr2,_) = break (== '.') left ver = read verStr1 * 100 + read verStr2 doctest-0.16.3/src/Test/0000755000000000000000000000000007346545000013145 5ustar0000000000000000doctest-0.16.3/src/Test/DocTest.hs0000644000000000000000000000007607346545000015051 0ustar0000000000000000module Test.DocTest ( doctest ) where import Run doctest-0.16.3/src/Util.hs0000644000000000000000000000131307346545000013475 0ustar0000000000000000module Util where import Data.Char convertDosLineEndings :: String -> String convertDosLineEndings = go where go input = case input of '\r':'\n':xs -> '\n' : go xs -- Haddock comments from source files with dos line endings end with a -- CR, so we strip that, too. "\r" -> "" x:xs -> x : go xs "" -> "" -- | Return the longest suffix of elements that satisfy a given predicate. takeWhileEnd :: (a -> Bool) -> [a] -> [a] takeWhileEnd p = reverse . takeWhile p . reverse -- | Remove trailing white space from a string. -- -- >>> stripEnd "foo " -- "foo" stripEnd :: String -> String stripEnd = reverse . dropWhile isSpace . reverse doctest-0.16.3/test/0000755000000000000000000000000007346545000012416 5ustar0000000000000000doctest-0.16.3/test/ExtractSpec.hs0000644000000000000000000000756007346545000015207 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} module ExtractSpec (main, spec) where import Test.Hspec import Test.HUnit import Panic (GhcException (..)) import Extract import Location import System.FilePath import Orphans () shouldGive :: HasCallStack => (String, String) -> [Module String] -> Assertion (d, m) `shouldGive` expected = do r <- map (fmap unLoc) `fmap` extract ["-i" ++ dir, dir m] r `shouldBe` expected where dir = "test/extract" d main :: IO () main = hspec spec spec :: Spec spec = do describe "extract" $ do it "extracts documentation for a top-level declaration" $ do ("declaration", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" Some documentation"]] it "extracts documentation from argument list" $ do ("argument-list", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" doc for arg1", " doc for arg2"]] it "extracts documentation for a type class function" $ do ("type-class", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" Convert given value to a string."]] it "extracts documentation from the argument list of a type class function" $ do ("type-class-args", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" foo", " bar"]] it "extracts documentation from the module header" $ do ("module-header", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" Some documentation"]] it "extracts documentation from imported modules" $ do ("imported-module", "Bar.hs") `shouldGive` [Module "Bar" Nothing [" documentation for bar"], Module "Baz" Nothing [" documentation for baz"]] it "extracts documentation from export list" $ do ("export-list", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" documentation from export list"]] it "extracts documentation from named chunks" $ do ("named-chunks", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" named chunk foo", "\n named chunk bar"]] it "returns docstrings in the same order they appear in the source" $ do ("comment-order", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" module header", " export list 1", " export list 2", " foo", " named chunk", " bar"]] it "extracts $setup code" $ do ("setup", "Foo.hs") `shouldGive` [Module "Foo" (Just "\n some setup code") [" foo", " bar", " baz"]] it "fails on invalid flags" $ do extract ["--foobar", "test/Foo.hs"] `shouldThrow` (\e -> case e of UsageError "unrecognized option `--foobar'" -> True; _ -> False) describe "extract (regression tests)" $ do it "works with infix operators" $ do ("regression", "Fixity.hs") `shouldGive` [Module "Fixity" Nothing []] it "works with parallel list comprehensions" $ do ("regression", "ParallelListComp.hs") `shouldGive` [Module "ParallelListComp" Nothing []] it "works with list comprehensions in instance definitions" $ do ("regression", "ParallelListCompClass.hs") `shouldGive` [Module "ParallelListCompClass" Nothing []] it "works with foreign imports" $ do ("regression", "ForeignImport.hs") `shouldGive` [Module "ForeignImport" Nothing []] it "works for rewrite rules" $ do ("regression", "RewriteRules.hs") `shouldGive` [Module "RewriteRules" Nothing [" doc for foo"]] it "works for rewrite rules with type signatures" $ do ("regression", "RewriteRulesWithSigs.hs") `shouldGive` [Module "RewriteRulesWithSigs" Nothing [" doc for foo"]] it "strips CR from dos line endings" $ do ("dos-line-endings", "Foo.hs") `shouldGive` [Module "Foo" Nothing ["\n foo\n bar\n baz"]] it "works with a module that splices in an expression from an other module" $ do ("th", "Foo.hs") `shouldGive` [Module "Foo" Nothing [" some documentation"], Module "Bar" Nothing []] it "works for type families and GHC 7.6.1" $ do ("type-families", "Foo.hs") `shouldGive` [Module "Foo" Nothing []] doctest-0.16.3/test/InterpreterSpec.hs0000644000000000000000000000202307346545000016065 0ustar0000000000000000module InterpreterSpec (main, spec) where import Prelude () import Prelude.Compat import Test.Hspec import Interpreter (interpreterSupported, haveInterpreterKey, ghcInfo, withInterpreter, safeEval) main :: IO () main = hspec spec spec :: Spec spec = do describe "interpreterSupported" $ do it "indicates whether GHCi is supported on current platform" $ do (Interpreter.interpreterSupported >> return ()) `shouldReturn` () describe "ghcInfo" $ do it ("includes " ++ show haveInterpreterKey) $ do info <- ghcInfo lookup haveInterpreterKey info `shouldSatisfy` (||) <$> (== Just "YES") <*> (== Just "NO") describe "safeEval" $ do it "evaluates an expression" $ withInterpreter [] $ \ghci -> do Interpreter.safeEval ghci "23 + 42" `shouldReturn` Right "65\n" it "returns Left on unterminated multiline command" $ withInterpreter [] $ \ghci -> do Interpreter.safeEval ghci ":{\n23 + 42" `shouldReturn` Left "unterminated multiline command" doctest-0.16.3/test/LocationSpec.hs0000644000000000000000000000257007346545000015341 0ustar0000000000000000module LocationSpec (main, spec) where import Test.Hspec import Location import SrcLoc import FastString (fsLit) main :: IO () main = hspec spec spec :: Spec spec = do describe "toLocation" $ do it "works for a regular SrcSpan" $ do toLocation (mkSrcSpan (mkSrcLoc (fsLit "Foo.hs") 2 5) (mkSrcLoc (fsLit "Foo.hs") 10 20)) `shouldBe` Location "Foo.hs" 2 it "works for a single-line SrcSpan" $ do toLocation (mkSrcSpan (mkSrcLoc (fsLit "Foo.hs") 2 5) (mkSrcLoc (fsLit "Foo.hs") 2 10)) `shouldBe` Location "Foo.hs" 2 it "works for a SrcSpan that corresponds to single point" $ do (toLocation . srcLocSpan) (mkSrcLoc (fsLit "Foo.hs") 10 20) `shouldBe` Location "Foo.hs" 10 it "works for a bad SrcSpan" $ do toLocation noSrcSpan `shouldBe` UnhelpfulLocation "" 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.16.3/test/MainSpec.hs0000644000000000000000000001217507346545000014457 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} module MainSpec (main, spec) where import Test.Hspec import Test.HUnit (assertEqual, Assertion) import Control.Exception import System.Directory (getCurrentDirectory, setCurrentDirectory) import System.FilePath import Options import Runner (Summary(..)) import Run hiding (doctest) import System.IO.Silently import System.IO withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory workingDir action = do bracket getCurrentDirectory setCurrentDirectory $ \_ -> do setCurrentDirectory workingDir action -- | Construct a doctest specific 'Assertion'. doctest :: HasCallStack => FilePath -> [String] -> Summary -> Assertion doctest = doctestWithPreserveIt defaultPreserveIt doctestWithPreserveIt :: HasCallStack => Bool -> FilePath -> [String] -> Summary -> Assertion doctestWithPreserveIt preserveIt workingDir args expected = do actual <- withCurrentDirectory ("test/integration" workingDir) (hSilence [stderr] $ doctestWithOptions defaultFastMode preserveIt defaultVerbose args) assertEqual label expected actual where label = workingDir ++ " " ++ show args cases :: Int -> Summary cases n = Summary n n 0 0 main :: IO () main = hspec spec spec :: Spec spec = do describe "doctest" $ do it "testSimple" $ do doctest "." ["testSimple/Fib.hs"] (cases 1) it "it-variable" $ do doctestWithPreserveIt True "." ["it/Foo.hs"] (cases 5) it "it-variable in $setup" $ do doctestWithPreserveIt True "." ["it/Setup.hs"] (cases 5) it "failing" $ do doctest "." ["failing/Foo.hs"] (cases 1) {sFailures = 1} it "skips subsequent examples from the same group if an example fails" $ doctest "." ["failing-multiple/Foo.hs"] (cases 4) {sTried = 2, sFailures = 1} it "testImport" $ do doctest "testImport" ["ModuleA.hs"] (cases 3) doctest ".." ["-iintegration/testImport", "integration/testImport/ModuleA.hs"] (cases 3) it "testCommentLocation" $ do doctest "." ["testCommentLocation/Foo.hs"] (cases 11) it "testPutStr" $ do doctest "testPutStr" ["Fib.hs"] (cases 3) it "fails on multi-line expressions, introduced with :{" $ do doctest "testFailOnMultiline" ["Fib.hs"] (cases 2) {sErrors = 2} it "testBlankline" $ do doctest "testBlankline" ["Fib.hs"] (cases 1) it "examples from the same Haddock comment share the same scope" $ do doctest "testCombinedExample" ["Fib.hs"] (cases 4) it "testDocumentationForArguments" $ do doctest "testDocumentationForArguments" ["Fib.hs"] (cases 1) it "template-haskell" $ do doctest "template-haskell" ["Foo.hs"] (cases 2) it "handles source files with CRLF line endings" $ do doctest "dos-line-endings" ["Fib.hs"] (cases 1) it "runs $setup before each test group" $ do doctest "setup" ["Foo.hs"] (cases 2) it "skips subsequent tests from a module, if $setup fails" $ do doctest "setup-skip-on-failure" ["Foo.hs"] (cases 3) {sTried = 1, sFailures = 1} it "works with additional object files" $ do doctest "with-cbits" ["Bar.hs", "../../../dist/build/spec/spec-tmp/test/integration/with-cbits/foo.o"] (cases 1) it "ignores trailing whitespace when matching test output" $ do doctest "trailing-whitespace" ["Foo.hs"] (cases 1) describe "doctest as a runner for QuickCheck properties" $ do it "runs a boolean property" $ do doctest "property-bool" ["Foo.hs"] (cases 1) it "runs an explicitly quantified property" $ do doctest "property-quantified" ["Foo.hs"] (cases 1) it "runs an implicitly quantified property" $ do doctest "property-implicitly-quantified" ["Foo.hs"] (cases 1) it "reports a failing property" $ do doctest "property-failing" ["Foo.hs"] (cases 1) {sFailures = 1} it "runs a boolean property with an explicit type signature" $ do doctest "property-bool-with-type-signature" ["Foo.hs"] (cases 1) it "runs $setup before each property" $ do doctest "property-setup" ["Foo.hs"] (cases 3) describe "doctest (regression tests)" $ do it "bugfixWorkingDirectory" $ do doctest "bugfixWorkingDirectory" ["Fib.hs"] (cases 1) doctest "bugfixWorkingDirectory" ["examples/Fib.hs"] (cases 2) it "bugfixOutputToStdErr" $ do doctest "bugfixOutputToStdErr" ["Fib.hs"] (cases 2) it "bugfixImportHierarchical" $ do doctest "bugfixImportHierarchical" ["ModuleA.hs", "ModuleB.hs"] (cases 3) it "bugfixMultipleModules" $ do doctest "bugfixMultipleModules" ["ModuleA.hs"] (cases 5) it "testCPP" $ do doctest "testCPP" ["-cpp", "Foo.hs"] (cases 1) {sFailures = 1} doctest "testCPP" ["-cpp", "-DFOO", "Foo.hs"] (cases 1) it "template-haskell-bugfix" $ do doctest "template-haskell-bugfix" ["Main.hs"] (cases 2) doctest-0.16.3/test/OptionsSpec.hs0000644000000000000000000000500707346545000015222 0ustar0000000000000000module OptionsSpec (spec) where import Prelude () import Prelude.Compat import Test.Hspec import Test.QuickCheck import Options spec :: Spec spec = do describe "parseOptions" $ do let warning = ["WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."] it "strips --optghc" $ property $ \xs ys -> parseOptions (xs ++ ["--optghc", "foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt defaultVerbose) it "strips --optghc=" $ property $ \xs ys -> parseOptions (xs ++ ["--optghc=foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt defaultVerbose) describe "--no-magic" $ do context "without --no-magic" $ do it "enables magic mode" $ do runMagicMode <$> parseOptions [] `shouldBe` Result True context "with --no-magic" $ do it "disables magic mode" $ do runMagicMode <$> parseOptions ["--no-magic"] `shouldBe` Result False describe "--fast" $ do context "without --fast" $ do it "disables fast mode" $ do runFastMode <$> parseOptions [] `shouldBe` Result False context "with --fast" $ do it "enabled fast mode" $ do runFastMode <$> parseOptions ["--fast"] `shouldBe` Result True describe "--preserve-it" $ do context "without --preserve-it" $ do it "does not preserve the `it` variable" $ do runPreserveIt <$> parseOptions [] `shouldBe` Result False context "with --preserve-it" $ do it "preserves the `it` variable" $ do runPreserveIt <$> parseOptions ["--preserve-it"] `shouldBe` Result True context "with --help" $ do it "outputs usage information" $ do parseOptions ["--help"] `shouldBe` Output usage context "with --version" $ do it "outputs version information" $ do parseOptions ["--version"] `shouldBe` Output versionInfo context "with --info" $ do it "outputs machine readable version information" $ do parseOptions ["--info"] `shouldBe` Output info describe "--verbose" $ do context "without --verbose" $ do it "is not verbose by default" $ do runVerbose <$> parseOptions [] `shouldBe` Result False context "with --verbose" $ do it "parses verbose option" $ do runVerbose <$> parseOptions ["--verbose"] `shouldBe` Result True doctest-0.16.3/test/Orphans.hs0000644000000000000000000000077507346545000014375 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Orphans where import Parse import Location -- The generic form -- -- > deriving instance Show a => Show (Module a) -- -- fails with GHC 7.0.1 due to an overlapping instance (leaked by the GHC API), -- this is why we derive the things we need individually. deriving instance Show (Module String) deriving instance Show (Module [DocTest]) deriving instance Show (Module [Located DocTest]) doctest-0.16.3/test/PackageDBsSpec.hs0000644000000000000000000000543507346545000015520 0ustar0000000000000000module PackageDBsSpec (main, spec) where import Prelude () import Prelude.Compat import qualified Control.Exception as E import Data.List (intercalate) import PackageDBs import System.Directory (getCurrentDirectory, setCurrentDirectory) import System.Environment.Compat import System.FilePath (searchPathSeparator) import Test.Hspec import Test.Mockery.Directory main :: IO () main = hspec spec withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory workingDir action = do E.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do setCurrentDirectory workingDir action withEnv :: String -> String -> IO a -> IO a withEnv k v action = E.bracket save restore $ \_ -> do setEnv k v >> action where save = lookup k <$> getEnvironment restore = maybe (unsetEnv k) (setEnv k) clearEnv :: IO a -> IO a clearEnv = withEnv "GHC_PACKAGE_PATH" "" . withEnv "HASKELL_PACKAGE_SANDBOX" "" . withEnv "HASKELL_PACKAGE_SANDBOXES" "" combineDirs :: [FilePath] -> String combineDirs = intercalate [searchPathSeparator] spec :: Spec spec = around_ clearEnv $ do describe "getPackageDBsFromEnv" $ do context "without a cabal sandbox present" $ do around_ (inTempDirectory) $ do it "uses global and user when no env or sandboxing used" $ do getPackageDBsFromEnv `shouldReturn` PackageDBs True True [] it "respects GHC_PACKAGE_PATH" $ withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo", "bar", ""]) $ do getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["foo", "bar"] it "HASKELL_PACKAGE_SANDBOXES trumps GHC_PACKAGE_PATH" $ withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo1", "bar1", ""]) $ do withEnv "HASKELL_PACKAGE_SANDBOXES" (combineDirs ["foo2", "bar2", ""]) $ do getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["foo2", "bar2"] it "HASKELL_PACKAGE_SANDBOX trumps GHC_PACKAGE_PATH" $ withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo1", "bar1", ""]) $ do withEnv "HASKELL_PACKAGE_SANDBOX" (combineDirs ["foo2"]) $ do getPackageDBsFromEnv `shouldReturn` PackageDBs True True ["foo2"] context "with a cabal sandbox present" $ do around_ (withCurrentDirectory "test/sandbox") $ do it "respects cabal sandboxes" $ do getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["/home/me/doctest-haskell/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"] it "GHC_PACKAGE_PATH takes precedence" $ withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo", "bar"]) $ do getPackageDBsFromEnv `shouldReturn` PackageDBs False False ["foo", "bar"] doctest-0.16.3/test/ParseSpec.hs0000644000000000000000000001342307346545000014642 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module ParseSpec (main, spec) where import Test.Hspec import Data.String import Data.String.Builder (Builder, build) import Control.Monad.Trans.Writer import Parse import Location import Orphans () main :: IO () main = hspec spec group :: Writer [DocTest] () -> Writer [[DocTest]] () group g = tell [execWriter g] ghci :: Expression -> Builder -> Writer [DocTest] () ghci expressions expected = tell [Example expressions $ (map fromString . lines . build) expected] prop_ :: Expression -> Writer [DocTest] () prop_ e = tell [Property e] module_ :: String -> Writer [[DocTest]] () -> Writer [Module [DocTest]] () module_ name gs = tell [Module name Nothing $ execWriter gs] shouldGive :: IO [Module [Located DocTest]] -> Writer [Module [DocTest]] () -> Expectation shouldGive action expected = map (fmap $ map unLoc) `fmap` action `shouldReturn` execWriter expected spec :: Spec spec = do describe "getDocTests" $ do it "extracts properties from a module" $ do getDocTests ["test/parse/property/Fib.hs"] `shouldGive` do module_ "Fib" $ do group $ do prop_ "foo" prop_ "bar" prop_ "baz" it "extracts examples from a module" $ do getDocTests ["test/parse/simple/Fib.hs"] `shouldGive` do module_ "Fib" $ do group $ do ghci "putStrLn \"foo\"" "foo" ghci "putStr \"bar\"" "bar" ghci "putStrLn \"baz\"" "baz" it "extracts examples from documentation for non-exported names" $ do getDocTests ["test/parse/non-exported/Fib.hs"] `shouldGive` do module_ "Fib" $ do group $ do ghci "putStrLn \"foo\"" "foo" ghci "putStr \"bar\"" "bar" ghci "putStrLn \"baz\"" "baz" it "extracts multiple examples from a module" $ do getDocTests ["test/parse/multiple-examples/Foo.hs"] `shouldGive` do module_ "Foo" $ do group $ do ghci "foo" "23" group $ do ghci "bar" "42" it "returns an empty list, if documentation contains no examples" $ do getDocTests ["test/parse/no-examples/Fib.hs"] >>= (`shouldBe` []) it "sets setup code to Nothing, if it does not contain any tests" $ do getDocTests ["test/parse/setup-empty/Foo.hs"] `shouldGive` do module_ "Foo" $ do group $ do ghci "foo" "23" it "keeps modules that only contain setup code" $ do getDocTests ["test/parse/setup-only/Foo.hs"] `shouldGive` do tell [Module "Foo" (Just [Example "foo" ["23"]]) []] describe "parseInteractions (an internal function)" $ do let parse_ = map unLoc . parseInteractions . noLocation . build it "parses an interaction" $ do parse_ $ do ">>> foo" "23" `shouldBe` [("foo", ["23"])] it "drops whitespace as appropriate" $ do parse_ $ do " >>> foo " " 23" `shouldBe` [("foo", ["23"])] it "parses an interaction without a result" $ do parse_ $ do ">>> foo" `shouldBe` [("foo", [])] it "works with a complex example" $ do parse_ $ do "test" "foobar" "" ">>> foo" "23" "" ">>> baz" "" ">>> bar" "23" "" "baz" `shouldBe` [("foo", ["23"]), ("baz", []), ("bar", ["23"])] it "attaches location information to parsed interactions" $ do let loc = Located . Location "Foo.hs" r <- return . parseInteractions . loc 23 . build $ do "1" "2" "" ">>> 4" "5" "" ">>> 7" "" ">>> 9" "10" "" "11" r `shouldBe` [loc 26 $ ("4", ["5"]), loc 29 $ ("7", []), loc 31 $ ("9", ["10"])] it "basic multiline" $ do parse_ $ do ">>> :{ first" " next" "some" ":}" "output" `shouldBe` [(":{ first\n next\nsome\n:}", ["output"])] it "multiline align output" $ do parse_ $ do ">>> :{ first" " :}" " output" `shouldBe` [(":{ first\n:}", ["output"])] it "multiline align output with >>>" $ do parse_ $ do " >>> :{ first" " >>> :}" " output" `shouldBe` [(":{ first\n:}", ["output"])] it "parses wild cards lines" $ do parse_ $ do " >>> action" " foo" " ..." " bar" `shouldBe` [("action", ["foo", WildCardLine, "bar"])] it "parses wild card chunks" $ do parse_ $ do " >>> action" " foo ... bar" `shouldBe` [("action", [ExpectedLine ["foo ", WildCardChunk, " bar"]])] describe " parseProperties (an internal function)" $ do let parse_ = map unLoc . parseProperties . noLocation . build it "parses a property" $ do parse_ $ do "prop> foo" `shouldBe` ["foo"] describe "mkLineChunks (an internal function)" $ do it "replaces ellipsis with WildCardChunks" $ do mkLineChunks "foo ... bar ... baz" `shouldBe` ["foo ", WildCardChunk, " bar ", WildCardChunk, " baz"] it "doesn't replace fewer than 3 consecutive dots" $ do mkLineChunks "foo .. bar .. baz" `shouldBe` ["foo .. bar .. baz"] it "handles leading and trailing dots" $ do mkLineChunks ".. foo bar .." `shouldBe` [".. foo bar .."] it "handles leading and trailing ellipsis" $ do mkLineChunks "... foo bar ..." `shouldBe` [ WildCardChunk , " foo bar " , WildCardChunk ] doctest-0.16.3/test/PropertySpec.hs0000644000000000000000000001241207346545000015411 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module PropertySpec (main, spec) where import Test.Hspec import Data.String.Builder import Property import Interpreter (withInterpreter) main :: IO () main = hspec spec isFailure :: PropertyResult -> Bool isFailure (Failure _) = True isFailure _ = False spec :: Spec spec = do describe "runProperty" $ do it "reports a failing property" $ withInterpreter [] $ \repl -> do runProperty repl "False" `shouldReturn` Failure "*** Failed! 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" $ #if __GLASGOW_HASKELL__ == 702 pendingWith "This triggers a bug in GHC 7.2.*." -- try e.g. -- >>> 23 -- >>> :t is #else -- ghc will include a suggestion (did you mean `id` instead of `is`) in -- the error message withInterpreter [] $ \repl -> do runProperty repl "foldr (+) 0 is == sum (is :: [Int])" `shouldReturn` Success #endif it "runs an explicitly quantified property" $ withInterpreter [] $ \repl -> do runProperty repl "\\xs -> (reverse . reverse) xs == (xs :: [Int])" `shouldReturn` Success it "allows to mix implicit and explicit quantification" $ withInterpreter [] $ \repl -> do runProperty repl "\\x -> x + y == y + x" `shouldReturn` Success it "reports the value for which a property fails" $ withInterpreter [] $ \repl -> do runProperty repl "x == 23" `shouldReturn` Failure "*** Failed! 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.16.3/test/RunSpec.hs0000644000000000000000000001503007346545000014330 0ustar0000000000000000{-# LANGUAGE CPP #-} module RunSpec (main, spec) where import Prelude () import Prelude.Compat import Test.Hspec import System.Exit import qualified Control.Exception as E #if __GLASGOW_HASKELL__ < 707 import System.Cmd #else import System.Process #endif import System.Directory (getCurrentDirectory, setCurrentDirectory, removeDirectoryRecursive) import Data.List.Compat import System.Environment.Compat import System.IO.Silently import System.IO (stderr) import qualified Options import Run doctestWithDefaultOptions :: [String] -> IO Summary doctestWithDefaultOptions = doctestWithOptions Options.defaultFastMode Options.defaultPreserveIt Options.defaultVerbose withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory workingDir action = do E.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do setCurrentDirectory workingDir action rmDir :: FilePath -> IO () rmDir dir = removeDirectoryRecursive dir `E.catch` (const $ return () :: E.IOException -> IO ()) withEnv :: String -> String -> IO a -> IO a withEnv k v action = E.bracket save restore $ \_ -> do setEnv k v >> action where save = lookup k <$> getEnvironment restore = maybe (unsetEnv k) (setEnv k) main :: IO () main = hspec spec spec :: Spec spec = do describe "doctest" $ do it "exits with ExitFailure if at least one test case fails" $ do hSilence [stderr] (doctest ["test/integration/failing/Foo.hs"]) `shouldThrow` (== ExitFailure 1) it "prints help on --help" $ do (r, ()) <- capture (doctest ["--help"]) r `shouldBe` Options.usage it "prints version on --version" $ do (r, ()) <- capture (doctest ["--version"]) lines r `shouldSatisfy` any (isPrefixOf "doctest version ") it "accepts arbitrary GHC options" $ do hSilence [stderr] $ doctest ["-cpp", "-DFOO", "test/integration/test-options/Foo.hs"] it "accepts GHC options with --optghc" $ do hSilence [stderr] $ doctest ["--optghc=-cpp", "--optghc=-DFOO", "test/integration/test-options/Foo.hs"] it "prints a deprecation message for --optghc" $ do (r, _) <- hCapture [stderr] $ doctest ["--optghc=-cpp", "--optghc=-DFOO", "test/integration/test-options/Foo.hs"] lines r `shouldSatisfy` isPrefixOf [ "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options" , "directly." ] it "prints error message on invalid option" $ do (r, e) <- hCapture [stderr] . E.try $ doctest ["--foo", "test/integration/test-options/Foo.hs"] e `shouldBe` Left (ExitFailure 1) r `shouldBe` unlines [ "doctest: unrecognized option `--foo'" , "Try `doctest --help' for more information." ] it "respects HASKELL_PACKAGE_SANDBOX" $ do withCurrentDirectory "test/integration/custom-package-conf/foo" $ do ExitSuccess <- rawSystem "ghc-pkg" ["init", "../packages"] ExitSuccess <- rawSystem "cabal" ["v1-configure", "--disable-optimization", "--disable-library-profiling", "--package-db=../packages"] ExitSuccess <- rawSystem "cabal" ["v1-build"] ExitSuccess <- rawSystem "cabal" ["v1-register", "--inplace"] return () withEnv "HASKELL_PACKAGE_SANDBOX" "test/integration/custom-package-conf/packages" $ do hCapture_ [stderr] (doctest ["test/integration/custom-package-conf/Bar.hs"]) `shouldReturn` "Examples: 2 Tried: 2 Errors: 0 Failures: 0\n" `E.finally` do rmDir "test/integration/custom-package-conf/packages/" rmDir "test/integration/custom-package-conf/foo/dist/" it "prints verbose description of a specification" $ do (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/testSimple/Fib.hs"] r `shouldBe` unlines [ "### Started execution at test/integration/testSimple/Fib.hs:5." , "### example:" , "fib 10" , "### Successful!" , "" , "# Final summary:" , "Examples: 1 Tried: 1 Errors: 0 Failures: 0" ] it "prints verbose description of a property" $ do (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/property-bool/Foo.hs"] 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) r `shouldBe` unlines [ "### Started execution at test/integration/failing/Foo.hs:5." , "### example:" , "23" , "test/integration/failing/Foo.hs:5: failure in expression `23'" , "expected: 42" , " but got: 23" , " ^" , "" , "# Final summary:" , "Examples: 1 Tried: 1 Errors: 0 Failures: 1" ] #if __GLASGOW_HASKELL__ >= 802 it "can deal with potentially problematic GHC options" $ do hSilence [stderr] $ doctest ["-fdiagnostics-color=always", "test/integration/color/Foo.hs"] #endif describe "doctestWithOptions" $ do context "on parse error" $ do let action = withCurrentDirectory "test/integration/parse-error" (doctestWithDefaultOptions ["Foo.hs"]) it "aborts with (ExitFailure 1)" $ do hSilence [stderr] action `shouldThrow` (== ExitFailure 1) it "prints a useful error message" $ do (r, _) <- hCapture [stderr] (E.try action :: IO (Either ExitCode Summary)) #if __GLASGOW_HASKELL__ < 706 r `shouldBe` "\nFoo.hs:6:1: parse error (possibly incorrect indentation)\n" #else #if __GLASGOW_HASKELL__ < 800 r `shouldBe` "\nFoo.hs:6:1:\n parse error (possibly incorrect indentation or mismatched brackets)\n" #else r `shouldBe` "\nFoo.hs:6:1: error:\n parse error (possibly incorrect indentation or mismatched brackets)\n" #endif #endif describe "expandDirs" $ do it "expands a directory" $ do res <- expandDirs "example" sort res `shouldBe` [ "example/src/Example.hs" , "example/test/doctests.hs" ] it "ignores files" $ do res <- expandDirs "doctest.cabal" res `shouldBe` ["doctest.cabal"] it "ignores random things" $ do let x = "foo bar baz bin" res <- expandDirs x res `shouldBe` [x] doctest-0.16.3/test/Runner/0000755000000000000000000000000007346545000013667 5ustar0000000000000000doctest-0.16.3/test/Runner/ExampleSpec.hs0000644000000000000000000001307707346545000016441 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Runner.ExampleSpec (main, spec) where import Prelude () import Prelude.Compat import Data.String import Test.Hspec import Test.Hspec.Core.QuickCheck (modifyMaxSize) import Test.QuickCheck import Parse import Runner.Example main :: IO () main = hspec spec data Line = PlainLine String | WildCardLines [String] deriving (Show, Eq) instance Arbitrary Line where arbitrary = frequency [ (2, PlainLine <$> arbitrary) , (1, WildCardLines . getNonEmpty <$> arbitrary) ] lineToExpected :: [Line] -> ExpectedResult lineToExpected = map $ \x -> case x of PlainLine str -> fromString str WildCardLines _ -> WildCardLine lineToActual :: [Line] -> [String] lineToActual = concatMap $ \x -> case x of PlainLine str -> [str] WildCardLines xs -> xs spec :: Spec spec = do describe "mkResult" $ do it "returns Equal when output matches" $ do property $ \xs -> do mkResult (map fromString xs) xs `shouldBe` Equal it "ignores trailing whitespace" $ do mkResult ["foo\t"] ["foo "] `shouldBe` Equal context "with WildCardLine" $ do it "matches zero lines" $ do mkResult ["foo", WildCardLine, "bar"] ["foo", "bar"] `shouldBe` Equal it "matches first zero line" $ do mkResult [WildCardLine, "foo", "bar"] ["foo", "bar"] `shouldBe` Equal it "matches final zero line" $ do mkResult ["foo", "bar", WildCardLine] ["foo", "bar"] `shouldBe` Equal it "matches an arbitrary number of lines" $ do mkResult ["foo", WildCardLine, "bar"] ["foo", "baz", "bazoom", "bar"] `shouldBe` Equal -- See https://github.com/sol/doctest/issues/259 modifyMaxSize (const 8) $ it "matches an arbitrary number of lines (quickcheck)" $ do property $ \xs -> mkResult (lineToExpected xs) (lineToActual xs) `shouldBe` Equal context "with WildCardChunk" $ do it "matches an arbitrary line chunk" $ do mkResult [ExpectedLine ["foo", WildCardChunk, "bar"]] ["foo baz bar"] `shouldBe` Equal it "matches an arbitrary line chunk at end" $ do mkResult [ExpectedLine ["foo", WildCardChunk]] ["foo baz bar"] `shouldBe` Equal it "does not match at end" $ do mkResult [ExpectedLine [WildCardChunk, "baz"]] ["foo baz bar"] `shouldBe` NotEqual [ "expected: ...baz" , " but got: foo baz bar" , " ^" ] it "does not match at start" $ do mkResult [ExpectedLine ["fuu", WildCardChunk]] ["foo baz bar"] `shouldBe` NotEqual [ "expected: fuu..." , " but got: foo baz bar" , " ^" ] context "when output does not match" $ do it "constructs failure message" $ do mkResult ["foo"] ["bar"] `shouldBe` NotEqual [ "expected: foo" , " but got: bar" , " ^" ] it "constructs failure message for multi-line output" $ do mkResult ["foo", "bar"] ["foo", "baz"] `shouldBe` NotEqual [ "expected: foo" , " bar" , " but got: foo" , " baz" , " ^" ] context "when any output line contains \"unsafe\" characters" $ do it "uses show to format output lines" $ do mkResult ["foo\160bar"] ["foo bar"] `shouldBe` NotEqual [ "expected: foo\\160bar" , " but got: foo bar" , " ^" ] it "insert caret after last matching character on different lengths" $ do mkResult ["foo"] ["fo"] `shouldBe` NotEqual [ "expected: foo" , " but got: fo" , " ^" ] it "insert caret after mismatching line for multi-line output" $ do mkResult ["foo", "bar", "bat"] ["foo", "baz", "bax"] `shouldBe` NotEqual [ "expected: foo" , " bar" , " bat" , " but got: foo" , " baz" , " ^" , " bax" ] it "insert caret after mismatching line with the longest match for multi-line wildcard pattern" $ do mkResult ["foo", WildCardLine, "bar", "bat"] ["foo", "xxx", "yyy", "baz", "bxx"] `shouldBe` NotEqual [ "expected: foo" , " ..." , " bar" , " bat" , " but got: foo" , " xxx" , " yyy" , " baz" , " ^" , " bxx" ] it "insert caret after longest match for wildcard" $ do mkResult [ExpectedLine ["foo ", WildCardChunk, " bar bat"]] ["foo xxx yyy baz bxx"] `shouldBe` NotEqual [ "expected: foo ... bar bat" , " but got: foo xxx yyy baz bxx" , " ^" ] it "show expanded pattern for long matches" $ do mkResult [ExpectedLine ["foo ", WildCardChunk, " bar bat"]] ["foo 123456789 123456789 xxx yyy baz bxx"] `shouldBe` NotEqual [ "expected: foo ... bar bat" , " but got: foo 123456789 123456789 xxx yyy baz bxx" , " foo ........................... ba^" ] doctest-0.16.3/test/RunnerSpec.hs0000644000000000000000000000452407346545000015043 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module RunnerSpec (main, spec) where import Test.Hspec #if __GLASGOW_HASKELL__ < 710 import Data.Monoid #endif import System.IO import System.IO.Silently (hCapture) import Control.Monad.Trans.State import Runner main :: IO () main = hspec spec capture :: Report a -> IO String capture = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 True False mempty) -- like capture, but with interactivity set to False capture_ :: Report a -> IO String capture_ = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 False False mempty) spec :: Spec spec = do describe "report" $ do context "when mode is interactive" $ do it "writes to stderr" $ do capture $ do report "foobar" `shouldReturn` "foobar\n" it "overwrites any intermediate output" $ do capture $ do report_ "foo" report "bar" `shouldReturn` "foo\rbar\n" it "blank out intermediate output if necessary" $ do capture $ do report_ "foobar" report "baz" `shouldReturn` "foobar\rbaz \n" context "when mode is non-interactive" $ do it "writes to stderr" $ do capture_ $ do report "foobar" `shouldReturn` "foobar\n" describe "report_" $ do context "when mode is interactive" $ do it "writes intermediate output to stderr" $ do capture $ do report_ "foobar" `shouldReturn` "foobar" it "overwrites any intermediate output" $ do capture $ do report_ "foo" report_ "bar" `shouldReturn` "foo\rbar" it "blank out intermediate output if necessary" $ do capture $ do report_ "foobar" report_ "baz" `shouldReturn` "foobar\rbaz " context "when mode is non-interactive" $ do it "is ignored" $ do capture_ $ do report_ "foobar" `shouldReturn` "" it "does not influence a subsequent call to `report`" $ do capture_ $ do report_ "foo" report "bar" `shouldReturn` "bar\n" it "does not require `report` to blank out any intermediate output" $ do capture_ $ do report_ "foobar" report "baz" `shouldReturn` "baz\n" doctest-0.16.3/test/SandboxSpec.hs0000644000000000000000000000077607346545000015175 0ustar0000000000000000module SandboxSpec where import Test.Hspec import Sandbox main :: IO () main = hspec spec spec :: Spec spec = do describe "getPackageDbDir" $ do it "parses a config file and extracts package db" $ do pkgDb <- getPackageDbDir "test/sandbox/cabal.sandbox.config" pkgDb `shouldBe` "/home/me/doctest-haskell/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d" it "throws an error if a config file is broken" $ do getPackageDbDir "test/sandbox/bad.config" `shouldThrow` anyException doctest-0.16.3/test/Spec.hs0000644000000000000000000000005407346545000013643 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} doctest-0.16.3/test/UtilSpec.hs0000644000000000000000000000105107346545000014477 0ustar0000000000000000module UtilSpec (main, spec) where import Test.Hspec import Util main :: IO () main = hspec spec spec :: Spec spec = do describe "convertDosLineEndings" $ do it "converts CRLF to LF" $ do convertDosLineEndings "foo\r\nbar\r\nbaz" `shouldBe` "foo\nbar\nbaz" it "strips a trailing CR" $ do convertDosLineEndings "foo\r" `shouldBe` "foo" describe "takeWhileEnd" $ do it "returns the longest suffix of elements that satisfy a given predicate" $ do takeWhileEnd (/= ' ') "foo bar" `shouldBe` "bar" doctest-0.16.3/test/doctests.hs0000644000000000000000000000042207346545000014600 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest [ "-packageghc" , "-isrc" , "-ighci-wrapper/src" , "-idist/build/autogen/" , "-optP-include" , "-optPdist/build/autogen/cabal_macros.h" , "src/Run.hs" , "src/PackageDBs.hs" ] doctest-0.16.3/test/extract/argument-list/0000755000000000000000000000000007346545000016663 5ustar0000000000000000doctest-0.16.3/test/extract/argument-list/Foo.hs0000755000000000000000000000014707346545000017747 0ustar0000000000000000module Foo where foo :: Int -- ^ doc for arg1 -> Int -- ^ doc for arg2 -> Int foo = undefined doctest-0.16.3/test/extract/comment-order/0000755000000000000000000000000007346545000016643 5ustar0000000000000000doctest-0.16.3/test/extract/comment-order/Foo.hs0000755000000000000000000000042107346545000017722 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.16.3/test/extract/declaration/0000755000000000000000000000000007346545000016355 5ustar0000000000000000doctest-0.16.3/test/extract/declaration/Foo.hs0000755000000000000000000000007607346545000017442 0ustar0000000000000000module Foo where -- | Some documentation foo :: Int foo = 23 doctest-0.16.3/test/extract/dos-line-endings/0000755000000000000000000000000007346545000017227 5ustar0000000000000000doctest-0.16.3/test/extract/dos-line-endings/Foo.hs0000755000000000000000000000011007346545000020301 0ustar0000000000000000module Foo where -- | -- foo -- bar -- baz foo :: Int foo = 23 doctest-0.16.3/test/extract/export-list/0000755000000000000000000000000007346545000016362 5ustar0000000000000000doctest-0.16.3/test/extract/export-list/Foo.hs0000755000000000000000000000020107346545000017435 0ustar0000000000000000module Foo ( -- * some heading -- | documentation from export list foo , bar ) where foo :: Int foo = 23 bar :: Int bar = 23 doctest-0.16.3/test/extract/imported-module/0000755000000000000000000000000007346545000017176 5ustar0000000000000000doctest-0.16.3/test/extract/imported-module/Bar.hs0000755000000000000000000000011507346545000020236 0ustar0000000000000000module Bar where import Baz -- | documentation for bar bar :: Int bar = 23 doctest-0.16.3/test/extract/imported-module/Baz.hs0000755000000000000000000000010107346545000020241 0ustar0000000000000000module Baz where -- | documentation for baz baz :: Int baz = 23 doctest-0.16.3/test/extract/module-header/0000755000000000000000000000000007346545000016603 5ustar0000000000000000doctest-0.16.3/test/extract/module-header/Foo.hs0000755000000000000000000000007607346545000017670 0ustar0000000000000000-- | Some documentation module Foo where foo :: Int foo = 23 doctest-0.16.3/test/extract/named-chunks/0000755000000000000000000000000007346545000016445 5ustar0000000000000000doctest-0.16.3/test/extract/named-chunks/Foo.hs0000755000000000000000000000020007346545000017517 0ustar0000000000000000module Foo ( foo , bar ) where -- $foo named chunk foo -- $bar -- named chunk bar foo :: Int foo = 23 bar :: Int bar = 23 doctest-0.16.3/test/extract/regression/0000755000000000000000000000000007346545000016250 5ustar0000000000000000doctest-0.16.3/test/extract/regression/Fixity.hs0000755000000000000000000000005607346545000020064 0ustar0000000000000000module Fixity where foo :: Int foo = 23 + 42 doctest-0.16.3/test/extract/regression/ForeignImport.hs0000755000000000000000000000037707346545000021402 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.16.3/test/extract/regression/ParallelListComp.hs0000755000000000000000000000017007346545000022014 0ustar0000000000000000{-# LANGUAGE ParallelListComp #-} module ParallelListComp where foo :: [Int] foo = [x+y | x <- [1,2,3] | y <- [4,5,6]] doctest-0.16.3/test/extract/regression/ParallelListCompClass.hs0000755000000000000000000000026207346545000023004 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.16.3/test/extract/regression/RewriteRules.hs0000755000000000000000000000023207346545000021240 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.16.3/test/extract/regression/RewriteRulesWithSigs.hs0000755000000000000000000000025607346545000022730 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.16.3/test/extract/setup/0000755000000000000000000000000007346545000015230 5ustar0000000000000000doctest-0.16.3/test/extract/setup/Foo.hs0000755000000000000000000000021107346545000016304 0ustar0000000000000000module Foo where -- $setup -- some setup code -- | foo foo :: Int foo = 42 -- | bar bar :: Int bar = 42 -- | baz baz :: Int baz = 42 doctest-0.16.3/test/extract/th/0000755000000000000000000000000007346545000014503 5ustar0000000000000000doctest-0.16.3/test/extract/th/Bar.hs0000755000000000000000000000010007346545000015535 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Bar where bar = [|23|] doctest-0.16.3/test/extract/th/Foo.hs0000755000000000000000000000015707346545000015570 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Foo where import Bar -- | some documentation foo :: Int foo = $(bar) doctest-0.16.3/test/extract/type-class-args/0000755000000000000000000000000007346545000017106 5ustar0000000000000000doctest-0.16.3/test/extract/type-class-args/Foo.hs0000755000000000000000000000014407346545000020167 0ustar0000000000000000module Foo where class Foo a where bar :: a -- ^ foo -> Int -- ^ bar -> String doctest-0.16.3/test/extract/type-class/0000755000000000000000000000000007346545000016154 5ustar0000000000000000doctest-0.16.3/test/extract/type-class/Foo.hs0000755000000000000000000000015507346545000017237 0ustar0000000000000000module Foo where class ToString a where -- | Convert given value to a string. toString :: a -> String doctest-0.16.3/test/extract/type-families/0000755000000000000000000000000007346545000016640 5ustar0000000000000000doctest-0.16.3/test/extract/type-families/Foo.hs0000755000000000000000000000013707346545000017723 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} module Foo where type family Foo a type instance Foo Int = Int doctest-0.16.3/test/integration/bugfixImportHierarchical/0000755000000000000000000000000007346545000021717 5ustar0000000000000000doctest-0.16.3/test/integration/bugfixImportHierarchical/ModuleA.hs0000755000000000000000000000010207346545000023575 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import Foo.ModuleB doctest-0.16.3/test/integration/bugfixImportHierarchical/ModuleB.hs0000755000000000000000000000023407346545000023604 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.16.3/test/integration/bugfixMultipleModules/0000755000000000000000000000000007346545000021272 5ustar0000000000000000doctest-0.16.3/test/integration/bugfixMultipleModules/ModuleA.hs0000755000000000000000000000007607346545000023162 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import ModuleB doctest-0.16.3/test/integration/bugfixMultipleModules/ModuleB.hs0000755000000000000000000000035007346545000023156 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.16.3/test/integration/bugfixOutputToStdErr/0000755000000000000000000000000007346545000021075 5ustar0000000000000000doctest-0.16.3/test/integration/bugfixOutputToStdErr/Fib.hs0000755000000000000000000000027407346545000022137 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.16.3/test/integration/bugfixWorkingDirectory/0000755000000000000000000000000007346545000021453 5ustar0000000000000000doctest-0.16.3/test/integration/bugfixWorkingDirectory/Fib.hs0000755000000000000000000000022407346545000022510 0ustar0000000000000000module Fib where -- | Calculate Fibonacci number of given 'Num'. -- -- >>> bar -- 10 fib :: (Num t, Num t1) => t -> t1 fib _ = undefined bar = 10 doctest-0.16.3/test/integration/bugfixWorkingDirectory/description0000755000000000000000000000031207346545000023720 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.16.3/test/integration/bugfixWorkingDirectory/examples/0000755000000000000000000000000007346545000023271 5ustar0000000000000000doctest-0.16.3/test/integration/bugfixWorkingDirectory/examples/Fib.hs0000755000000000000000000000042507346545000024331 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.16.3/test/integration/color/0000755000000000000000000000000007346545000016057 5ustar0000000000000000doctest-0.16.3/test/integration/color/Foo.hs0000755000000000000000000000037107346545000017142 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.16.3/test/integration/custom-package-conf/0000755000000000000000000000000007346545000020567 5ustar0000000000000000doctest-0.16.3/test/integration/custom-package-conf/Bar.hs0000755000000000000000000000013207346545000021626 0ustar0000000000000000module Bar where import Foo -- | -- >>> import Foo -- >>> foo -- 23 bar :: Int bar = 42 doctest-0.16.3/test/integration/custom-package-conf/foo/0000755000000000000000000000000007346545000021352 5ustar0000000000000000doctest-0.16.3/test/integration/custom-package-conf/foo/Foo.hs0000755000000000000000000000004507346545000022433 0ustar0000000000000000module Foo where foo :: Int foo = 23 doctest-0.16.3/test/integration/custom-package-conf/foo/doctest-foo.cabal0000755000000000000000000000023207346545000024564 0ustar0000000000000000name: doctest-foo version: 0.0.0 build-type: Simple cabal-version: >= 1.8 library exposed-modules: Foo build-depends: base doctest-0.16.3/test/integration/dos-line-endings/0000755000000000000000000000000007346545000020100 5ustar0000000000000000doctest-0.16.3/test/integration/dos-line-endings/Fib.hs0000755000000000000000000000024507346545000021140 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.16.3/test/integration/failing-multiple/0000755000000000000000000000000007346545000020203 5ustar0000000000000000doctest-0.16.3/test/integration/failing-multiple/Foo.hs0000755000000000000000000000021507346545000021263 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> 23 -- 23 -- -- >>> 23 -- 42 -- -- >>> 23 -- 23 -- >>> 23 -- 23 test :: a test = undefined doctest-0.16.3/test/integration/failing/0000755000000000000000000000000007346545000016352 5ustar0000000000000000doctest-0.16.3/test/integration/failing/Foo.hs0000755000000000000000000000012707346545000017434 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> 23 -- 42 test :: a test = undefined doctest-0.16.3/test/integration/it/0000755000000000000000000000000007346545000015355 5ustar0000000000000000doctest-0.16.3/test/integration/it/Foo.hs0000755000000000000000000000026007346545000016435 0ustar0000000000000000module Foo where -- | -- -- >>> :t 'a' -- 'a' :: Char -- -- >>> "foo" -- "foo" -- -- >>> length it -- 3 -- -- >>> it * it -- 9 -- -- >>> :t it -- it :: Int -- foo = undefined doctest-0.16.3/test/integration/it/Setup.hs0000755000000000000000000000031007346545000017006 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.16.3/test/integration/multiline/0000755000000000000000000000000007346545000016743 5ustar0000000000000000doctest-0.16.3/test/integration/multiline/Multiline.hs0000755000000000000000000000114207346545000021242 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.16.3/test/integration/parse-error/0000755000000000000000000000000007346545000017202 5ustar0000000000000000doctest-0.16.3/test/integration/parse-error/Foo.hs0000755000000000000000000000007307346545000020264 0ustar0000000000000000module Foo where -- | Some documentation foo :: Int foo = doctest-0.16.3/test/integration/property-bool-with-type-signature/0000755000000000000000000000000007346545000023505 5ustar0000000000000000doctest-0.16.3/test/integration/property-bool-with-type-signature/Foo.hs0000755000000000000000000000007507346545000024571 0ustar0000000000000000module Foo where -- | -- prop> True :: Bool foo = undefined doctest-0.16.3/test/integration/property-bool/0000755000000000000000000000000007346545000017556 5ustar0000000000000000doctest-0.16.3/test/integration/property-bool/Foo.hs0000755000000000000000000000006507346545000020641 0ustar0000000000000000module Foo where -- | -- prop> True foo = undefined doctest-0.16.3/test/integration/property-failing/0000755000000000000000000000000007346545000020234 5ustar0000000000000000doctest-0.16.3/test/integration/property-failing/Foo.hs0000755000000000000000000000007307346545000021316 0ustar0000000000000000module Foo where -- | -- prop> abs x == x foo = undefined doctest-0.16.3/test/integration/property-implicitly-quantified/0000755000000000000000000000000007346545000023131 5ustar0000000000000000doctest-0.16.3/test/integration/property-implicitly-quantified/Foo.hs0000755000000000000000000000010507346545000024207 0ustar0000000000000000module Foo where -- | -- prop> abs x == abs (abs x) foo = undefined doctest-0.16.3/test/integration/property-quantified/0000755000000000000000000000000007346545000020754 5ustar0000000000000000doctest-0.16.3/test/integration/property-quantified/Foo.hs0000755000000000000000000000011307346545000022031 0ustar0000000000000000module Foo where -- | -- prop> \x -> abs x == abs (abs x) foo = undefined doctest-0.16.3/test/integration/property-setup/0000755000000000000000000000000007346545000017763 5ustar0000000000000000doctest-0.16.3/test/integration/property-setup/Foo.hs0000755000000000000000000000024507346545000021046 0ustar0000000000000000module Foo where -- $setup -- >>> import Test.QuickCheck -- >>> let arbitraryEven = (* 2) `fmap` arbitrary -- | -- prop> forAll arbitraryEven even foo = undefined doctest-0.16.3/test/integration/setup-skip-on-failure/0000755000000000000000000000000007346545000021104 5ustar0000000000000000doctest-0.16.3/test/integration/setup-skip-on-failure/Foo.hs0000755000000000000000000000017707346545000022173 0ustar0000000000000000module Foo where -- $setup -- >>> x -- 23 -- | -- >>> foo -- 42 foo :: Int foo = 42 -- | -- >>> y -- 42 bar :: Int bar = 42 doctest-0.16.3/test/integration/setup/0000755000000000000000000000000007346545000016101 5ustar0000000000000000doctest-0.16.3/test/integration/setup/Foo.hs0000755000000000000000000000014407346545000017162 0ustar0000000000000000module Foo where -- $setup -- >>> let x = 23 :: Int -- | -- >>> x + foo -- 65 foo :: Int foo = 42 doctest-0.16.3/test/integration/template-haskell-bugfix/0000755000000000000000000000000007346545000021457 5ustar0000000000000000doctest-0.16.3/test/integration/template-haskell-bugfix/Main.hs0000755000000000000000000000042707346545000022705 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.16.3/test/integration/template-haskell-bugfix/Printf.hs0000755000000000000000000000077507346545000023271 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.16.3/test/integration/template-haskell/0000755000000000000000000000000007346545000020175 5ustar0000000000000000doctest-0.16.3/test/integration/template-haskell/Foo.hs0000755000000000000000000000061407346545000021260 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.16.3/test/integration/test-options/0000755000000000000000000000000007346545000017411 5ustar0000000000000000doctest-0.16.3/test/integration/test-options/Foo.hs0000755000000000000000000000015607346545000020475 0ustar0000000000000000module Foo where -- | -- Examples: -- -- >>> foo -- 23 foo :: Int #ifdef FOO foo = 23 #else foo = 42 #endif doctest-0.16.3/test/integration/testBlankline/0000755000000000000000000000000007346545000017540 5ustar0000000000000000doctest-0.16.3/test/integration/testBlankline/Fib.hs0000755000000000000000000000026307346545000020600 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.16.3/test/integration/testCPP/0000755000000000000000000000000007346545000016263 5ustar0000000000000000doctest-0.16.3/test/integration/testCPP/Foo.hs0000755000000000000000000000015607346545000017347 0ustar0000000000000000module Foo where -- | -- Examples: -- -- >>> foo -- 23 foo :: Int #ifdef FOO foo = 23 #else foo = 42 #endif doctest-0.16.3/test/integration/testCombinedExample/0000755000000000000000000000000007346545000020675 5ustar0000000000000000doctest-0.16.3/test/integration/testCombinedExample/Fib.hs0000755000000000000000000000046607346545000021742 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.16.3/test/integration/testCommentLocation/0000755000000000000000000000000007346545000020734 5ustar0000000000000000doctest-0.16.3/test/integration/testCommentLocation/Foo.hs0000755000000000000000000000260307346545000022017 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.16.3/test/integration/testDocumentationForArguments/0000755000000000000000000000000007346545000023007 5ustar0000000000000000doctest-0.16.3/test/integration/testDocumentationForArguments/Fib.hs0000755000000000000000000000014607346545000024047 0ustar0000000000000000module Fib where fib :: Int -- ^ -- >>> 23 -- 23 -> Int fib _ = undefined doctest-0.16.3/test/integration/testFailOnMultiline/0000755000000000000000000000000007346545000020674 5ustar0000000000000000doctest-0.16.3/test/integration/testFailOnMultiline/Fib.hs0000755000000000000000000000034707346545000021737 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.16.3/test/integration/testImport/0000755000000000000000000000000007346545000017113 5ustar0000000000000000doctest-0.16.3/test/integration/testImport/ModuleA.hs0000755000000000000000000000007607346545000021003 0ustar0000000000000000-- | -- >>> fib 10 -- 55 module ModuleA where import ModuleB doctest-0.16.3/test/integration/testImport/ModuleB.hs0000755000000000000000000000023007346545000020774 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.16.3/test/integration/testPutStr/0000755000000000000000000000000007346545000017102 5ustar0000000000000000doctest-0.16.3/test/integration/testPutStr/Fib.hs0000755000000000000000000000032107346545000020135 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.16.3/test/integration/testSimple/0000755000000000000000000000000007346545000017072 5ustar0000000000000000doctest-0.16.3/test/integration/testSimple/Fib.hs0000755000000000000000000000023307346545000020127 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.16.3/test/integration/trailing-whitespace/0000755000000000000000000000000007346545000020704 5ustar0000000000000000doctest-0.16.3/test/integration/trailing-whitespace/Foo.hs0000755000000000000000000000014707346545000021770 0ustar0000000000000000module Foo where -- | A failing example -- -- >>> putStrLn "foo " -- foo test :: a test = undefined doctest-0.16.3/test/integration/with-cbits/0000755000000000000000000000000007346545000017016 5ustar0000000000000000doctest-0.16.3/test/integration/with-cbits/Bar.hs0000755000000000000000000000020507346545000020056 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module Bar where import Foreign.C -- | -- >>> foo -- 23 foreign import ccall foo :: CInt doctest-0.16.3/test/integration/with-cbits/foo.c0000644000000000000000000000003307346545000017741 0ustar0000000000000000int foo() { return 23; } doctest-0.16.3/test/integration/with-cbits/foo.c0000755000000000000000000000003307346545000017744 0ustar0000000000000000int foo() { return 23; } doctest-0.16.3/test/parse/multiple-examples/0000755000000000000000000000000007346545000017177 5ustar0000000000000000doctest-0.16.3/test/parse/multiple-examples/Foo.hs0000755000000000000000000000012107346545000020253 0ustar0000000000000000module Foo where -- | -- >>> foo -- 23 foo = 23 -- | -- >>> bar -- 42 bar = 42 doctest-0.16.3/test/parse/no-examples/0000755000000000000000000000000007346545000015760 5ustar0000000000000000doctest-0.16.3/test/parse/no-examples/Fib.hs0000755000000000000000000000020607346545000017015 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- @ -- some code -- @ -- -- foobar 23 fib :: Int -> Int -> Int fib _ = undefined doctest-0.16.3/test/parse/non-exported/0000755000000000000000000000000007346545000016152 5ustar0000000000000000doctest-0.16.3/test/parse/non-exported/Fib.hs0000755000000000000000000000035407346545000017213 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.16.3/test/parse/property/0000755000000000000000000000000007346545000015414 5ustar0000000000000000doctest-0.16.3/test/parse/property/Fib.hs0000755000000000000000000000026407346545000016455 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.16.3/test/parse/setup-empty/0000755000000000000000000000000007346545000016024 5ustar0000000000000000doctest-0.16.3/test/parse/setup-empty/Foo.hs0000755000000000000000000000013207346545000017102 0ustar0000000000000000module Foo where -- $setup -- some setup code -- | -- >>> foo -- 23 foo :: Int foo = 23 doctest-0.16.3/test/parse/setup-only/0000755000000000000000000000000007346545000015647 5ustar0000000000000000doctest-0.16.3/test/parse/setup-only/Foo.hs0000755000000000000000000000013207346545000016725 0ustar0000000000000000module Foo where -- $setup -- >>> foo -- 23 -- | some documentation foo :: Int foo = 23 doctest-0.16.3/test/parse/simple/0000755000000000000000000000000007346545000015021 5ustar0000000000000000doctest-0.16.3/test/parse/simple/Fib.hs0000755000000000000000000000027207346545000016061 0ustar0000000000000000module Fib where -- | Calculate Fibonacci numbers. -- -- >>> putStrLn "foo" -- foo -- >>> putStr "bar" -- bar -- -- >>> putStrLn "baz" -- baz fib :: Int -> Int -> Int fib _ = undefined doctest-0.16.3/test/sandbox/0000755000000000000000000000000007346545000014054 5ustar0000000000000000doctest-0.16.3/test/sandbox/bad.config0000755000000000000000000000000607346545000015770 0ustar0000000000000000brokendoctest-0.16.3/test/sandbox/cabal.sandbox.config0000755000000000000000000000166107346545000017751 0ustar0000000000000000-- This is a Cabal package environment file. -- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY. -- Please create a 'cabal.config' file in the same directory -- if you want to change the default settings for this sandbox. local-repo: /home/me/doctest-haskell/.cabal-sandbox/packages logs-dir: /home/me/doctest-haskell/.cabal-sandbox/logs world-file: /home/me/doctest-haskell/.cabal-sandbox/world user-install: False package-db: /home/me/doctest-haskell/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d build-summary: /home/me/doctest-haskell/.cabal-sandbox/logs/build.log install-dirs prefix: /home/me/doctest-haskell/.cabal-sandbox bindir: $prefix/bin libdir: $prefix/lib libsubdir: $arch-$os-$compiler/$pkgid libexecdir: $prefix/libexec datadir: $prefix/share datasubdir: $arch-$os-$compiler/$pkgid docdir: $datadir/doc/$arch-$os-$compiler/$pkgid htmldir: $docdir/html haddockdir: $htmldir sysconfdir: $prefix/etc