diff options
author | idontgetoutmuch <dominic@steinitz.org> | 2015-12-20 21:01:47 +0000 |
---|---|---|
committer | idontgetoutmuch <dominic@steinitz.org> | 2015-12-20 21:01:47 +0000 |
commit | 2bdfda1fb2e0de696ca8c6f7a152b2f85a541be9 (patch) | |
tree | cc29895f7d69f051cfec172bb0f8c2ef03552789 /haddock-api/test | |
parent | 5a57a24c44e06e964c4ea2276c842c722c4e93d9 (diff) | |
parent | fa03f80d76f1511a811a0209ea7a6a8b6c58704f (diff) |
Merge pull request #1 from haskell/ghc-head
Ghc head
Diffstat (limited to 'haddock-api/test')
-rw-r--r-- | haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs | 98 | ||||
-rw-r--r-- | haddock-api/test/Spec.hs | 1 |
2 files changed, 99 insertions, 0 deletions
diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs new file mode 100644 index 00000000..8cd2690e --- /dev/null +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -0,0 +1,98 @@ +module Haddock.Backends.Hyperlinker.ParserSpec (main, spec) where + + +import Test.Hspec +import Test.QuickCheck + +import Haddock.Backends.Hyperlinker.Parser +import Haddock.Backends.Hyperlinker.Types + + +main :: IO () +main = hspec spec + + +spec :: Spec +spec = do + describe "parse" parseSpec + + +parseSpec :: Spec +parseSpec = do + + it "is total" $ + property $ \src -> length (parse src) `shouldSatisfy` (>= 0) + + it "retains file layout" $ + property $ \src -> concatMap tkValue (parse src) == src + + context "when parsing single-line comments" $ do + + it "should ignore content until the end of line" $ + "-- some very simple comment\nidentifier" + `shouldParseTo` + [TkComment, TkSpace, TkIdentifier] + + it "should allow endline escaping" $ + "-- first line\\\nsecond line\\\nand another one" + `shouldParseTo` + [TkComment] + + context "when parsing multi-line comments" $ do + + it "should support nested comments" $ + "{- comment {- nested -} still comment -} {- next comment -}" + `shouldParseTo` + [TkComment, TkSpace, TkComment] + + it "should distinguish compiler pragma" $ + "{- comment -}{-# LANGUAGE GADTs #-}{- comment -}" + `shouldParseTo` + [TkComment, TkPragma, TkComment] + + it "should recognize preprocessor directives" $ do + "\n#define foo bar" `shouldParseTo` [TkSpace, TkCpp] + "x # y" `shouldParseTo` + [TkIdentifier, TkSpace, TkOperator, TkSpace,TkIdentifier] + + it "should distinguish basic language constructs" $ do + "(* 2) <$> (\"abc\", foo)" `shouldParseTo` + [ TkSpecial, TkOperator, TkSpace, TkNumber, TkSpecial + , TkSpace, TkOperator, TkSpace + , TkSpecial, TkString, TkSpecial, TkSpace, TkIdentifier, TkSpecial + ] + "let foo' = foo in foo' + foo'" `shouldParseTo` + [ TkKeyword, TkSpace, TkIdentifier + , TkSpace, TkGlyph, TkSpace + , TkIdentifier, TkSpace, TkKeyword, TkSpace + , TkIdentifier, TkSpace, TkOperator, TkSpace, TkIdentifier + ] + "square x = y^2 where y = x" `shouldParseTo` + [ TkIdentifier, TkSpace, TkIdentifier + , TkSpace, TkGlyph, TkSpace + , TkIdentifier, TkOperator, TkNumber + , TkSpace, TkKeyword, TkSpace + , TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier + ] + + it "should parse do-notation syntax" $ do + "do { foo <- getLine; putStrLn foo }" `shouldParseTo` + [ TkKeyword, TkSpace, TkSpecial, TkSpace + , TkIdentifier, TkSpace, TkGlyph, TkSpace + , TkIdentifier, TkSpecial, TkSpace + , TkIdentifier, TkSpace, TkIdentifier, TkSpace, TkSpecial + ] + + unlines + [ "do" + , " foo <- getLine" + , " putStrLn foo" + ] `shouldParseTo` + [ TkKeyword, TkSpace, TkIdentifier + , TkSpace, TkGlyph, TkSpace, TkIdentifier, TkSpace + , TkIdentifier, TkSpace, TkIdentifier, TkSpace + ] + + +shouldParseTo :: String -> [TokenType] -> Expectation +str `shouldParseTo` tokens = map tkType (parse str) `shouldBe` tokens diff --git a/haddock-api/test/Spec.hs b/haddock-api/test/Spec.hs new file mode 100644 index 00000000..a824f8c3 --- /dev/null +++ b/haddock-api/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} |