Ensure correctness of StackValue instances
This commit is contained in:
parent
9278a6325d
commit
d412c38c71
2 changed files with 29 additions and 0 deletions
|
@ -531,6 +531,7 @@ Test-Suite test-pandoc
|
||||||
text >= 0.11 && < 1.3,
|
text >= 0.11 && < 1.3,
|
||||||
directory >= 1 && < 1.4,
|
directory >= 1 && < 1.4,
|
||||||
filepath >= 1.1 && < 1.5,
|
filepath >= 1.1 && < 1.5,
|
||||||
|
hslua >= 0.4 && < 0.6,
|
||||||
process >= 1.2.3 && < 1.5,
|
process >= 1.2.3 && < 1.5,
|
||||||
skylighting >= 0.3.1 && < 0.4,
|
skylighting >= 0.3.1 && < 0.4,
|
||||||
temporary >= 1.1 && < 1.3,
|
temporary >= 1.1 && < 1.3,
|
||||||
|
|
|
@ -1,12 +1,17 @@
|
||||||
{-# Language OverloadedStrings #-}
|
{-# Language OverloadedStrings #-}
|
||||||
module Tests.Lua ( tests ) where
|
module Tests.Lua ( tests ) where
|
||||||
|
|
||||||
|
import Control.Monad (when)
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
import Test.Tasty (TestTree)
|
import Test.Tasty (TestTree)
|
||||||
import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
|
import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
|
||||||
|
import Test.Tasty.QuickCheck (ioProperty, testProperty)
|
||||||
|
import Text.Pandoc.Arbitrary ()
|
||||||
import Text.Pandoc.Builder
|
import Text.Pandoc.Builder
|
||||||
import Text.Pandoc.Lua
|
import Text.Pandoc.Lua
|
||||||
|
|
||||||
|
import qualified Scripting.Lua as Lua
|
||||||
|
|
||||||
tests :: [TestTree]
|
tests :: [TestTree]
|
||||||
tests =
|
tests =
|
||||||
[ testCase "macro expansion via filter" $
|
[ testCase "macro expansion via filter" $
|
||||||
|
@ -32,9 +37,32 @@ tests =
|
||||||
"markdown-reader.lua"
|
"markdown-reader.lua"
|
||||||
(doc $ rawBlock "markdown" "*charly* **delta**")
|
(doc $ rawBlock "markdown" "*charly* **delta**")
|
||||||
(doc . para $ emph "charly" <> space <> strong "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 :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
|
||||||
assertFilterConversion msg filterPath docIn docExpected = do
|
assertFilterConversion msg filterPath docIn docExpected = do
|
||||||
docRes <- runLuaFilter ("lua" </> filterPath) [] docIn
|
docRes <- runLuaFilter ("lua" </> filterPath) [] docIn
|
||||||
assertEqual msg docExpected docRes
|
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
|
||||||
|
|
Loading…
Add table
Reference in a new issue