Added Tests.Walk.

This verifies that walk and query match the generic traversals.
This commit is contained in:
John MacFarlane 2013-08-10 19:04:15 -07:00
parent 02a125d0aa
commit 6f736dfa75
3 changed files with 50 additions and 0 deletions

View file

@ -406,6 +406,7 @@ Test-Suite test-pandoc
Tests.Helpers Tests.Helpers
Tests.Arbitrary Tests.Arbitrary
Tests.Shared Tests.Shared
Tests.Walk
Tests.Readers.LaTeX Tests.Readers.LaTeX
Tests.Readers.Markdown Tests.Readers.Markdown
Tests.Readers.RST Tests.Readers.RST

47
tests/Tests/Walk.hs Normal file
View file

@ -0,0 +1,47 @@
{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
module Tests.Walk (tests) where
import Text.Pandoc.Definition
import Text.Pandoc.Walk
import Test.Framework
import Tests.Helpers
import Data.Char (toUpper)
import Tests.Arbitrary()
import Data.Generics
import Data.Monoid
tests :: [Test]
tests = [ testGroup "Walk"
[ property "p_walk inlineTrans" (p_walk inlineTrans)
, property "p_walk blockTrans" (p_walk blockTrans)
, property "p_query inlineQuery" (p_query inlineQuery)
, property "p_query blockQuery" (p_query blockQuery)
]
]
p_walk :: (Typeable a, Walkable a Pandoc)
=> (a -> a) -> Pandoc -> Bool
p_walk f = (\(d :: Pandoc) -> everywhere (mkT f) d == walk f d)
p_query :: (Eq a, Typeable a1, Monoid a, Walkable a1 Pandoc)
=> (a1 -> a) -> Pandoc -> Bool
p_query f = (\(d :: Pandoc) -> everything mappend (mempty `mkQ` f) d == query f d)
inlineTrans :: Inline -> Inline
inlineTrans (Str xs) = Str $ map toUpper xs
inlineTrans (Emph xs) = Strong xs
inlineTrans x = x
blockTrans :: Block -> Block
blockTrans (Plain xs) = Para xs
blockTrans (BlockQuote xs) = Div ("",["special"],[]) xs
blockTrans x = x
inlineQuery :: Inline -> String
inlineQuery (Str xs) = xs
inlineQuery _ = ""
blockQuery :: Block -> [Int]
blockQuery (Header lev _ _) = [lev]
blockQuery _ = []

View file

@ -14,11 +14,13 @@ import qualified Tests.Writers.HTML
import qualified Tests.Writers.Native import qualified Tests.Writers.Native
import qualified Tests.Writers.Markdown import qualified Tests.Writers.Markdown
import qualified Tests.Shared import qualified Tests.Shared
import qualified Tests.Walk
import Text.Pandoc.Shared (inDirectory) import Text.Pandoc.Shared (inDirectory)
tests :: [Test] tests :: [Test]
tests = [ testGroup "Old" Tests.Old.tests tests = [ testGroup "Old" Tests.Old.tests
, testGroup "Shared" Tests.Shared.tests , testGroup "Shared" Tests.Shared.tests
, testGroup "Walk" Tests.Walk.tests
, testGroup "Writers" , testGroup "Writers"
[ testGroup "Native" Tests.Writers.Native.tests [ testGroup "Native" Tests.Writers.Native.tests
, testGroup "ConTeXt" Tests.Writers.ConTeXt.tests , testGroup "ConTeXt" Tests.Writers.ConTeXt.tests