aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/test/Haddock
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2019-02-11 12:27:41 -0500
committerAlec Theriault <alec.theriault@gmail.com>2019-03-29 12:11:56 -0700
commit3efdc3a8da642d5d76b2c3f10a22f0503f65456a (patch)
tree31346880aef210cae45005037c40af8ce15257ed /haddock-api/test/Haddock
parentae23b4f25a972620686617b5aab5375d5046b1c9 (diff)
Remove workaround for now-fixed Clang CPP bug (#1028)
Before LLVM 6.0.1 (or 10.0 on Apple LLVM), there was a bug where lines that started with an octothorpe but turned out not to lex like pragmas would have an extra line added after them. Since this bug has been fixed upstream and that it doesn't have dire consequences anyways, the workaround is not really worth it anymore - we can just tell people to update their clang version (or re-structure their pragma code).
Diffstat (limited to 'haddock-api/test/Haddock')
-rw-r--r--haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs49
1 files changed, 18 insertions, 31 deletions
diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
index ff18cb40..1273a45a 100644
--- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -5,8 +5,7 @@ import Test.Hspec
import Test.QuickCheck
import GHC ( runGhc, getSessionDynFlags )
-import DynFlags ( CompilerInfo, DynFlags )
-import SysTools.Info ( getCompilerInfo' )
+import DynFlags ( DynFlags )
import Control.Monad.IO.Class
import Data.String ( fromString )
@@ -17,13 +16,12 @@ import Haddock (getGhcDirs)
import Haddock.Backends.Hyperlinker.Parser
import Haddock.Backends.Hyperlinker.Types
-withDynFlags :: ((DynFlags, CompilerInfo) -> IO ()) -> IO ()
+withDynFlags :: (DynFlags -> IO ()) -> IO ()
withDynFlags cont = do
libDir <- fmap snd (getGhcDirs [])
runGhc (Just libDir) $ do
dflags <- getSessionDynFlags
- cinfo <- liftIO $ getCompilerInfo' dflags
- liftIO $ cont (dflags, cinfo)
+ liftIO $ cont dflags
main :: IO ()
@@ -60,60 +58,54 @@ instance Arbitrary NoGhcRewrite where
parseSpec :: Spec
parseSpec = around withDynFlags $ do
- it "is total" $ \(dflags, cinfo) ->
- property $ \src -> length (parse cinfo dflags "" (fromString src)) `shouldSatisfy` (>= 0)
+ it "is total" $ \dflags ->
+ property $ \src -> length (parse dflags "" (fromString src)) `shouldSatisfy` (>= 0)
- it "retains file layout" $ \(dflags, cinfo) ->
+ it "retains file layout" $ \dflags ->
property $ \(NoGhcRewrite src) ->
let orig = fromString src
- lexed = BS.concat (map tkValue (parse cinfo dflags "" orig))
+ lexed = BS.concat (map tkValue (parse dflags "" orig))
in lexed == orig
context "when parsing single-line comments" $ do
- it "should ignore content until the end of line" $ \(dflags, cinfo) ->
+ it "should ignore content until the end of line" $ \dflags ->
shouldParseTo
"-- some very simple comment\nidentifier"
[TkComment, TkSpace, TkIdentifier]
- cinfo
dflags
- it "should allow endline escaping" $ \(dflags, cinfo) ->
+ it "should allow endline escaping" $ \dflags ->
shouldParseTo
"#define first line\\\nsecond line\\\nand another one"
[TkCpp]
- cinfo
dflags
context "when parsing multi-line comments" $ do
- it "should support nested comments" $ \(dflags, cinfo) ->
+ it "should support nested comments" $ \dflags ->
shouldParseTo
"{- comment {- nested -} still comment -} {- next comment -}"
[TkComment, TkSpace, TkComment]
- cinfo
dflags
- it "should distinguish compiler pragma" $ \(dflags, cinfo) ->
+ it "should distinguish compiler pragma" $ \dflags ->
shouldParseTo
"{- comment -}{-# LANGUAGE GADTs #-}{- comment -}"
[TkComment, TkPragma, TkComment]
- cinfo
dflags
- it "should recognize preprocessor directives" $ \(dflags, cinfo) -> do
+ it "should recognize preprocessor directives" $ \dflags -> do
shouldParseTo
"\n#define foo bar"
[TkCpp]
- cinfo
dflags
shouldParseTo
"x # y"
[TkIdentifier, TkSpace, TkOperator, TkSpace,TkIdentifier]
- cinfo
dflags
- it "should distinguish basic language constructs" $ \(dflags, cinfo) -> do
+ it "should distinguish basic language constructs" $ \dflags -> do
shouldParseTo
"(* 2) <$> (\"abc\", foo)"
@@ -121,7 +113,6 @@ parseSpec = around withDynFlags $ do
, TkSpace, TkOperator, TkSpace
, TkSpecial, TkString, TkSpecial, TkSpace, TkIdentifier, TkSpecial
]
- cinfo
dflags
shouldParseTo
@@ -131,7 +122,6 @@ parseSpec = around withDynFlags $ do
, TkIdentifier, TkSpace, TkKeyword, TkSpace
, TkIdentifier, TkSpace, TkOperator, TkSpace, TkIdentifier
]
- cinfo
dflags
shouldParseTo
@@ -142,10 +132,9 @@ parseSpec = around withDynFlags $ do
, TkSpace, TkKeyword, TkSpace
, TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier
]
- cinfo
dflags
- it "should parse do-notation syntax" $ \(dflags, cinfo) -> do
+ it "should parse do-notation syntax" $ \dflags -> do
shouldParseTo
"do { foo <- getLine; putStrLn foo }"
[ TkKeyword, TkSpace, TkSpecial, TkSpace
@@ -153,7 +142,6 @@ parseSpec = around withDynFlags $ do
, TkIdentifier, TkSpecial, TkSpace
, TkIdentifier, TkSpace, TkIdentifier, TkSpace, TkSpecial
]
- cinfo
dflags
shouldParseTo
@@ -166,10 +154,9 @@ parseSpec = around withDynFlags $ do
, TkSpace, TkGlyph, TkSpace, TkIdentifier, TkSpace
, TkIdentifier, TkSpace, TkIdentifier, TkSpace
]
- cinfo
dflags
where
- shouldParseTo :: ByteString -> [TokenType] -> CompilerInfo -> DynFlags -> Expectation
- shouldParseTo str tokens cinfo dflags = [ tkType tok
- | tok <- parse cinfo dflags "" str
- , not (BS.null (tkValue tok)) ] `shouldBe` tokens
+ shouldParseTo :: ByteString -> [TokenType] -> DynFlags -> Expectation
+ shouldParseTo str tokens dflags = [ tkType tok
+ | tok <- parse dflags "" str
+ , not (BS.null (tkValue tok)) ] `shouldBe` tokens