doctest 0.16.2 → 0.16.3
raw patch · 7 files changed
+224/−42 lines, 7 filesdep +hspec-coredep ~ghcPVP ok
version bump matches the API change (PVP)
Dependencies added: hspec-core
Dependency ranges changed: ghc
API changes (from Hackage documentation)
Files
- CHANGES +5/−0
- README.markdown +6/−0
- doctest.cabal +9/−8
- src/Extract.hs +3/−1
- src/Runner/Example.hs +115/−28
- test/RunSpec.hs +1/−0
- test/Runner/ExampleSpec.hs +85/−5
CHANGES view
@@ -1,3 +1,8 @@+Changes in 0.16.3+ - Add a cursor to highlight the differing portion between the+ expected and actual output. (#249)+ - GHC 8.10 compatibility. (#247, #257)+ Changes in 0.16.2 - Add doctest's necessary-for-operation options to GHC's command line at the end, so that they over-ride anything provided by the
README.markdown view
@@ -66,6 +66,12 @@ 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
doctest.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 5cc030c2d812828564b9725382af262e688b5005f8fff23c961b5ac94d7d22e1+-- hash: 4cde762c2c650b42498854666c00b2d44f751e196c9b0dd779fcb055b388414f name: doctest-version: 0.16.2+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 (<http://docs.python.org/library/doctest.html>).@@ -20,7 +20,7 @@ license-file: LICENSE copyright: (c) 2009-2018 Simon Hengel author: Simon Hengel <sol@typeful.net>-maintainer: Simon Hengel <sol@typeful.net>+maintainer: quasicomputational <quasicomputational@gmail.com> build-type: Simple extra-source-files: example/example.cabal@@ -137,7 +137,7 @@ , deepseq , directory , filepath- , ghc >=7.0 && <8.9+ , ghc >=7.0 && <8.11 , ghc-paths >=0.1.0.9 , process , syb >=0.3@@ -159,7 +159,7 @@ , directory , doctest , filepath- , ghc >=7.0 && <8.9+ , ghc >=7.0 && <8.11 , ghc-paths >=0.1.0.9 , process , syb >=0.3@@ -180,7 +180,7 @@ , directory , doctest , filepath- , ghc >=7.0 && <8.9+ , ghc >=7.0 && <8.11 , ghc-paths >=0.1.0.9 , process , syb >=0.3@@ -238,9 +238,10 @@ , deepseq , directory , filepath- , ghc >=7.0 && <8.9+ , ghc >=7.0 && <8.11 , ghc-paths >=0.1.0.9 , hspec >=2.3.0+ , hspec-core >=2.3.0 , mockery , process , setenv
src/Extract.hs view
@@ -118,9 +118,11 @@ enableCompilation modGraph = do #if __GLASGOW_HASKELL__ < 707 let enableComp d = d { hscTarget = defaultObjectTarget }-#else+#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.
src/Runner/Example.hs view
@@ -9,56 +9,143 @@ 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- | expected `matches` actual = Equal- | otherwise = NotEqual (formatNotEqual expected actual)+mkResult expected_ actual_ =+ case expected `matches` actual of+ Full -> Equal+ Partial partial -> NotEqual (formatNotEqual expected actual partial) where- chunksMatch :: [LineChunk] -> String -> Bool- chunksMatch [] "" = True- chunksMatch [LineChunk xs] ys = stripEnd xs == stripEnd ys+ -- 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 =- x `isPrefixOf` ys && xs `chunksMatch` drop (length x) 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) =- xs `chunksMatch` ys || zs `chunksMatch` ys- chunksMatch _ _ = False+ -- 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 "" "") - matches :: ExpectedResult -> [String] -> Bool- matches (ExpectedLine x : xs) (y : ys) = x `chunksMatch` y && xs `matches` ys- matches (WildCardLine : xs) ys | xs `matches` ys = True- matches zs@(WildCardLine : _) (_ : ys) = zs `matches` ys- matches [] [] = True- matches [] _ = False- matches _ [] = False+ 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 "") -formatNotEqual :: ExpectedResult -> [String] -> [String]-formatNotEqual expected_ actual = formatLines "expected: " expected ++ formatLines " but got: " actual+-- 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_ - -- 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+ 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
test/RunSpec.hs view
@@ -131,6 +131,7 @@ , "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"
test/Runner/ExampleSpec.hs view
@@ -6,6 +6,7 @@ import Data.String import Test.Hspec+import Test.Hspec.Core.QuickCheck (modifyMaxSize) import Test.QuickCheck import Parse@@ -47,24 +48,55 @@ 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 - it "matches an arbitrary number of lines (quickcheck)" $ do- property $ \xs -> mkResult (lineToExpected xs) (lineToActual xs)- `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@@ -73,11 +105,59 @@ , " 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\""+ "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^"+ ]