From 25f5b927773eb730c2d5ef834bd61e1d2d5f09df Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Mon, 17 May 2021 15:37:25 +0200
Subject: HTML writer: ensure headings only have valid attribs in HTML4

Fixes: #5944
---
 test/Tests/Writers/HTML.hs | 109 ++++++++++++++++++++++++---------------------
 1 file changed, 57 insertions(+), 52 deletions(-)

(limited to 'test')

diff --git a/test/Tests/Writers/HTML.hs b/test/Tests/Writers/HTML.hs
index 328801e31..404f6da98 100644
--- a/test/Tests/Writers/HTML.hs
+++ b/test/Tests/Writers/HTML.hs
@@ -34,55 +34,60 @@ infix 4 =:
 (=:) = test html
 
 tests :: [TestTree]
-tests = [ testGroup "inline code"
-          [ "basic" =: code "@&" =?> "<code>@&amp;</code>"
-          , "haskell" =: codeWith ("",["haskell"],[]) ">>="
-            =?> "<code class=\"sourceCode haskell\"><span class=\"op\">&gt;&gt;=</span></code>"
-          , "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>="
-            =?> "<code class=\"nolanguage\">&gt;&gt;=</code>"
-          ]
-        , testGroup "images"
-          [ "alt with formatting" =:
-            image "/url" "title" ("my " <> emph "image")
-            =?> "<img src=\"/url\" title=\"title\" alt=\"my image\" />"
-          ]
-        , testGroup "blocks"
-          [ "definition list with empty <dt>" =:
-            definitionList [(mempty, [para $ text "foo bar"])]
-            =?> "<dl><dt></dt><dd><p>foo bar</p></dd></dl>"
-          ]
-        , testGroup "quotes"
-          [ "quote with cite attribute (without q-tags)" =:
-            doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
-            =?> "“<span cite=\"http://example.org\">examples</span>”"
-          , tQ "quote with cite attribute (with q-tags)" $
-            doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
-            =?> "<q cite=\"http://example.org\">examples</q>"
-          ]
-        , testGroup "sample"
-          [ "sample should be rendered correctly" =:
-            plain (codeWith ("",["sample"],[]) "Answer is 42") =?>
-            "<samp>Answer is 42</samp>"
-          ]
-        , testGroup "variable"
-          [ "variable should be rendered correctly" =:
-            plain (codeWith ("",["variable"],[]) "result") =?>
-            "<var>result</var>"
-          ]
-        , testGroup "sample with style"
-          [ "samp should wrap highlighted code" =:
-            codeWith ("",["sample","haskell"],[]) ">>="
-            =?> ("<samp><code class=\"sourceCode haskell\">" ++
-                "<span class=\"op\">&gt;&gt;=</span></code></samp>")
-          ]
-        , testGroup "variable with style"
-          [ "var should wrap highlighted code" =:
-            codeWith ("",["haskell","variable"],[]) ">>="
-            =?> ("<var><code class=\"sourceCode haskell\">" ++
-                "<span class=\"op\">&gt;&gt;=</span></code></var>")
-          ]
-        ]
-        where
-          tQ :: (ToString a, ToPandoc a)
-               => String -> (a, String) -> TestTree
-          tQ = test htmlQTags
+tests =
+  [ testGroup "inline code"
+    [ "basic" =: code "@&" =?> "<code>@&amp;</code>"
+    , "haskell" =: codeWith ("",["haskell"],[]) ">>="
+      =?> "<code class=\"sourceCode haskell\"><span class=\"op\">&gt;&gt;=</span></code>"
+    , "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>="
+      =?> "<code class=\"nolanguage\">&gt;&gt;=</code>"
+    ]
+  , testGroup "images"
+    [ "alt with formatting" =:
+      image "/url" "title" ("my " <> emph "image")
+      =?> "<img src=\"/url\" title=\"title\" alt=\"my image\" />"
+    ]
+  , testGroup "blocks"
+    [ "definition list with empty <dt>" =:
+      definitionList [(mempty, [para $ text "foo bar"])]
+      =?> "<dl><dt></dt><dd><p>foo bar</p></dd></dl>"
+    , "heading with disallowed attributes" =:
+      headerWith ("", [], [("invalid","1"), ("lang", "en")]) 1 "test"
+      =?>
+      "<h1 lang=\"en\">test</h1>"
+    ]
+  , testGroup "quotes"
+    [ "quote with cite attribute (without q-tags)" =:
+      doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
+      =?> "“<span cite=\"http://example.org\">examples</span>”"
+    , tQ "quote with cite attribute (with q-tags)" $
+      doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
+      =?> "<q cite=\"http://example.org\">examples</q>"
+    ]
+  , testGroup "sample"
+    [ "sample should be rendered correctly" =:
+      plain (codeWith ("",["sample"],[]) "Answer is 42") =?>
+      "<samp>Answer is 42</samp>"
+    ]
+  , testGroup "variable"
+    [ "variable should be rendered correctly" =:
+      plain (codeWith ("",["variable"],[]) "result") =?>
+      "<var>result</var>"
+    ]
+  , testGroup "sample with style"
+    [ "samp should wrap highlighted code" =:
+      codeWith ("",["sample","haskell"],[]) ">>="
+      =?> ("<samp><code class=\"sourceCode haskell\">" ++
+          "<span class=\"op\">&gt;&gt;=</span></code></samp>")
+    ]
+  , testGroup "variable with style"
+    [ "var should wrap highlighted code" =:
+      codeWith ("",["haskell","variable"],[]) ">>="
+      =?> ("<var><code class=\"sourceCode haskell\">" ++
+          "<span class=\"op\">&gt;&gt;=</span></code></var>")
+    ]
+  ]
+  where
+    tQ :: (ToString a, ToPandoc a)
+         => String -> (a, String) -> TestTree
+    tQ = test htmlQTags
-- 
cgit v1.2.3