tasty-lua (empty) → 0.1.0
raw patch · 7 files changed
+385/−0 lines, 7 filesdep +basedep +bytestringdep +directorysetup-changed
Dependencies added: base, bytestring, directory, file-embed, hslua, tasty, tasty-hunit, tasty-lua, text
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- src/Test/Tasty/Lua.hs +118/−0
- tasty-lua.cabal +45/−0
- tasty.lua +145/−0
- test/test-tasty-lua.hs +50/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for hslua-module-json++## 0.1.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2019 Albert Krewinkel++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Test/Tasty/Lua.hs view
@@ -0,0 +1,118 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE TemplateHaskell #-}+{-|+Module : Test.Tasty.Lua+Copyright : © 2019 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>+Stability : alpha+Portability : Requires TemplateHaskell++Convert Lua test results into a tasty test trees.+-}+module Test.Tasty.Lua+ ( -- * Lua module+ pushModule+ -- * Running tests+ , testsFromFile+ -- * Helpers+ , pathFailure+ )+where++import Control.Monad (void)+import Data.ByteString (ByteString)+import Data.FileEmbed+import Foreign.Lua (Lua, NumResults, Peekable, StackIndex)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text.Encoding+import qualified Foreign.Lua as Lua+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.Providers as Tasty+++-- | Tasty Lua script+tastyScript :: ByteString+tastyScript = $(embedFile "tasty.lua")++-- | Push the Aeson module on the Lua stack.+pushModule :: Lua NumResults+pushModule = do+ result <- Lua.dostring tastyScript+ if result == Lua.OK+ then return 1+ else Lua.throwTopMessage+{-# INLINABLE pushModule #-}++-- | Report failure of testing a path.+pathFailure :: FilePath -> String -> Tasty.TestTree+pathFailure fp errMsg = Tasty.singleTest fp (Failure errMsg)++-- | Run tasty.lua tests from the given file.+testsFromFile :: FilePath -> Lua Tasty.TestTree+testsFromFile fp = do+ Lua.openlibs+ Lua.requirehs "tasty" (void pushModule)+ res <- Lua.dofile fp+ if res == Lua.OK+ then do+ results <- Lua.peekList Lua.stackTop+ return $ Tasty.testGroup fp $ map testTree results+ else do+ errMsg <- toString <$> Lua.tostring' Lua.stackTop+ return $ pathFailure fp errMsg++-- | Convert internal (tasty.lua) tree format into Tasty tree.+testTree :: Tree -> Tasty.TestTree+testTree (Tree name tree) =+ case tree of+ SingleTest outcome -> Tasty.singleTest name outcome+ TestGroup results -> Tasty.testGroup name (map testTree results)++data Tree = Tree Tasty.TestName UnnamedTree++instance Peekable Tree where+ peek idx = do+ name <- Lua.getfield idx "name" *> Lua.popValue+ result <- Lua.getfield idx "result" *> Lua.popValue+ return $ Tree name result++instance Tasty.IsTest Outcome where+ run _ tr _ = return $ case tr of+ Success -> Tasty.testPassed ""+ Failure msg -> Tasty.testFailed msg+ testOptions = return []+++data UnnamedTree+ = SingleTest Outcome+ | TestGroup [Tree]++instance Peekable UnnamedTree where+ peek = peekTree++peekTree :: StackIndex -> Lua UnnamedTree+peekTree idx = do+ ty <- Lua.ltype idx+ case ty of+ Lua.TypeTable -> TestGroup <$> Lua.peekList idx+ _ -> SingleTest <$> Lua.peek idx++-- | Test outcome+data Outcome = Success | Failure String++instance Peekable Outcome where+ peek idx = do+ ty <- Lua.ltype idx+ case ty of+ Lua.TypeString -> Failure <$> Lua.peek idx+ Lua.TypeBoolean -> do+ b <- Lua.peek idx+ return $ if b then Success else Failure "???"+ _ -> do+ s <- toString <$> Lua.tostring' idx+ Lua.throwException ("not a test result: " ++ s)++-- | Convert UTF8-encoded @'ByteString'@ to a @'String'@.+toString :: ByteString -> String+toString = Text.unpack . Text.Encoding.decodeUtf8
+ tasty-lua.cabal view
@@ -0,0 +1,45 @@+name: tasty-lua+version: 0.1.0+synopsis: Write tests in Lua, integrate into tasty.+description: Allow users to define tasty tests from Lua.+homepage: https://github.com/hslua/tasty-lua+license: MIT+license-file: LICENSE+author: Albert Krewinkel+maintainer: albert+hslua@zeitkraut.de+copyright: Albert Krewinkel <albert+hslua@zeitkraut.de>+category: Foreign+build-type: Simple+extra-source-files: CHANGELOG.md+ , tasty.lua+cabal-version: >=1.10+tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5++source-repository head+ type: git+ location: https://github.com/hslua/hslua-module-tasty.git++library+ build-depends: base >= 4.9 && < 5+ , bytestring >= 0.10.2 && < 0.11+ , file-embed >= 0.0 && < 0.1+ , hslua >= 1.0.3 && < 1.2+ , tasty >= 1.2 && < 1.3+ , text >= 1.0 && < 1.3+ exposed-modules: Test.Tasty.Lua+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++test-suite test-tasty-lua+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: test-tasty-lua.hs+ hs-source-dirs: test+ ghc-options: -Wall -threaded+ build-depends: base+ , directory+ , hslua+ , tasty+ , tasty-lua+ , tasty-hunit
+ tasty.lua view
@@ -0,0 +1,145 @@+------------------------------------------------------------------------+--- Assertors++local assertors = {}++local function register_assertor (name, callback, error_message)+ assertors[name] = function (...)+ local bool = callback(...)+ if bool then+ return+ end++ local success, formatted_message =+ pcall(string.format, error_message, ...)+ if not success then+ error('assertion failed, and error message could not be formatted', 2)+ end+ error('\n' .. formatted_message or 'assertion failed!', 2)+ end+end++--- Value is truthy+local function is_truthy (x)+ return x ~= false and x ~= nil+end++--- Value is falsy+local function is_falsy (x)+ return not is_truthy(x)+end++--- Value is nil+local function is_nil (x)+ return x == nil+end++--- Values are equal+local function are_equal (x, y)+ return x == y+end++local function cycle_aware_compare(t1, t2, cache)+ if cache[t1] and cache[t1][t2] then return true end++ local ty1 = type(t1)+ local ty2 = type(t2)++ -- if t1 == t2 then return true end+ if ty1 ~= ty2 then return false end+ if ty1 ~= 'table' then return t1 == t2 end++ -- Check tables have the same set of keys+ for k1 in pairs(t1) do+ if t2[k1] == nil then return false end+ end+ for k2 in pairs(t2) do+ if t1[k2] == nil then return false end+ end++ -- cache comparison result+ cache[t1] = cache[t1] or {}+ cache[t1][t2] = true++ for k1, v1 in pairs(t1) do+ local v2 = t2[k1]+ if not cycle_aware_compare(v1, v2, cache) then return false end+ end+ return true+end++--- Check if tables are the same+local function are_same(x, y)+ return cycle_aware_compare(x, y, {})+end++local function error_matches(fn, pattern)+ local success, msg = pcall(fn)+ if success then+ return false+ end+ return msg:match(pattern)+end++register_assertor('is_truthy', is_truthy, "expected a truthy value, got %s")+register_assertor('is_falsy', is_falsy, "expected a falsy value, got %s")+register_assertor('is_nil', is_nil, "expected nil, got %s")+register_assertor('are_same', are_same, 'expected same values, got %s and %s')+register_assertor(+ 'are_equal',+ are_equal,+ "expected values to be equal, got '%s' and '%s'"+)+register_assertor(+ 'error_matches',+ error_matches,+ 'no error matching the given pattern was raised'+)++------------------------------------------------------------------------++local ok = true++local function test_success (name)+ return {+ name = name,+ result = ok,+ }+end++local function test_failure (name, err_msg)+ return {+ name = name,+ result = err_msg,+ }+end++------------------------------------------------------------------------+-- Test definitions++local function test_case (name, callback)+ local success, err_msg = pcall(callback)+ return success+ and test_success(name)+ or test_failure(name, err_msg)+end++local function test_group (name, tests)+ if tests == nil then+ -- let's try to curry+ return function (tests_)+ return tests_ and test_group(name, tests_) or error('no tests')+ end+ end+ return {+ name = name,+ result = tests,+ }+end++return {+ assert = assertors,+ ok = ok,+ test_case = test_case,+ test_group = test_group+}
+ test/test-tasty-lua.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module : Main+Copyright : © 2019 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>+Stability : alpha+Portability : Requires language extensions ForeignFunctionInterface,+ OverloadedStrings.++Tests for the @tasty@ Lua module.+-}++import Control.Monad (void)+import Foreign.Lua (Lua)+import System.Directory (withCurrentDirectory)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (assertEqual, testCase)+import Test.Tasty.Lua (pushModule, testsFromFile)++import qualified Foreign.Lua as Lua++main :: IO ()+main = do+ luaTest <- withCurrentDirectory "test" . Lua.run $+ testsFromFile "test-tasty.lua"+ defaultMain $ testGroup "tasty-hslua" [luaTest, tests]++-- | HSpec tests for the Lua 'system' module+tests :: TestTree+tests = testGroup "HsLua tasty module"+ [ testCase "can be pushed to the stack" $+ Lua.run (void pushModule)++ , testCase "can be added to the preloader" . Lua.run $ do+ Lua.openlibs+ Lua.preloadhs "tasty" pushModule+ assertEqual' "function not added to preloader" Lua.TypeFunction =<< do+ Lua.getglobal' "package.preload.tasty"+ Lua.ltype (-1)++ , testCase "can be loaded as tasty" . Lua.run $ do+ Lua.openlibs+ Lua.requirehs "tasty" (void pushModule)+ assertEqual' "loading the module fails " Lua.OK =<<+ Lua.dostring "require 'tasty'"+ ]++assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua ()+assertEqual' msg expected = Lua.liftIO . assertEqual msg expected