doctest 0.9.6 → 0.9.7
raw patch · 5 files changed
+245/−236 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- doctest.cabal +3/−2
- src/Report.hs +0/−233
- src/Run.hs +1/−1
- src/Runner.hs +204/−0
- src/Runner/Example.hs +37/−0
doctest.cabal view
@@ -1,5 +1,5 @@ name: doctest-version: 0.9.6+version: 0.9.7 synopsis: Test interactive Haskell examples description: The doctest program checks examples in source code comments. It is modeled after doctest for Python@@ -41,7 +41,8 @@ , Parse , Paths_doctest , Property- , Report+ , Runner+ , Runner.Example , Run , Util build-depends:
− src/Report.hs
@@ -1,233 +0,0 @@-{-# LANGUAGE CPP #-}-module Report (- runModules-, Summary(..)--#ifdef TEST-, Report-, ReportState (..)-, report-, report_-, reportNotEqual-#endif-) where--import Prelude hiding (putStr, putStrLn, error)-import Data.Monoid-import Control.Applicative-import Control.Monad hiding (forM_)-import Text.Printf (printf)-import System.IO (hPutStrLn, hPutStr, stderr, hIsTerminalDevice)-import Data.Char-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---- | 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- (Summary x1 x2 x3 x4) `mappend` (Summary y1 y2 y3 y4) = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4)---- | Run all examples from a list of modules.-runModules :: Interpreter -> [Module [Located DocTest]] -> IO Summary-runModules repl modules = do- isInteractive <- hIsTerminalDevice stderr- ReportState _ _ s <- (`execStateT` ReportState 0 isInteractive mempty {sExamples = c}) $ do- forM_ modules $ runModule repl-- -- report 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?-, 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 :: Interpreter -> Module [Located DocTest] -> Report ()-runModule repl (Module module_ setup examples) = do-- Summary _ _ e0 f0 <- gets reportStateSummary-- forM_ setup $- runTestGroup 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 repl setup_- where- reload :: IO ()- reload = do- -- NOTE: It is important to do the :reload first! There was some odd bug- -- with a previous version of GHC (7.4.1?).- void $ Interpreter.eval repl ":reload"- void $ Interpreter.eval repl $ ":m *" ++ module_-- setup_ :: IO ()- setup_ = do- reload- forM_ setup $ \l -> forM_ l $ \(Located _ x) -> case x of- Property _ -> return ()- Example e _ -> void $ Interpreter.eval repl e--reportFailure :: Location -> Expression -> Report ()-reportFailure loc expression = do- report (printf "### Failure in %s: expression `%s'" (show loc) expression)- updateSummary (Summary 0 1 0 1)--reportError :: Location -> Expression -> String -> Report ()-reportError loc expression err = do- report (printf "### Error in %s: expression `%s'" (show loc) expression)- report err- updateSummary (Summary 0 1 1 0)--reportSuccess :: Report ()-reportSuccess =- updateSummary (Summary 0 1 0 0)--updateSummary :: Summary -> Report ()-updateSummary summary = do- ReportState n f s <- get- put (ReportState n f $ s `mappend` summary)--reportNotEqual :: [String] -> [String] -> Report ()-reportNotEqual expected actual = do- outputLines "expected: " expected- outputLines " but got: " actual- where-- -- print quotes if any line ends with trailing whitespace- printQuotes = any isSpace (map last . filter (not . null) $ expected ++ actual)-- -- use show to escape special characters in output lines if any output line- -- contains any unsafe character- escapeOutput = any (not . isSafe) (concat $ expected ++ actual)-- isSafe :: Char -> Bool- isSafe c = c == ' ' || (isPrint c && (not . isSpace) c)-- outputLines message l_ = case l of- x:xs -> do- report (message ++ x)- let padding = replicate (length message) ' '- forM_ xs $ \y -> report (padding ++ y)- [] ->- report message- where- l | printQuotes || escapeOutput = map show l_- | otherwise = l_---- | 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 :: Interpreter -> IO () -> [Located DocTest] -> Report ()-runTestGroup repl setup tests = do-- -- report intermediate summary- gets (show . reportStateSummary) >>= report_-- liftIO setup- runExampleGroup repl examples-- forM_ properties $ \(loc, expression) -> do- r <- liftIO $ do- setup- runProperty repl expression- case r of- Success ->- reportSuccess- Error err -> do- reportError loc expression err- Failure msg -> do- reportFailure loc expression- report 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 :: Interpreter -> [Located Interaction] -> Report ()-runExampleGroup repl = go- where- go ((Located loc (expression, expected)) : xs) = do- r <- fmap lines <$> liftIO (Interpreter.safeEval repl expression)- case r of- Left err -> do- reportError loc expression err- Right actual -> do- if expected /= actual- then do- reportFailure loc expression- reportNotEqual expected actual- else do- reportSuccess- go xs- go [] = return ()
src/Run.hs view
@@ -20,7 +20,7 @@ import Parse import Help-import Report+import Runner import qualified Interpreter ghcPackageDbFlag :: String
+ src/Runner.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE CPP #-}+module Runner (+ runModules+, Summary(..)++#ifdef TEST+, Report+, ReportState (..)+, report+, report_+#endif+) where++import Prelude hiding (putStr, putStrLn, error)+import Data.Monoid+import Control.Applicative+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+ (Summary x1 x2 x3 x4) `mappend` (Summary y1 y2 y3 y4) = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4)++-- | Run all examples from a list of modules.+runModules :: Interpreter -> [Module [Located DocTest]] -> IO Summary+runModules repl modules = do+ isInteractive <- hIsTerminalDevice stderr+ ReportState _ _ s <- (`execStateT` ReportState 0 isInteractive mempty {sExamples = c}) $ do+ forM_ modules $ runModule repl++ -- report 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?+, 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 :: Interpreter -> Module [Located DocTest] -> Report ()+runModule repl (Module module_ setup examples) = do++ Summary _ _ e0 f0 <- gets reportStateSummary++ forM_ setup $+ runTestGroup 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 repl setup_+ where+ reload :: IO ()+ reload = do+ -- NOTE: It is important to do the :reload first! There was some odd bug+ -- with a previous version of GHC (7.4.1?).+ void $ Interpreter.eval repl ":reload"+ void $ Interpreter.eval repl $ ":m *" ++ module_++ setup_ :: IO ()+ setup_ = do+ reload+ forM_ setup $ \l -> forM_ l $ \(Located _ x) -> case x of+ Property _ -> return ()+ Example e _ -> void $ Interpreter.eval repl e++reportFailure :: Location -> Expression -> Report ()+reportFailure loc expression = do+ report (printf "### Failure in %s: expression `%s'" (show loc) expression)+ updateSummary (Summary 0 1 0 1)++reportError :: Location -> Expression -> String -> Report ()+reportError loc expression err = do+ report (printf "### Error in %s: expression `%s'" (show loc) expression)+ report err+ updateSummary (Summary 0 1 1 0)++reportSuccess :: Report ()+reportSuccess =+ updateSummary (Summary 0 1 0 0)++updateSummary :: Summary -> Report ()+updateSummary summary = do+ ReportState n f s <- get+ put (ReportState n f $ s `mappend` summary)++-- | 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 :: Interpreter -> IO () -> [Located DocTest] -> Report ()+runTestGroup repl setup tests = do++ -- report intermediate summary+ gets (show . reportStateSummary) >>= report_++ liftIO setup+ runExampleGroup repl examples++ forM_ properties $ \(loc, expression) -> do+ r <- liftIO $ do+ setup+ runProperty repl expression+ case r of+ Success ->+ reportSuccess+ Error err -> do+ reportError loc expression err+ Failure msg -> do+ reportFailure loc expression+ report 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 :: Interpreter -> [Located Interaction] -> Report ()+runExampleGroup repl = go+ where+ go ((Located loc (expression, expected)) : xs) = do+ r <- fmap lines <$> liftIO (Interpreter.safeEval 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+ mapM_ report err+ Equal -> do+ reportSuccess+ go xs+ go [] = return ()
+ src/Runner/Example.hs view
@@ -0,0 +1,37 @@+module Runner.Example (+ Result (..)+, mkResult+) where++import Data.Char+import Util++data Result = Equal | NotEqual [String]+ deriving (Eq, Show)++mkResult :: [String] -> [String] -> Result+mkResult expected_ actual_+ | expected == actual = Equal+ | otherwise = NotEqual (formatNotEqual expected actual)+ where+ expected = map stripEnd expected_+ actual = map stripEnd actual_++formatNotEqual :: [String] -> [String] -> [String]+formatNotEqual expected actual = formatLines "expected: " expected ++ formatLines " but got: " actual+ where+ -- use show to escape special characters in output lines if any output line+ -- contains any unsafe character+ escapeOutput+ | any (not . isSafe) (concat $ expected ++ actual) = map show+ | otherwise = id++ isSafe :: Char -> Bool+ isSafe c = c == ' ' || (isPrint c && (not . isSpace) c)++ formatLines :: String -> [String] -> [String]+ formatLines message xs = case escapeOutput xs of+ y:ys -> (message ++ y) : map (padding ++) ys+ [] -> [message]+ where+ padding = replicate (length message) ' '