File: AuxiliaryTests.hs

package info (click to toggle)
haskell-hslua-core 2.3.2-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 288 kB
  • sloc: haskell: 2,243; makefile: 3
file content (146 lines) | stat: -rw-r--r-- 4,614 bytes parent folder | download | duplicates (2)
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
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{-| Tests for the auxiliary library.
-}
module HsLua.Core.AuxiliaryTests (tests) where

import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)
import HsLua.Core (nth)
import Test.Tasty.HsLua ( (?:), (=:), pushLuaExpr, shouldBeResultOf
                        , shouldBeErrorMessageOf)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit ((@=?))

import qualified Lua
import qualified HsLua.Core as Lua

-- | Specifications for Attributes parsing functions.
tests :: TestTree
tests = testGroup "Auxiliary"
  [ testGroup "checkstack'"
    [ "returns unit if stack space can be provided" =:
      () `shouldBeResultOf` Lua.checkstack' 2 "test"

      -- testing the error case is not possible for some reason
      -- , "fails if too much stack space is requested" =:
      --    "stack overflow (test)"`shouldBeErrorMessageOf`
      --    Lua.checkstack' maxBound "test"
    ]

  , testGroup "getsubtable"
    [ "gets a subtable from field" =:
      [5, 8] `shouldBeResultOf` do
        pushLuaExpr @Lua.Exception "{foo = {5, 8}}"
        _ <- Lua.getsubtable Lua.top "foo"
        Lua.rawgeti (nth 1) 1
        Lua.rawgeti (nth 2) 2
        i1 <- fromMaybe 0 <$> Lua.tointeger (nth 2)
        i2 <- fromMaybe 0 <$> Lua.tointeger (nth 1)
        return [i1, i2]

    , "creates new table at field if necessary" =:
      Lua.TypeTable `shouldBeResultOf` do
        Lua.newtable
        _ <- Lua.getsubtable Lua.top "new"
        Lua.getfield (Lua.nth 2) "new"
        Lua.ltype Lua.top

    , "returns True if a table exists" ?: do
        pushLuaExpr @Lua.Exception "{yep = {}}"
        Lua.getsubtable Lua.top "yep"

    , "returns False if field does not contain a table" ?: do
        pushLuaExpr @Lua.Exception "{nope = 5}"
        not <$> Lua.getsubtable Lua.top "nope"

    ]

  , testGroup "getmetafield'"
    [ "gets field from the object's metatable" =:
      ("testing" :: ByteString) `shouldBeResultOf` do
        Lua.newtable
        pushLuaExpr "{foo = 'testing'}"
        Lua.setmetatable (Lua.nth 2)
        _ <- Lua.getmetafield Lua.top "foo"
        Lua.tostring' Lua.top

    , "returns TypeNil if the object doesn't have a metatable" =:
      Lua.TypeNil `shouldBeResultOf` do
        Lua.newtable
        Lua.getmetafield Lua.top "foo"
    ]

  , testGroup "getmetatable'"
    [ "gets table created with newmetatable" =:
      ("__name" :: ByteString, "testing" :: ByteString) `shouldBeResultOf` do
        Lua.newmetatable "testing" *> Lua.pop 1
        _ <- Lua.getmetatable' "testing"
        Lua.pushnil
        Lua.next (nth 2)
        key <- Lua.tostring' (nth 2) <* Lua.pop 1
        value <- Lua.tostring' (nth 1) <* Lua.pop 1
        return (key, value)

    , "returns nil if there is no such metatable" =:
      Lua.TypeNil `shouldBeResultOf` do
        _ <- Lua.getmetatable' "nope"
        Lua.ltype Lua.top

    , "returns TypeTable if metatable exists" =:
      Lua.TypeTable `shouldBeResultOf` do
        _ <- Lua.newmetatable "yep"
        Lua.getmetatable' "yep"
    ]

  , testGroup "requiref"
    [ "can load a module" =: do
        Lua.TypeTable `shouldBeResultOf` do
          Lua.openlibs
          Lua.requiref "mathematics" Lua.luaopen_math False
          Lua.ltype Lua.top

    , "returns () on success" =: do
        () `shouldBeResultOf` do
          Lua.openlibs
          -- already loaded
          Lua.requiref "math" Lua.luaopen_math False

    , "sets global if flag is set" =: do
        Lua.TypeTable `shouldBeResultOf` do
          Lua.openlibs
          Lua.requiref "foo" Lua.luaopen_math True
          Lua.pop 1
          Lua.getglobal "foo"

    , "catches errors" =: do
        "attempt to index a nil value" `shouldBeErrorMessageOf` do
          -- unset registry
          Lua.pushnil
          Lua.copy Lua.top Lua.registryindex
          Lua.requiref "math" Lua.luaopen_package False
    ]

  , testGroup "where'"
    [ "return location in chunk" =:
      "test:1: nope, not yet" `shouldBeResultOf` do
        Lua.openlibs
        Lua.pushHaskellFunction $ 1 <$ do
          Lua.settop 1
          Lua.where' 2
          Lua.pushstring "nope, "
          Lua.pushvalue 1
          Lua.concat 3
        Lua.setglobal "frob"
        Lua.OK <- Lua.loadbuffer
          "return frob('not yet')"
          "@test"
        result <- Lua.pcall 0 1 Nothing
        if result /= Lua.OK
          then Lua.throwErrorAsException
          else Lua.tostring' Lua.top
    ]

  , "loaded" =: ("_LOADED" @=? Lua.loaded)
  , "preload" =: ("_PRELOAD" @=? Lua.preload)
  ]