module Test.Mangrove.Html5Lib.TreeConstruction
( tests
) where
import qualified Control.Exception as E
import qualified Test.HUnit as U
import Web.Mangrove.Parse.Tree
import Test.Mangrove.Html5Lib.TreeConstruction.Parser
import Test.HUnit ( (@=?) )
tests :: IO U.Test
tests = U.TestLabel "tree-construction" . U.TestList <$> mapM runTestFile files
where files =
[ "tests" ++ show (i :: Word)
| i <- [1..12]
-- "tests13" doesn't exist
++ [14..26]
] ++
[ "adoption01"
, "adoption02"
, "blocks"
, "comments01"
, "doctype01"
, "domjs-unsafe"
, "entities01"
, "entities02"
, "foreign-fragment"
, "html5test-com"
, "inbody01"
, "isindex"
, "main-element"
, "math"
, "menuitem-element"
, "namespace-sensitivity"
, "plain-text-unsafe"
, "ruby"
, "scriptdata01"
, "tables01"
, "template"
, "tests_innerHTML_1"
, "tricky01"
, "webkit01"
, "webkit02"
]
runTestFile :: FilePath -> IO U.Test
runTestFile p = U.TestLabel (p ++ ".dat") . U.TestList . map run <$> parseTestFile p
run :: TreeTest -> U.Test
run t = U.TestCase $ do
result <- E.tryJust filterErrors . E.evaluate .
uncurry finalizeTree . tree (state t) $ input t
either return (output t @=?) $ normalizeOutput <$> result
where filterErrors (E.ErrorCall "Adoption agency not yet implemented") = Just ()
filterErrors (E.ErrorCall "Foster parenting not yet implemented") = Just ()
filterErrors _ = Nothing
normalizeOutput n = n
{ node = normalizeQuirks $ node n
}
normalizeQuirks (Document _) = Document NoQuirks
normalizeQuirks n = n