summaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorAlbert Krewinkel <albert@zeitkraut.de>2017-04-06 21:00:38 +0200
committerAlbert Krewinkel <albert@zeitkraut.de>2017-04-06 21:00:38 +0200
commitd412c38c714b810040d583bbe40af4937f8ef138 (patch)
tree9a0c78055c8182b893eb20ed75d959cf4640d55e /test
parent9278a6325d01f2b8442103c98ad00b05e65c2b3e (diff)
Ensure correctness of StackValue instances
Diffstat (limited to 'test')
-rw-r--r--test/Tests/Lua.hs28
1 files changed, 28 insertions, 0 deletions
diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs
index 27a4d8d6f..f01784663 100644
--- a/test/Tests/Lua.hs
+++ b/test/Tests/Lua.hs
@@ -1,12 +1,17 @@
{-# Language OverloadedStrings #-}
module Tests.Lua ( tests ) where
+import Control.Monad (when)
import System.FilePath ((</>))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
+import Test.Tasty.QuickCheck (ioProperty, testProperty)
+import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
import Text.Pandoc.Lua
+import qualified Scripting.Lua as Lua
+
tests :: [TestTree]
tests =
[ testCase "macro expansion via filter" $
@@ -32,9 +37,32 @@ tests =
"markdown-reader.lua"
(doc $ rawBlock "markdown" "*charly* **delta**")
(doc . para $ emph "charly" <> space <> strong "delta")
+
+ , testProperty "inline elements can be round-tripped through the lua stack" $
+ \x -> ioProperty (roundtripEqual (x::Inline))
+
+ , testProperty "block elements can be round-tripped through the lua stack" $
+ \x -> ioProperty (roundtripEqual (x::Block))
]
assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
assertFilterConversion msg filterPath docIn docExpected = do
docRes <- runLuaFilter ("lua" </> filterPath) [] docIn
assertEqual msg docExpected docRes
+
+roundtripEqual :: (Eq a, Lua.StackValue a) => a -> IO Bool
+roundtripEqual x = (x ==) <$> roundtripped
+ where
+ roundtripped :: (Lua.StackValue a) => IO a
+ roundtripped = do
+ lua <- Lua.newstate
+ Lua.push lua x
+ size <- Lua.gettop lua
+ when (size /= 1) $
+ error ("not exactly one element on the stack: " ++ show size)
+ res <- Lua.peek lua (-1)
+ retval <- case res of
+ Nothing -> error "could not read from stack"
+ Just y -> return y
+ Lua.close lua
+ return retval