1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
|
{-|
Module : Lua.ErsatzTests
Copyright : © 2021-2024 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <tarleb@hslua.org>
Stability : beta
Tests for Lua bindings.
-}
module Lua.ErsatzTests (tests) where
import Control.Monad (void)
import Foreign.C.String (withCString, withCStringLen)
import Foreign.Marshal (alloca)
import Foreign.Ptr (nullPtr)
import Foreign.Storable (peek)
import Lua
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, HasCallStack, testCase, (@=?) )
-- | Tests for unsafe methods.
tests :: TestTree
tests = testGroup "ersatz"
[ testGroup "arith"
[ "adds two numbers" =: do
7 `shouldBeResultOf` \l -> do
lua_pushinteger l 5
lua_pushinteger l 2
hslua_arith l LUA_OPADD nullPtr
lua_tointegerx l top nullPtr
, "negates number" =: do
(-5) `shouldBeResultOf` \l -> do
lua_pushinteger l 5
hslua_arith l LUA_OPUNM nullPtr
lua_tointegerx l top nullPtr
, "pops its arguments from the stack" =: do
1 `shouldBeResultOf` \l -> do
old <- lua_gettop l
lua_pushinteger l 4
lua_pushinteger l 3
hslua_arith l LUA_OPADD nullPtr
new <- lua_gettop l
return (new - old)
, "pops a single argument for unary negation" =: do
1 `shouldBeResultOf` \l -> do
old <- lua_gettop l
lua_pushinteger l 3
hslua_arith l LUA_OPUNM nullPtr
new <- lua_gettop l
return (new - old)
, "sets status to LUA_OK on success" =: do
(LUA_OK, 1024) `shouldBeResultOf` \l -> do
lua_pushinteger l 2
lua_pushinteger l 10
stts <- alloca $ \status -> do
hslua_arith l LUA_OPPOW status
peek status
result <- lua_tointegerx l top nullPtr
return (stts, result)
, "sets error status on error" =: do
LUA_ERRRUN `shouldBeResultOf` \l -> do
lua_pushinteger l 2
lua_pushboolean l TRUE
alloca $ \status -> do
hslua_arith l LUA_OPSHR status
peek status
, "runs metamethod" =: do
(LUA_OK, 7) `shouldBeResultOf` \l -> do
lua_pushinteger l 2
lua_createtable l 0 0
LUA_OK <- withCStringLen "return {__mod = function() return 7 end}" $
\(s, len) -> luaL_loadbuffer l s (fromIntegral len) s
LUA_OK <- lua_pcall l 0 1 0
lua_setmetatable l (-2)
stts <- alloca $ \status -> do
hslua_arith l LUA_OPMOD status
peek status
result <- lua_tointegerx l top nullPtr
return (stts, result)
, "catches runtime error in metamethod" =: do
LUA_ERRRUN `shouldBeResultOf` \l -> do
lua_pushinteger l 2
lua_createtable l 0 0
LUA_OK <- withCStringLen "return {__bor = function() error'no' end}" $
\(s, len) -> luaL_loadbuffer l s (fromIntegral len) s
LUA_OK <- lua_pcall l 0 1 0
lua_setmetatable l (-2)
alloca $ \status -> do
hslua_arith l LUA_OPBOR status
peek status
]
, testGroup "global"
[ "set and get global field" =: do
(42, LUA_TNUMBER) `shouldBeResultOf` \l -> do
lua_pushinteger l 42
tp <- withCStringLen "ups" $ \(name, nameLen) -> do
hslua_setglobal l name (fromIntegral nameLen) nullPtr
hslua_getglobal l name (fromIntegral nameLen) nullPtr
i <- lua_tointegerx l top nullPtr
return (i, tp)
, "get value from table" =: do
(-23, LUA_TNUMBER) `shouldBeResultOf` \l -> do
withCStringLen "return {[5] = -23}" $ \(name, len) -> void $
luaL_loadbuffer l name (fromIntegral len) name
LUA_OK <- lua_pcall l 0 1 0
lua_pushinteger l 5
ty <- hslua_gettable l (nth 2) nullPtr
i <- lua_tointegerx l top nullPtr
return (i, ty)
]
, testGroup "Auxiliary"
[ testGroup "hslua_requiref"
[ "can load a module" =: do
LUA_TTABLE `shouldBeResultOf` \l -> do
lua_pushcfunction l luaopen_package
LUA_OK <- lua_pcall l 0 0 0
withCString "math" $ \s ->
hsluaL_requiref l s luaopen_math FALSE nullPtr
lua_type l (-1)
, "returns LUA_OK on success" =: do
LUA_OK `shouldBeResultOf` \l -> do
lua_pushcfunction l luaopen_package
LUA_OK <- lua_pcall l 0 0 0
alloca $ \status -> do
withCString "math" $ \s ->
hsluaL_requiref l s luaopen_package FALSE status
peek status
, "sets global if flag is set" =: do
LUA_TTABLE `shouldBeResultOf` \l -> do
luaL_openlibs l
withCString "mathematics" $ \s ->
hsluaL_requiref l s luaopen_math TRUE nullPtr
withCStringLen "mathematics" $ \(name, len) ->
hslua_getglobal l name (fromIntegral len) nullPtr
, "catches errors" =: do
LUA_ERRRUN `shouldBeResultOf` \l -> do
-- unset registry
lua_pushnil l
lua_copy l (-1) LUA_REGISTRYINDEX
alloca $ \status -> do
withCString "math" $ \s ->
hsluaL_requiref l s luaopen_package FALSE status
peek status
]
]
]
infix 3 =:
(=:) :: String -> Assertion -> TestTree
(=:) = testCase
shouldBeResultOf :: (HasCallStack, Eq a, Show a)
=> a -> (State -> IO a) -> Assertion
shouldBeResultOf expected luaOp = do
result <- withNewState luaOp
expected @=? result
|