aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/test
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2019-02-11 12:27:41 -0500
committerGitHub <noreply@github.com>2019-02-11 12:27:41 -0500
commit9790200cb854b75e00afaf2eea49a22b7223b200 (patch)
tree0652623398095f3eaaeb30845c877785a342452a /haddock-api/test
parent4e8321de13225f1f5bdec8f39993e9b1aa0831a8 (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')
-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