diff options
| author | Alec Theriault <alec.theriault@gmail.com> | 2019-02-11 12:27:41 -0500 | 
|---|---|---|
| committer | Alec Theriault <alec.theriault@gmail.com> | 2019-03-29 12:11:56 -0700 | 
| commit | 3efdc3a8da642d5d76b2c3f10a22f0503f65456a (patch) | |
| tree | 31346880aef210cae45005037c40af8ce15257ed /haddock-api/test/Haddock | |
| parent | ae23b4f25a972620686617b5aab5375d5046b1c9 (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.hs | 49 | 
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 | 
