aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/test
diff options
context:
space:
mode:
authoridontgetoutmuch <dominic@steinitz.org>2015-12-20 21:01:47 +0000
committeridontgetoutmuch <dominic@steinitz.org>2015-12-20 21:01:47 +0000
commit2bdfda1fb2e0de696ca8c6f7a152b2f85a541be9 (patch)
treecc29895f7d69f051cfec172bb0f8c2ef03552789 /haddock-api/test
parent5a57a24c44e06e964c4ea2276c842c722c4e93d9 (diff)
parentfa03f80d76f1511a811a0209ea7a6a8b6c58704f (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.hs98
-rw-r--r--haddock-api/test/Spec.hs1
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 #-}