doctest 0.3.0 → 0.4.0
raw patch · 7 files changed
+129/−35 lines, 7 files
Files
- LICENSE +1/−1
- doctest.cabal +24/−3
- src/DocTest.hs +44/−0
- src/HaddockBackend/Api.hs +11/−6
- src/Interpreter.hs +14/−2
- src/Main.hs +2/−23
- src/Test/DocTest.hs +33/−0
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009 Simon Hengel <simon.hengel@web.de>+Copyright (c) 2009, 2010, 2011 Simon Hengel <simon.hengel@wiktory.org> Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
doctest.cabal view
@@ -1,14 +1,14 @@ name: doctest-version: 0.3.0+version: 0.4.0 stability: experimental synopsis: Test interactive Haskell examples description: The doctest program checks examples in source code comments. It is modeled after doctest for Python (<http://docs.python.org/library/doctest.html>). .- Documentation is at <http://haskell.org/haskellwiki/DocTest>.+ Documentation is at <https://github.com/sol/doctest-haskell#readme>. category: Testing-homepage: http://haskell.org/haskellwiki/DocTest+homepage: https://github.com/sol/doctest-haskell#readme license: MIT license-file: LICENSE copyright: (c) 2009-2011 Simon Hengel@@ -21,6 +21,26 @@ type: git location: git://github.com/sol/doctest-haskell.git +library+ ghc-options: -Wall+ hs-source-dirs: src+ exposed-modules: Test.DocTest+ other-modules:+ Interpreter+ , Options+ , HaddockBackend.Api+ , HaddockBackend.Markup+ , DocTest++ build-depends:+ base >= 4.0 && < 4.4+ , containers >= 0.3 && < 0.5+ , haddock >= 2.8 && < 2.10+ , ghc >= 6.12 && < 7.2+ , ghc-paths == 0.1.*+ , HUnit == 1.2.*+ , process == 1.0.*+ executable doctest ghc-options: -Wall hs-source-dirs: src@@ -30,6 +50,7 @@ , Options , HaddockBackend.Api , HaddockBackend.Markup+ , DocTest build-depends: base >= 4.0 && < 4.4
+ src/DocTest.hs view
@@ -0,0 +1,44 @@+module DocTest (+ getDocTests+ , DocTest(..)+ , Interaction(..)+ , toTestCase+ , toAssertion+ ) where++import Test.HUnit (Test(..), assertEqual, Assertion)+import qualified Interpreter+import HaddockBackend.Api+++toTestCase :: Interpreter.Interpreter -> DocTest -> Test+toTestCase repl test = TestLabel sourceFile $ TestCase $ toAssertion repl test+ where+ sourceFile = source test++-- |+-- Execute all expressions from given 'DocTest' in given+-- 'Interpreter.Interpreter' and verify the output.+--+-- The interpreter state is zeroed with @:reload@ before executing the+-- expressions. This means that you can reuse the same+-- 'Interpreter.Interpreter' for several calls to `toAssertion`.+toAssertion :: Interpreter.Interpreter -> DocTest -> Assertion+toAssertion repl test = do+ _ <- Interpreter.eval repl $ ":m *" ++ moduleName+ _ <- Interpreter.eval repl $ ":reload"+ mapM_ interactionToAssertion $ interactions test+ where+ moduleName = module_ test+ interactionToAssertion x = do+ result' <- Interpreter.eval repl exampleExpression+ assertEqual ("expression `" ++ exampleExpression ++ "'")+ exampleResult $ lines result'+ where+ exampleExpression = expression x+ exampleResult = map subBlankLines $ result x++ -- interpret lines that only contain the string "<BLANKLINE>" as an+ -- empty line+ subBlankLines "<BLANKLINE>" = ""+ subBlankLines line = line
src/HaddockBackend/Api.hs view
@@ -20,19 +20,24 @@ source :: String -- ^ source file , module_ :: String -- ^ originating module , interactions :: [Interaction]-} deriving (Eq, Show, Read)+} deriving (Show) data Interaction = Interaction { expression :: String -- ^ example expression , result :: [String] -- ^ expected result-} deriving (Eq, Show, Read)+} deriving (Show) --- | Extract 'DocTest's-getDocTests :: [Flag] -- ^ list of Haddock command-line flags- -> [String] -- ^ file or module names- -> IO [DocTest] -- ^ extracted 'DocTest's+-- |+-- Extract 'DocTest's from all given modules and all modules included by the+-- given modules.+--+-- Note that this function can be called only once during process lifetime, so+-- use it wisely.+getDocTests :: [Flag] -- ^ List of Haddock flags+ -> [String] -- ^ File or module names+ -> IO [DocTest] -- ^ Extracted 'DocTest's getDocTests flags modules = do interfaces <- createInterfaces flags modules return $ concat $ map docTestsFromInterface interfaces
src/Interpreter.hs view
@@ -6,6 +6,8 @@ import System.IO import System.Process+import System.Exit+import Control.Monad(when) import Control.Exception (bracket) import Data.Char import Data.List@@ -23,14 +25,15 @@ data Interpreter = Interpreter { hIn :: Handle , hOut :: Handle+ , process :: ProcessHandle } 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}+ (Just stdin_, Just stdout_, Nothing, processHandle ) <- createProcess $ (proc ghc myFlags) {std_in = CreatePipe, std_out = CreatePipe, std_err = UseHandle stdout} setMode stdin_ setMode stdout_- return Interpreter {hIn = stdin_, hOut = stdout_}+ return Interpreter {hIn = stdin_, hOut = stdout_, process = processHandle} where myFlags = ["-v0", "--interactive", "-ignore-dot-ghci"] ++ flags @@ -56,8 +59,17 @@ closeInterpreter :: Interpreter -> IO () closeInterpreter 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) $ error $ "Interpreter exited with an error: " ++ show e + return () putExpression :: Interpreter -> String -> IO () putExpression repl e = do
src/Main.hs view
@@ -1,9 +1,10 @@ module Main where -import Test.HUnit (runTestTT, Test(..), assertEqual)+import Test.HUnit (runTestTT, Test(..)) import HaddockBackend.Api import Options+import DocTest import qualified Interpreter @@ -26,25 +27,3 @@ 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 = map subBlankLines $ result x-- -- interpret lines that only contain the string "<BLANKLINE>" as an- -- empty line- subBlankLines "<BLANKLINE>" = ""- subBlankLines line = line
+ src/Test/DocTest.hs view
@@ -0,0 +1,33 @@+-- |+-- An experimental API for extracting and executing `DocTest`s.+--+-- Use 'getDocTests' to extract 'DocTest' examples from Haddock comments. To+-- verify that the examples work turn them into 'Test.HUnit.Assertion's, using+-- 'withInterpreter' and 'toAssertion'. After this just wrap the newly minted+-- assertions into something suitable for your favorite test framework.+module Test.DocTest (+ DocTest+ , getDocTests+ , sourcePath+ , firstExpression+ , toAssertion+ , Interpreter+ , withInterpreter+ ) where++import HaddockBackend.Api+import DocTest+import Interpreter (Interpreter)+import qualified Interpreter++sourcePath :: DocTest -> FilePath+sourcePath = source++firstExpression :: DocTest -> String+firstExpression test = expression $ head $ interactions test++withInterpreter+ :: [String] -- ^ List of flags, passed to GHC+ -> (Interpreter -> IO a) -- ^ Action to run+ -> IO a -- ^ Result of action+withInterpreter = Interpreter.withInterpreter