From a8f7b19f7cc3c5ac02cd15b4270cad5c869dc0c0 Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
Date: Sun, 24 Dec 2017 09:49:47 -0800
Subject: 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
---
 .../Haddock/Backends/Hyperlinker/ParserSpec.hs     | 33 ++++++++++++++--------
 1 file changed, 22 insertions(+), 11 deletions(-)

(limited to 'haddock-api/test/Haddock/Backends')

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
 
-- 
cgit v1.2.3