Ensure correctness of StackValue instances

2 files changed, 29 insertions, 0 deletions

diff --git a/pandoc.cabal b/pandoc.cabal
index 246b36841..ef3f8fd04 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -531,6 +531,7 @@ Test-Suite test-pandoc
                   text >= 0.11 && < 1.3,
                   directory >= 1 && < 1.4,
                   filepath >= 1.1 && < 1.5,
+                  hslua >= 0.4 && < 0.6,
                   process >= 1.2.3 && < 1.5,
                   skylighting >= 0.3.1 && < 0.4,
                   temporary >= 1.1 && < 1.3,
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