Merge remote-tracking branch 'origin/ghc-9.0' into ghc-head

1 files changed, 31 insertions, 4 deletions

diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
index 6269184a..1724c664 100644
--- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs
+++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
@@ -3,6 +3,7 @@
 
 module Documentation.Haddock.ParserSpec (main, spec) where
 
+import           Data.Char (isSpace)
 import           Data.String
 import qualified Documentation.Haddock.Parser as Parse
 import           Documentation.Haddock.Types
@@ -112,7 +113,7 @@ spec = do
         "``" `shouldParseTo` "``"
 
       it "can parse an identifier in infix notation enclosed within backticks" $ do
-        "``infix``" `shouldParseTo` "`" <> DocIdentifier "infix" <> "`"
+        "``infix``" `shouldParseTo` DocIdentifier "`infix`"
 
       it "can parse identifiers containing a single quote" $ do
         "'don't'" `shouldParseTo` DocIdentifier "don't"
@@ -132,6 +133,19 @@ spec = do
       it "can parse an identifier that starts with an underscore" $ do
         "'_x'" `shouldParseTo` DocIdentifier "_x"
 
+      it "can parse value-namespaced identifiers" $ do
+        "v'foo'" `shouldParseTo` DocIdentifier "foo"
+
+      it "can parse type-namespaced identifiers" $ do
+        "t'foo'" `shouldParseTo` DocIdentifier "foo"
+
+      it "can parse parenthesized operators and backticked identifiers" $ do
+        "'(<|>)'" `shouldParseTo` DocIdentifier "(<|>)"
+        "'`elem`'" `shouldParseTo` DocIdentifier "`elem`"
+
+      it "can properly figure out the end of identifiers" $ do
+        "'DbModule'/'DbUnitId'" `shouldParseTo` DocIdentifier "DbModule" <> "/" <> DocIdentifier "DbUnitId"
+
     context "when parsing operators" $ do
       it "can parse an operator enclosed within single quotes" $ do
         "'.='" `shouldParseTo` DocIdentifier ".="
@@ -275,8 +289,10 @@ spec = do
       it "parses a single word anchor" $ do
         "#foo#" `shouldParseTo` DocAName "foo"
 
-      it "parses a multi word anchor" $ do
-        "#foo bar#" `shouldParseTo` DocAName "foo bar"
+      -- Spaces are not allowed:
+      -- https://www.w3.org/TR/html51/dom.html#the-id-attribute
+      it "doesn't parse a multi word anchor" $ do
+        "#foo bar#" `shouldParseTo` "#foo bar#"
 
       it "parses a unicode anchor" $ do
         "#灼眼のシャナ#" `shouldParseTo` DocAName "灼眼のシャナ"
@@ -291,6 +307,9 @@ spec = do
       it "does not accept empty anchors" $ do
         "##" `shouldParseTo` "##"
 
+      it "does not accept anchors containing spaces" $ do
+        "{-# LANGUAGE GADTs #-}" `shouldParseTo` "{-# LANGUAGE GADTs #-}"
+
     context "when parsing emphasised text" $ do
       it "emphasises a word on its own" $ do
         "/foo/" `shouldParseTo` DocEmphasis "foo"
@@ -417,6 +436,9 @@ spec = do
       it "accepts anchor reference syntax as DocModule" $ do
         "\"Foo#bar\"" `shouldParseTo` DocModule "Foo#bar"
 
+      it "accepts anchor with hyphen as DocModule" $ do
+        "\"Foo#bar-baz\"" `shouldParseTo` DocModule "Foo#bar-baz"
+
       it "accepts old anchor reference syntax as DocModule" $ do
         "\"Foo\\#bar\"" `shouldParseTo` DocModule "Foo\\#bar"
 
@@ -429,6 +451,10 @@ spec = do
       property $ \xs ->
         (length . show . parseParas) xs `shouldSatisfy` (> 0)
 
+    -- See <https://github.com/haskell/haddock/issues/1142>
+    it "doesn't crash on unicode whitespace" $ do
+      "\8197" `shouldParseTo` DocEmpty
+
     context "when parsing @since" $ do
       it "adds specified version to the result" $ do
         parseParas "@since 0.5.0" `shouldBe`
@@ -457,7 +483,8 @@ spec = do
 
 
     context "when parsing text paragraphs" $ do
-      let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String))
+      let isSpecial c = isSpace c || c `elem` (".(=#-[*`\\\"'_/@<>" :: String)
+          filterSpecial = filter (not . isSpecial)
 
       it "parses an empty paragraph" $ do
         "" `shouldParseTo` DocEmpty