aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/test/Haddock/Backends
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2017-12-24 09:49:47 -0800
committerAlexander Biehl <alexbiehl@gmail.com>2018-02-01 14:58:18 +0100
commita8f7b19f7cc3c5ac02cd15b4270cad5c869dc0c0 (patch)
treef1d0a366b7b2ba88d1e8364b578d198539540926 /haddock-api/test/Haddock/Backends
parent11f438ed9161a7dbb5de685fd7f3f18b1942b16e (diff)
Patch flaky parser test (#720)
* Patch flaky parser test This test was a great idea, but it doesn't port over too well to using the GHC lexer. GHC rewrites its input a bit - nothing surprising, but we need to guard against those cases for the test. * Change instance head * Change use site
Diffstat (limited to 'haddock-api/test/Haddock/Backends')
-rw-r--r--haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs33
1 files changed, 22 insertions, 11 deletions
diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
index dcb30e41..4639253c 100644
--- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -27,16 +27,27 @@ spec :: Spec
spec = describe "parse" parseSpec
--- | Defined for its instance of 'Arbitrary'
-newtype NoTabs = NoTabs String deriving (Show, Eq)
-
-noTabs :: String -> Bool
-noTabs = all (\c -> c `notElem` "\r\t\f\v")
-
--- | Does not generate content with space characters other than ' ' and '\n'
-instance Arbitrary NoTabs where
- arbitrary = fmap NoTabs (arbitrary `suchThat` noTabs)
- shrink (NoTabs src) = [ NoTabs shrunk | shrunk <- shrink src, noTabs shrunk ]
+-- | Defined for its instance of 'Arbitrary'. Represents strings that, when
+-- considered as GHC source, won't be rewritten.
+newtype NoGhcRewrite = NoGhcRewrite String deriving (Show, Eq)
+
+-- | Filter out strings where GHC would replace/remove some characters during
+-- lexing.
+noGhcRewrite :: String -> Bool
+noGhcRewrite ('\t':_) = False -- GHC replaces tabs with 8 spaces
+noGhcRewrite ('\r':_) = False
+noGhcRewrite ('\f':_) = False
+noGhcRewrite ('\v':_) = False
+noGhcRewrite (' ':'\n':_) = False -- GHC strips whitespace on empty lines
+noGhcRewrite (_:s) = noGhcRewrite s
+noGhcRewrite "" = True
+
+instance Arbitrary NoGhcRewrite where
+ arbitrary = fmap NoGhcRewrite (arbitrary `suchThat` noGhcRewrite)
+ shrink (NoGhcRewrite src) = [ NoGhcRewrite shrunk
+ | shrunk <- shrink src
+ , noGhcRewrite shrunk
+ ]
parseSpec :: Spec
@@ -46,7 +57,7 @@ parseSpec = around withDynFlags $ do
property $ \src -> length (parse dflags "" src) `shouldSatisfy` (>= 0)
it "retains file layout" $ \dflags ->
- property $ \(NoTabs src) -> concatMap tkValue (parse dflags "" src) == src
+ property $ \(NoGhcRewrite src) -> concatMap tkValue (parse dflags "" src) == src
context "when parsing single-line comments" $ do