packages feed

DocTest 0.0.6 → 0.1.0

raw patch · 33 files changed

+926/−181 lines, 33 filesdep +containersdep +ghcdep +ghc-pathsdep −directorydep −filepathdep −haskell-srcdep ~HUnitdep ~basedep ~process

Dependencies added: containers, ghc, ghc-paths, haddock

Dependencies removed: directory, filepath, haskell-src, parsec

Dependency ranges changed: HUnit, base, process

Files

DocTest.cabal view
@@ -1,5 +1,5 @@ name:                DocTest-version:             0.0.6+version:             0.1.0 stability:           experimental synopsis:            Test interactive Haskell examples description:         DocTest checks examples in source code comments.@@ -16,23 +16,52 @@ build-type:          Simple cabal-version:       >= 1.6 +extra-source-files:+    DocTest.cabal+    LICENSE+    Setup.lhs+    tests/run.sh+    tests/TestInterpreter.hs+    tests/runtests.sh+    tests/Main.hs+    tests/bugfixMultipleStatements/Fib.hs+    tests/testImport/ModuleB.hs+    tests/testImport/ModuleA.hs+    tests/run_interpreter_tests.sh+    tests/bugfixMultipleModules/ModuleB.hs+    tests/bugfixMultipleModules/ModuleA.hs+    tests/selftest.sh+    tests/testCommentLocation/Foo.hs+    tests/runtests.bat+    tests/bugfixOutputToStdErr/Fib.hs+    tests/testFailOnMultiline/Fib.hs+    tests/testPutStr/Fib.hs+    tests/bugfixWorkingDirectory/examples/Fib.hs+    tests/bugfixWorkingDirectory/description+    tests/bugfixWorkingDirectory/Fib.hs+    tests/bugfixImportHierarchical/ModuleB.hs+    tests/bugfixImportHierarchical/ModuleA.hs+    tests/Util.hs+ source-repository head     type:            git     location:        http://code.haskell.org/~sih/code/DocTest.git/  executable doctest+    ghc-options:     -Wall+    hs-source-dirs:  src     main-is:         Main.hs     other-modules:-                       Test.DocTest-                     , Test.DocTest.Error-                     , Test.DocTest.Parser-                     , Test.DocTest.Util+                      Interpreter+                    , Options+                    , HaddockBackend.Api+                    , HaddockBackend.Markup      build-depends:-                       base >= 3 && < 5-                     , HUnit-                     , parsec-                     , haskell-src-                     , directory-                     , filepath-                     , process+                       base      >= 4.0.0.0 && < 4.3.0.0+                     , containers == 0.3.*+                     , HUnit     == 1.2.*+                     , process   == 1.0.*+                     , haddock   == 2.8.*+                     , ghc-paths == 0.1.*+                     , ghc       == 6.12.*
− Main.hs 
@@ -1,12 +0,0 @@-module Main where--import System.Environment-import Test.DocTest-import Test.DocTest.Parser-import Test.HUnit--main = do-	args <- getArgs-	docTests <- mapM parseModule args-	tests <- mapM docTestToTestCase (concat docTests)-	runTestTT (TestList tests)
− Test/DocTest.hs 
@@ -1,47 +0,0 @@--- Copyright (c) 2009 Simon Hengel <simon.hengel@web.de>-module Test.DocTest where--import Test.HUnit-import System.FilePath-import System.Directory-import Test.DocTest.Util-import System.Process---data DocTest = DocTest {-	  source		:: String-	, _module		:: String-	, expression	:: String-	, result		:: String-	}-	deriving (Show)---_testModule :: DocTest -> String-_testModule (DocTest source _module expression result) =-	"import " ++ _module  ++ "\n" ++-	"main = do\n" ++-	"    putStr (show (" ++ expression ++ "))\n"--docTestToTestCase :: DocTest -> IO Test-docTestToTestCase test = do-	canonicalModulePath <- canonicalizePath $ source test-	let baseDir = packageBaseDir canonicalModulePath (_module test)--	ret <- readProcess "runhaskell" ["-i" ++ baseDir] (_testModule test)-	return (TestCase (assertEqual (source test) (result test) ret))------ Maps a given source file and a corresponding module name to the base--- directory of the package.------ Example:--- > packageBaseDir "/foo/bar/MyPackage/MyModule.hs" "MyPackage.MyModule"--- "/foo/bar/"---- > packageBaseDir "foo" "bar"--- "foo*** Exception: Prelude.undefined--packageBaseDir :: FilePath -> String -> FilePath-packageBaseDir moduleSrcFile moduleName = stripPostfix (dropExtension moduleSrcFile) (replace "." [pathSeparator] moduleName)
− Test/DocTest/Error.hs 
@@ -1,27 +0,0 @@-module Test.DocTest.Error where--import Data.List-import Language.Haskell.Syntax-import Text.ParserCombinators.Parsec-import Text.ParserCombinators.Parsec.Error--data Error = Error {-	  location	:: SrcLoc-	, message	:: String-	}--instance Show Error where-	show (Error (SrcLoc filename line column) message) = intercalate ":" [filename, show line, show column, " " ++ message]--reportError :: Error -> a-reportError e = error (show e)---_showErrorMessages = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input"---toSrcLoc :: SourcePos -> SrcLoc-toSrcLoc x = SrcLoc (sourceName x) (sourceLine x) (sourceColumn x)--toError :: ParseError -> Error-toError e = Error (toSrcLoc (errorPos e)) (_showErrorMessages (errorMessages e))
− Test/DocTest/Parser.hs 
@@ -1,59 +0,0 @@-module Test.DocTest.Parser (parseModule) where--import System.IO-import Language.Haskell.Parser hiding (parseModule)-import Language.Haskell.Syntax-import Text.ParserCombinators.Parsec-import Test.DocTest-import Test.DocTest.Error-import Data.List--parseModule :: FilePath -> IO [DocTest]-parseModule fileName = do-	moduleSource <- readFile fileName--	let moduleName =-		case (parseModuleWithMode (ParseMode fileName) moduleSource) of-			ParseFailed l m								-> reportError (Error l m)-			ParseOk (HsModule _ (Module name) _ _ _)	-> name--	docTests <--		case (parse manyTestsParser fileName moduleSource) of-			--Left  e -> error ("parse error at " ++ show e)-			Left  e	-> reportError (toError e)-			Right x	-> return x--	return-		(-			map-			(\(expression, result) -> DocTest fileName moduleName expression result)-			docTests-		)---- Parser--tillEndOfLine :: Parser String-tillEndOfLine = manyTill anyChar newline--commentLine :: Parser String-commentLine = do-	{-		  string "-- "-		; tillEndOfLine-	}--commentLines :: Parser [String]-commentLines = many1 commentLine--docTestStart = string "-- > "--singelTestParser :: Parser (String, String) -singelTestParser = do-	{-		  manyTill anyChar (try docTestStart)-		; expression	<- tillEndOfLine-		; result		<- commentLines-		; return (expression, (intercalate "\n" result))-	}--manyTestsParser = (many (try singelTestParser))
− Test/DocTest/Util.hs 
@@ -1,24 +0,0 @@-module Test.DocTest.Util where--import Data.List----- Source: Posted from Chaddaï Fouché to Haskell-Cafe mailing list.------ Example:--- > replace "." "/" "Foo.Bar.Baz"--- "Foo/Bar/Baz"-replace :: (Eq a) => [a] -> [a] -> [a] -> [a]-replace _ _ [] = []-replace old new xs@(y:ys) =-	case stripPrefix old xs of-		Nothing -> y : replace old new ys-		Just ys' -> new ++ replace old new ys' -----removePost :: [a] -> [a] -> [a]--stripPostfix [] ys = undefined-stripPostfix (x:xs) ys-	| xs == ys	= [x]-	| otherwise	= x : (stripPostfix xs ys)
+ src/HaddockBackend/Api.hs view
@@ -0,0 +1,57 @@+module HaddockBackend.Api (+  DocTest(..)+, Interaction(..)+, getDocTests+) where++import Module (moduleName, moduleNameString)+import HaddockBackend.Markup (examplesFromInterface)++import Documentation.Haddock(+    Interface(ifaceMod, ifaceOrigFilename)+  , exampleExpression+  , exampleResult+  , createInterfaces+  , Flag+  )+++data DocTest = DocExample {+    source        :: String -- ^ source file+  , module_       :: String -- ^ originating module+  , interactions  :: [Interaction]+} deriving Show+++data Interaction = Interaction {+    expression :: String    -- ^ example expression+  , result     :: [String]  -- ^ expected result+} deriving Show+++-- | Extract 'DocTest's+getDocTests :: [Flag]       -- ^ list of Haddock command-line flags+            -> [String]     -- ^ file or module names+            -> IO [DocTest] -- ^ extracted 'DocTest's+getDocTests flags modules = do+  interfaces <- createInterfaces flags modules+  return $ concat $ map docTestsFromInterface interfaces+++-- | Get name of the module, that is  associated with given 'Interface'+moduleNameFromInterface :: Interface -> String+moduleNameFromInterface = moduleNameString . moduleName . ifaceMod+++-- | Get 'DocTest's from 'Interface'.+docTestsFromInterface :: Interface -> [DocTest]+docTestsFromInterface interface = map docTestFromExamples listOfExamples+  where+    listOfExamples    = examplesFromInterface interface+    moduleName' = moduleNameFromInterface interface+    fileName    = ifaceOrigFilename interface+    docTestFromExamples examples =+      DocExample fileName moduleName' $ map interactionFromExample examples+      where+        interactionFromExample e =+          Interaction (exampleExpression e) (exampleResult e)
+ src/HaddockBackend/Markup.hs view
@@ -0,0 +1,72 @@+module HaddockBackend.Markup (examplesFromInterface) where++import Name (Name)+import qualified Data.Map as Map+import Data.Map (Map)+import Documentation.Haddock (+    markup+  , DocMarkup(..)+  , Interface(ifaceRnDocMap, ifaceRnExportItems, ifaceRnDoc)+  , Example+  , DocForDecl+  , Doc+  , DocName+  , ExportItem(ExportDoc)+  )++-- | Extract all 'Example's from given 'Interface'.+examplesFromInterface :: Interface -> [[Example]]+examplesFromInterface interface =+  fromModuleHeader ++ fromExportItems ++ fromDeclarations+  where+    fromModuleHeader = case ifaceRnDoc interface of+      Just doc  -> extract doc+      Nothing   -> []+    fromExportItems =+      concatMap extractFromExportItem . ifaceRnExportItems $ interface+      where+        extractFromExportItem (ExportDoc doc) = extract doc+        extractFromExportItem _ = []+    fromDeclarations = fromDeclMap $ ifaceRnDocMap interface++fromDeclMap :: Map Name (DocForDecl DocName) -> [[Example]]+fromDeclMap docMap = concatMap docForDeclName $ Map.elems docMap++docForDeclName :: DocForDecl name -> [[Example]]+docForDeclName (declDoc, argsDoc)  = declExamples ++ argsExamples+  where+    declExamples = extractFromMap argsDoc+    argsExamples = extractFromMaybe declDoc++extractFromMaybe :: Maybe (Doc name) -> [[Example]]+extractFromMaybe (Just doc) = extract doc+extractFromMaybe Nothing    = []++extractFromMap :: Map key (Doc name) -> [[Example]]+extractFromMap m = concatMap extract $ Map.elems m++-- | Extract all 'Example's from given 'Doc' node.+extract :: Doc name -> [[Example]]+extract = markup exampleMarkup+  where+    exampleMarkup :: DocMarkup name [[Example]]+    exampleMarkup = Markup {+      markupEmpty         = [],+      markupString        = const [],+      markupParagraph     = id,+      markupAppend        = (++),+      markupIdentifier    = const [],+      markupModule        = const [],+      markupEmphasis      = id,+      markupMonospaced    = id,+      markupUnorderedList = concat,+      markupOrderedList   = concat,+      markupDefList       = concat . map combineTuple,+      markupCodeBlock     = id,+      markupURL           = const [],+      markupAName         = const [],+      markupPic           = const [],+      markupExample       = return+      }+      where+        combineTuple = uncurry (++)
+ src/Interpreter.hs view
@@ -0,0 +1,128 @@+module Interpreter (+  Interpreter+, eval+, withInterpreter+) where++import System.IO+import System.Process+import Control.Exception (bracket)+import Data.Char+import Data.List++import GHC.Paths (ghc)++-- | 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"++data Interpreter = Interpreter {+    hIn  :: Handle+  , hOut :: Handle+  }++newInterpreter :: [String] -> IO Interpreter+newInterpreter flags = do+  (Just stdin_, Just stdout_, Nothing, _) <- createProcess $ (proc ghc myFlags) {std_in = CreatePipe, std_out = CreatePipe, std_err = UseHandle stdout}+  setMode stdin_+  setMode stdout_+  return Interpreter {hIn = stdin_, hOut = stdout_}+  where+    myFlags = ["-v0", "--interactive", "-ignore-dot-ghci"] ++ flags++    setMode handle = do+      hSetBinaryMode handle False+      hSetBuffering handle LineBuffering+      hSetEncoding handle utf8+++-- | 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 = bracket (newInterpreter flags) closeInterpreter+++closeInterpreter :: Interpreter -> IO ()+closeInterpreter repl = do+  hClose $ hIn repl+  hClose $ hOut repl+++putExpression :: Interpreter -> String -> IO ()+putExpression repl e = do+  hPutStrLn stdin_ $ filterExpression e+  hPutStrLn stdin_ marker+  hFlush stdin_+  return ()+  where+    stdin_ = hIn repl+++-- | Fail on unterminated multiline commands.+--+-- Examples:+--+-- >>> filterExpression ""+-- ""+--+-- >>> filterExpression "foobar"+-- "foobar"+--+-- >>> filterExpression ":{"+-- "*** Exception: unterminated multiline command+--+-- >>> filterExpression "  :{  "+-- "*** Exception: unterminated multiline command+--+-- >>> filterExpression "  :{  \nfoobar"+-- "*** Exception: unterminated multiline command+--+-- >>> filterExpression "  :{  \nfoobar \n  :}  "+-- "  :{  \nfoobar \n  :}  "+--+filterExpression :: String -> String+filterExpression e =+  case lines e of+    [] -> e+    l  -> if firstLine == ":{" && lastLine /= ":}" then fail_ else e+      where+        firstLine = strip $ head l+        lastLine  = strip $ last l+        fail_ = error "unterminated multiline command"+  where+    strip :: String -> String+    strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse+++getResult :: Interpreter -> IO String+getResult repl = do+  line <- hGetLine stdout_+  if isSuffixOf marker line+    then+      return $ stripMarker line+    else do+      result <- getResult repl+      return $ line ++ '\n' : result+  where+    stdout_ = hOut repl+    stripMarker l = take (length l - length marker) l++-- | Evaluate an expresion+eval+  :: Interpreter+  -> String       -- Expression+  -> IO String    -- Result+eval repl expr = do+  putExpression repl expr+  getResult repl
+ src/Main.hs view
@@ -0,0 +1,45 @@+module Main where++import Test.HUnit (runTestTT, Test(..), assertEqual)++import HaddockBackend.Api+import Options++import qualified Interpreter++main :: IO ()+main = do+  (options, files) <- getOptions+  let ghciArgs = ghcOptions options ++ files+  Interpreter.withInterpreter ghciArgs $ \repl -> do++    -- get examples from Haddock comments+    let haddockFlags = haddockOptions options+    docTests <- getDocTests haddockFlags files++    if DumpOnly `elem` options+      then do+        -- dump to stdout+        print docTests+      else do+        -- map to unit tests+        let tests = TestList $ map (toTestCase repl) docTests+        _ <- runTestTT tests+        return ()++toTestCase :: Interpreter.Interpreter -> DocTest -> Test+toTestCase repl test = TestLabel sourceFile $ TestCase $ do+  -- bring module into scope before running tests..+  _ <- Interpreter.eval repl $ ":m *" ++ moduleName+  _ <- Interpreter.eval repl $ ":reload"+  mapM_ interactionToAssertion $ interactions test+  where+    moduleName = module_ test+    sourceFile = source test+    interactionToAssertion x = do+      result' <- Interpreter.eval repl exampleExpression+      assertEqual ("expression `" ++ exampleExpression ++ "'")+        exampleResult $ lines result'+      where+        exampleExpression = expression x+        exampleResult     = result x
+ src/Options.hs view
@@ -0,0 +1,77 @@+module Options (+  Option(..)+, getOptions+, ghcOptions+, haddockOptions+) where++import Control.Monad (when)+import System.Environment (getArgs)+import System.Exit++import System.Console.GetOpt++import qualified Documentation.Haddock as Haddock+++data Option = Help+            | Verbose+            | GhcOption String+            | DumpOnly+            deriving (Show, Eq)+++documentedOptions :: [OptDescr Option]+documentedOptions = [+    Option []     ["help"]        (NoArg Help)                    "display this help and exit"+  , Option ['v']  ["verbose"]     (NoArg Verbose)                 "explain what is being done, enable Haddock warnings"+  , Option []     ["optghc"]      (ReqArg GhcOption "OPTION")     "option to be forwarded to GHC"+  ]++undocumentedOptions :: [OptDescr Option]+undocumentedOptions = [+    Option []     ["dump-only"]   (NoArg DumpOnly)                "dump extracted test cases to stdout"+  ]+++getOptions :: IO ([Option], [String])+getOptions = do+  args  <- getArgs+  let (options, modules, errors) = getOpt Permute (documentedOptions ++ undocumentedOptions) args++  when (Help `elem` options)+    (printAndExit usage)++  when ((not . null) errors)+    (tryHelp $ head errors)++  when (null modules)+    (tryHelp "no input files\n")++  return (options, modules)+  where+    printAndExit :: String -> IO a+    printAndExit s = putStr s >> exitWith ExitSuccess++    usage = usageInfo "Usage: doctest [OPTION]... MODULE...\n" documentedOptions++    tryHelp message = printAndExit $ "doctest: " ++ message+      ++ "Try `doctest --help' for more information.\n"+++-- | Extract all ghc options from given list of options.+--+-- Example:+--+-- >>> ghcOptions [Help, GhcOption "-foo", Verbose, GhcOption "-bar"]+-- ["-foo","-bar"]+ghcOptions :: [Option] -> [String]+ghcOptions opts = [ option | GhcOption option <- opts ]+++-- | Format given list of options for Haddock.+haddockOptions :: [Option] -> [Haddock.Flag]+haddockOptions opts = verbosity : ghcOpts+  where+    verbosity = if (Verbose `elem` opts) then Haddock.Flag_Verbosity "3" else Haddock.Flag_NoWarnings+    ghcOpts = map Haddock.Flag_OptGhc $ ghcOptions opts
+ tests/Main.hs view
@@ -0,0 +1,73 @@+module Main where++import System.Directory (canonicalizePath)+import System.Environment (getArgs)+import Test.HUnit (Test(TestList), runTestTT)+import Util++main :: IO ()+main = do+  -- get path to doctest binary+  [bin] <- getArgs+  bin' <- canonicalizePath bin+  _ <- runTestTT $ tests $ doctestTestCase bin'+  return ();+  where+    tests doctest = TestList [++    -- Tests+    -- =====++    --  * testImport+        doctest "testImport" ["ModuleA.hs"]+        (cases 2)+      , doctest ".." ["--optghc=-itests/testImport", "tests/testImport/ModuleA.hs"]+        (cases 2)++    --  * testCommentLocation+      , doctest "." ["testCommentLocation/Foo.hs"]+        (cases 11)++    -- * testPutStr+      , doctest "testPutStr" ["Fib.hs"]+        (cases 2)++    -- * testFailOnMultiline+      , doctest "testFailOnMultiline" ["Fib.hs"]+        (cases 2) {errors = 2}++    -- Bugfix tests+    -- ============++    --  * bugfixWorkingDirectory+      , doctest "bugfixWorkingDirectory" ["Fib.hs"]+        (cases 1)+      , doctest "bugfixWorkingDirectory" ["examples/Fib.hs"]+        (cases 2)++    -- * bugfixOutputToStdErr+      , doctest "bugfixOutputToStdErr" ["Fib.hs"]+        (cases 1)++    -- * bugfixMultipleStatements+      , doctest "bugfixMultipleStatements" ["Fib.hs"]+        (cases 1)++    -- * bugfixImportHierarchical+      , doctest "bugfixImportHierarchical" ["ModuleA.hs", "ModuleB.hs"]+        (cases 2)++    -- * bugfixMultipleModules+      , doctest "bugfixMultipleModules" ["ModuleA.hs"]+        (cases 3)++    -- Open bugs+    -- =========++    {-+    -- * bugFoo+      , doctest "bugFoo" ["Foo.hs"]+        (cases 3) {errors = 0, failures = 1}+        -- expected: (cases 3)+    -}+      ]
+ tests/TestInterpreter.hs view
@@ -0,0 +1,92 @@+module Main where++import Test.HUnit+import Interpreter++data InterpreterTest =+  InterpreterTest+    String        -- name+    [Interaction] -- interactions++data Interaction =+  Interaction+    String    -- expression+    String    -- result++ghci = Interaction++tests :: [InterpreterTest]+tests = [+    InterpreterTest "testLocalDeclaration" [+      ghci "let x = 10"+      []+    , ghci "x"+      "10\n"+  ]+  , InterpreterTest "testAddition" [+      ghci "23 + 42"+      "65\n"+    , ghci "putStrLn \"foo\" >> putStrLn \"bar\""+      "foo\n\+      \bar\n"+  ]+  , InterpreterTest "testImport" [+      ghci "import Data.Maybe"+      ""+    , ghci "fromJust $ Just 20"+      "20\n"+  ]+  , InterpreterTest "testNotInScope" [+      ghci "foo"+      "\n\+      \<interactive>:1:0: Not in scope: `foo'\n"+  ]+  , InterpreterTest "testStdOutErr" [+      ghci "import System.IO"+      ""+    , ghci "hPutStrLn stdout \"foo\""+      "foo\n"+    , ghci "hPutStrLn stderr \"bar\""+      "bar\n"+  ]+  , InterpreterTest "testShowUnicode" [+      ghci "\"λ\""+      "\"\\955\"\n"+  ]+  , InterpreterTest "testOutputUnicode" [+      ghci "putStrLn \"λ\""+      "λ\n"+  ]+  , InterpreterTest "testSystemExit" [+      ghci "import System.Exit"+      ""+    , ghci "exitWith $ ExitFailure 10"+      "*** Exception: ExitFailure 10\n"+  ]+  , InterpreterTest "testPutEmptyLine" [+      ghci "putStrLn \"\""+      "\n"+  ]+  , InterpreterTest "testPutStr" [+      ghci "putStr \"foo\""+      "foo"+  ]+  ]++main :: IO ()+main = do+  _ <- runTestTT $ TestList $ map testFromInterpreterTest tests+  return ();++testFromInterpreterTest :: InterpreterTest -> Test+testFromInterpreterTest (InterpreterTest name expressions) =+  TestLabel name $ TestCase $ assertionFromInteractions expressions+  where+    assertionFromInteractions :: [Interaction] -> Assertion+    assertionFromInteractions l = do+      withInterpreter [] $ \repl -> mapM_ (assertionFromInteraction repl) l+      where+        assertionFromInteraction :: Interpreter -> Interaction -> Assertion+        assertionFromInteraction repl (Interaction expression result') = do+          result <- eval repl expression+          assertEqual expression result' result
+ tests/Util.hs view
@@ -0,0 +1,73 @@+module Util (+    doctestTestCase+  , Util.cases+  , errors+  , failures+  ) where++import System.Directory (getCurrentDirectory, setCurrentDirectory)+import System.Exit (ExitCode(ExitSuccess))+import System.Process (readProcessWithExitCode)+import qualified Test.HUnit as HU+import Test.HUnit (assertEqual, Counts(..), Test(TestCase), Assertion,+                   showCounts)+import Data.Char (isSpace)++cases :: Int -> Counts+cases n = Counts {+    HU.cases = n+  , tried    = n+  , errors   = 0+  , failures = 0+  }+++-- | Construct a doctest specific 'TestCase'.+doctestTestCase :: FilePath -- ^ absolute path to `doctest` binary+                -> FilePath -- ^ current directory of forked `doctest` process+                -> [String] -- ^ args, given to doctest+                -> Counts   -- ^ expected test result+                -> Test+doctestTestCase doctest dir args counts = TestCase $ doctestAssert doctest dir args counts+++-- | Construct a doctest specific 'Assertion'.+doctestAssert :: FilePath   -- ^ absolute path to `doctest` binary+              -> FilePath   -- ^ current directory of forked `doctest` process+              -> [String]   -- ^ args, given to `doctest`+              -> Counts     -- ^ expected test result+              -> Assertion+doctestAssert doctest workingDir args counts = do+  out <- runDoctest doctest workingDir args+  assertEqual label (showCounts counts) (last . lines $ out)+  where+    label = workingDir ++ " " ++ show args+++-- | Fork and run a `doctest` process.+runDoctest :: FilePath      -- ^ absolute path to `doctest` binary+           -> FilePath      -- ^ current directory of forked `doctest` process+           -> [String]      -- ^ args, given to `doctest`+           -> IO String     -- ^ final result, as printed by `doctest`+runDoctest doctest workingDir args = do+  cwd <- getCurrentDirectory+  setCurrentDirectory workingDir+  (exit, out, err) <- readProcessWithExitCode doctest args ""+  setCurrentDirectory cwd+  case exit of+    ExitSuccess -> return $ lastLine err+    _           ->+      error $ mayCat "STDERR:" (strip err) ++ mayCat "STDOUT:" (strip out)+      where+        mayCat x y = if null y then "" else unlines ["", x, y]+  where+    lastLine = reverse . takeWhile (/= '\r') . reverse++-- | Remove leading and trailing whitespace from given string.+--+-- Example:+--+-- >>> strip "   \tfoo\nbar  \t\n "+-- "foo\nbar"+strip :: String -> String+strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
+ tests/bugfixImportHierarchical/ModuleA.hs view
@@ -0,0 +1,6 @@+-- |+-- >>> fib 10+-- 55+module ModuleA where++import Foo.ModuleB
+ tests/bugfixImportHierarchical/ModuleB.hs view
@@ -0,0 +1,12 @@+module 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)
+ tests/bugfixMultipleModules/ModuleA.hs view
@@ -0,0 +1,6 @@+-- |+-- >>> fib 10+-- 55+module ModuleA where++import ModuleB
+ tests/bugfixMultipleModules/ModuleB.hs view
@@ -0,0 +1,20 @@+module 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)
+ tests/bugfixMultipleStatements/Fib.hs view
@@ -0,0 +1,13 @@+module Fib where++import System++-- | Calculate Fibonacci number of given 'Num'.+--+-- >>> let x = 10+-- >>> x+-- 10+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined++bar = 10
+ tests/bugfixOutputToStdErr/Fib.hs view
@@ -0,0 +1,11 @@+module Fib where++import System++-- | Calculate Fibonacci number of given 'Num'.+--+-- >>> import System.IO+-- >>> hPutStrLn stderr "foobar"+-- foobar+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined
+ tests/bugfixWorkingDirectory/Fib.hs view
@@ -0,0 +1,10 @@+module Fib where++-- | Calculate Fibonacci number of given 'Num'.+--+-- >>> bar+-- 10+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined++bar = 10
+ tests/bugfixWorkingDirectory/description view
@@ -0,0 +1,10 @@+Put 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`.
+ tests/bugfixWorkingDirectory/examples/Fib.hs view
@@ -0,0 +1,16 @@+module Fib where+++-- | Calculate Fibonacci number of given 'Num'.+--+-- Examples:+--+--    >>> fib 10+--    55+--+--    >>> fib 5+--    5+fib :: (Num t, Num t1) => t -> t1+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)
+ tests/run.sh view
@@ -0,0 +1,10 @@+#!/bin/bash++set -o nounset+set -o errexit++cd "`dirname $0`"++./run_interpreter_tests.sh+./runtests.sh+./selftest.sh
+ tests/run_interpreter_tests.sh view
@@ -0,0 +1,4 @@+#!/bin/bash++cd "`dirname $0`"+runhaskell -i../src TestInterpreter.hs
+ tests/runtests.bat view
@@ -0,0 +1,1 @@+runhaskell -hide-all-packages -packagebase -packageHUnit -packageprocess -packagedirectory Main.hs ../dist/build/doctest/doctest
+ tests/runtests.sh view
@@ -0,0 +1,16 @@+#!/bin/bash++cd "`dirname $0`"++DOCTEST="${1:-"../dist/build/doctest/doctest"}"++if [ -x "$DOCTEST" ]; then+    runhaskell -hide-all-packages \+               -packagebase \+               -packageHUnit \+               -packageprocess \+               -packagedirectory \+                Main.hs "$DOCTEST"+else+    echo "$DOCTEST is not executable!"+fi
+ tests/selftest.sh view
@@ -0,0 +1,12 @@+#!/bin/bash++cd "`dirname $0`"++DOCTEST="${1:-"../dist/build/doctest/doctest"}"++if [ -x "$DOCTEST" ]; then+    SRCDIR="../src"+    "$DOCTEST" --optghc=-packageghc --optghc=-i$SRCDIR $SRCDIR/Main.hs+else+    echo "$DOCTEST is not executable!"+fi
+ tests/testCommentLocation/Foo.hs view
@@ -0,0 +1,75 @@+-- |+-- 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++-- |+-- >>> 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
+ tests/testFailOnMultiline/Fib.hs view
@@ -0,0 +1,13 @@+module Fib where++import System++-- | Calculate Fibonacci number of given 'Num'.+--+-- The following interactions cause `doctest' to fail with an error:+--+-- >>> :{+--+-- >>>       :{+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined
+ tests/testImport/ModuleA.hs view
@@ -0,0 +1,6 @@+-- |+-- >>> fib 10+-- 55+module ModuleA where++import ModuleB
+ tests/testImport/ModuleB.hs view
@@ -0,0 +1,12 @@+module 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)
+ tests/testPutStr/Fib.hs view
@@ -0,0 +1,15 @@+module Fib where++import System++-- | Calculate Fibonacci number of given 'Num'.+--+-- >>> putStrLn "foo"+-- foo+-- >>> putStr "bar"+-- bar+--+-- >>> putStrLn "baz"+-- baz+fib :: (Num t, Num t1) => t -> t1+fib _ = undefined