tasty-lua 1.0.0 → 1.0.1
raw patch · 11 files changed
+582/−163 lines, 11 filesdep +QuickCheckdep +lua-arbitrarydep ~basedep ~hslua-coredep ~hslua-marshalling
Dependencies added: QuickCheck, lua-arbitrary
Dependency ranges changed: base, hslua-core, hslua-marshalling, tasty, text
Files
- CHANGELOG.md +92/−40
- src/Test/Tasty/Lua.hs +3/−1
- src/Test/Tasty/Lua/Arbitrary.hs +67/−0
- src/Test/Tasty/Lua/Core.hs +10/−23
- src/Test/Tasty/Lua/Module.hs +16/−11
- src/Test/Tasty/Lua/Translate.hs +4/−8
- stack.yaml +0/−4
- tasty-lua.cabal +41/−22
- tasty.lua +193/−43
- test/test-tasty-lua.hs +38/−10
- test/test-tasty.lua +118/−1
CHANGELOG.md view
@@ -1,63 +1,115 @@-# Revision history for tasty-lua+# Changelog -## 0.2.3.2 -- 2021-01-11+`tasty-lua` uses [PVP Versioning][]. -- Relaxed upper bound for tasty, allowing `tasty-1.4.*`.+## tasty-lua-1.0.1 -## 0.2.3.1 -- 2020-10-16+Released 29-01-2022. -- Relaxed upper bound for hslua, allow `hslua-1.3.*`.+- Support for property testing: the new functions `forall` and a+ set of generators are provided for property testing. The table+ `tasty.arbitrary` holds default generators for basic types: -## 0.2.3 -- 2020-08-14+ - `tasty.arbitrary.boolean`+ - `tasty.arbitrary.integer`+ - `tasty.arbitrary.number`+ - `tasty.arbitrary.string` -- CI now also builds with for GHC 8.10.+ Additional generators can be added via the Haskell function+ `registerArbitrary`. -- Errors are now explicitly converted to strings before matched- when using `error_matches`.+- Allow dot instead of underscore in assertion functions: It's+ often easier to type dot than an underscore, so writing+ `assert.is.x` or `assert.are.x` is an acceptable alternative+ to `assert.is_x` and `assert.are_x`, respectively. -- Relax version limits for tasty and hslua, allowing tasty-1.3.*- and hslua-1.2.*.+- Added new assertion functions `is_true` and `is_false`,+ `error_equals`, and `error_satifies`. -## 0.2.2 -- 2020-01-26+- Improved info message of `assert.error_matches`; the message+ now includes the expected pattern as well as the actual error. -- Avoid compilation warnings on GHC 8.2 and older. Monoid- instances on older GHC versions require an explicit- implementation of `mappend`. Newer instances use `(<>)` from- Semigroup.+- Relaxed upper bound for hslua-core, hslua-marshalling. -- Improved CI tests: build with more GHC versions, build with- stack, and ensure that there are no HLint errors.+## tasty-lua-0.2.3.2 -## 0.2.1 -- 2020-01-26+Released 2021-01-11. -- Fixed an issue with error reporting: the bug caused test-group- names to be added multiple times when reporting a test failure.+- Relaxed upper bound for tasty, allowing `tasty-1.4.*`. -## 0.2.0.1 -- 2019-06-19+## tasty-lua-0.2.3.1 -- List all files in cabal file: *stack.yaml* and- *test/tasty-lua.lua* were added to the list of extra source- files.+Released 2020-10-16. -## 0.2.0 -- 2019-05-19+- Relaxed upper bound for hslua, allow `hslua-1.3.*`. -- Renamed `testFileWith` to `testLuaFile`, and- `testsFromFile` to `translateResultsFromFile`.+## tasty-lua-0.2.3 -- Fixed and extended test summary: if all tests pass, a brief- summary about the number of passed tests is show. Furthermore,- some bugs (caused by a misused Foldable instance) have been- fixed.+Released 2020-08-14. -- Code has been split into multiple sub-modules.+- CI now also builds with for GHC 8.10. -## 0.1.1 -- 2019-05-17+- Errors are now explicitly converted to strings before matched+ when using `error_matches`. -- Add new function `testFileWith`, allowing to run a file as a- single test case. Lua tests should be defined with `tasty.lua`.- Failures, if any, are summarized in the failure message of the- test.+- Relax version limits for tasty and hslua, allowing tasty-1.3.*+ and hslua-1.2.*. -## 0.1.0 -- 2019-05-11+## tasty-lua-0.2.2 -* First version. Released on an unsuspecting world.+Released 2020-01-26.++- Avoid compilation warnings on GHC 8.2 and older. Monoid+ instances on older GHC versions require an explicit+ implementation of `mappend`. Newer instances use `(<>)` from+ Semigroup.++- Improved CI tests: build with more GHC versions, build with+ stack, and ensure that there are no HLint errors.++## tasty-lua-0.2.1++Released 2020-01-26.++- Fixed an issue with error reporting: the bug caused test-group+ names to be added multiple times when reporting a test+ failure.++## tasty-lua-0.2.0.1++Released 2019-06-19.++- List all files in cabal file: *stack.yaml* and+ *test/tasty-lua.lua* were added to the list of extra source+ files.++## tasty-lua-0.2.0++Released 2019-05-19.++- Renamed `testFileWith` to `testLuaFile`, and `testsFromFile`+ to `translateResultsFromFile`.++- Fixed and extended test summary: if all tests pass, a brief+ summary about the number of passed tests is show. Furthermore,+ some bugs (caused by a misused Foldable instance) have been+ fixed.++- Code has been split into multiple sub-modules.++## tasty-lua-0.1.1++Released 2019-05-17.++- Add new function `testFileWith`, allowing to run a file as a+ single test case. Lua tests should be defined with+ `tasty.lua`. Failures, if any, are summarized in the failure+ message of the test.++## 0.1.0++Released 2019-05-11.++- First version. Released on an unsuspecting world.++ [PVP Versioning]: https://pvp.haskell.org
src/Test/Tasty/Lua.hs view
@@ -4,7 +4,7 @@ {-# LANGUAGE TypeApplications #-} {-| Module : Test.Tasty.Lua-Copyright : © 2019–2021 Albert Krewinkel+Copyright : © 2019–2022 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de> Stability : alpha@@ -20,6 +20,7 @@ , translateResultsFromFile -- * Helpers , pathFailure+ , registerArbitrary ) where @@ -29,6 +30,7 @@ import HsLua.Core (LuaE, LuaError) import Test.Tasty (TestName, TestTree) import Test.Tasty.Providers (IsTest (..), singleTest, testFailed, testPassed)+import Test.Tasty.Lua.Arbitrary (registerArbitrary) import Test.Tasty.Lua.Module (pushModule) import Test.Tasty.Lua.Core (Outcome (..), ResultTree (..), UnnamedTree (..), runTastyFile)
+ src/Test/Tasty/Lua/Arbitrary.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-|+Module : Test.Tasty.Lua.Arbitrary+Copyright : © 2019–2022 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>++Generators for arbitrary Lua values.+-}+module Test.Tasty.Lua.Arbitrary+ ( registerArbitrary+ , registerDefaultGenerators+ , pushArbitraryTable+ )+where++import HsLua.Core+import HsLua.Marshalling+import Lua.Arbitrary ()+import Test.QuickCheck (Arbitrary (..), generate, vectorOf)++-- | Register a Lua value generator.+registerArbitrary :: forall a e. (Arbitrary a, LuaError e)+ => Name+ -> Pusher e a+ -> Peeker e a+ -> LuaE e ()+registerArbitrary name push peek = do+ pushArbitraryTable+ pushName name+ newtable+ pushName "generator"+ pushHaskellFunction $ do+ samples <- liftIO (generate $ vectorOf 30 (arbitrary @a))+ pushIterator (\x -> NumResults 1 <$ push x) samples+ rawset (nth 3)+ pushName "shrink"+ pushHaskellFunction $+ runPeeker peek (nthBottom 1) >>= \case+ Success x -> do+ pushList push (shrink x)+ pure (NumResults 1)+ _ -> pure (NumResults 0)+ rawset (nth 3)+ rawset (nth 3)+ pop 1 -- remove `tasty.arbitrary` table+++-- | Pushes the table holding all arbitrary generators to the stack.+pushArbitraryTable :: LuaE e ()+pushArbitraryTable =+ newmetatable "tasty.arbitrary" >>= \case+ False -> -- table exists+ pure ()+ True -> do -- table created+ -- make table it's own metatable+ pushvalue top+ setmetatable (nth 2)++registerDefaultGenerators :: LuaError e => LuaE e ()+registerDefaultGenerators = do+ registerArbitrary "boolean" pushboolean peekBool+ registerArbitrary "integer" pushinteger peekIntegral+ registerArbitrary "number" pushnumber peekRealFloat+ registerArbitrary "string" pushString peekString
src/Test/Tasty/Lua/Core.hs view
@@ -1,13 +1,10 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Test.Tasty.Lua.Core-Copyright : © 2019–2021 Albert Krewinkel+Copyright : © 2019–2022 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>-Stability : alpha-Portability : not portable, requires GHC or later Core types and functions for tasty Lua tests. -}@@ -20,15 +17,13 @@ where import Control.Monad ((<$!>), void)-import Data.ByteString (ByteString)-import HsLua.Core (LuaE, LuaError, absindex, pop, toboolean, top)+import HsLua.Core (LuaE, LuaError, toboolean, top) import HsLua.Marshalling ( Peeker, failPeek, liftLua, resultToEither, retrieving- , peekList, peekString, runPeek, typeMismatchMessage)+ , peekFieldRaw, peekList, peekString, runPeek, typeMismatchMessage) import Test.Tasty.Lua.Module (pushModule)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T.Encoding import qualified HsLua.Core as Lua+import qualified HsLua.Core.Utf8 as Utf8 import qualified Test.Tasty as Tasty -- | Run a tasty Lua script from a file and return either the resulting@@ -36,17 +31,12 @@ runTastyFile :: LuaError e => FilePath -> LuaE e (Either String [ResultTree]) runTastyFile fp = do Lua.openlibs- Lua.requirehs "tasty" (void pushModule)- res <- Lua.dofile fp+ Lua.requirehs "tasty" (const . void $ pushModule)+ res <- Lua.dofileTrace fp if res /= Lua.OK- then Left . toString <$> Lua.tostring' top+ then Left . Utf8.toString <$> Lua.tostring' top else resultToEither <$> runPeek (peekList peekResultTree top) --- | Convert UTF8-encoded @'ByteString'@ to a @'String'@.-toString :: ByteString -> String-toString = T.unpack . T.Encoding.decodeUtf8-- -- | Tree of test results returned by tasty Lua scripts. This is -- similar to tasty's @'TestTree'@, with the important difference that -- all tests have already been run, and all test results are known.@@ -54,13 +44,10 @@ peekResultTree :: LuaError e => Peeker e ResultTree peekResultTree idx = do- idx' <- liftLua $ absindex idx- name <- liftLua (Lua.getfield idx' "name") *> peekString top- result <- liftLua (Lua.getfield idx' "result") *> peekUnnamedTree top- liftLua $ pop 2+ name <- peekFieldRaw peekString "name" idx+ result <- peekFieldRaw peekUnnamedTree "result" idx return $! ResultTree name result - -- | Either a raw test outcome, or a nested @'Tree'@. data UnnamedTree = SingleTest Outcome@@ -77,7 +64,7 @@ data Outcome = Success | Failure String -- | Unmarshal a test outcome-peekOutcome :: LuaError e => Peeker e Outcome+peekOutcome :: Peeker e Outcome peekOutcome idx = retrieving "test result" $ do liftLua (Lua.ltype idx) >>= \case Lua.TypeString -> Failure <$!> peekString idx
src/Test/Tasty/Lua/Module.hs view
@@ -1,11 +1,10 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-| Module : Test.Tasty.Lua.Module-Copyright : © 2019–2021 Albert Krewinkel+Copyright : © 2019–2022 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>-Stability : alpha-Portability : Requires TemplateHaskell Tasty Lua module, providing the functions necessary to write tasty tests in Lua scripts.@@ -17,17 +16,23 @@ import Data.ByteString (ByteString) import Data.FileEmbed import HsLua.Core- (LuaE, LuaError, NumResults, Status (OK), dostring, throwErrorAsException)+ ( HaskellFunction, LuaError, NumResults (..), Status (OK)+ , dostringTrace, nth, rawset, throwErrorAsException )+import HsLua.Marshalling (pushName)+import Test.Tasty.Lua.Arbitrary -- | Tasty Lua script tastyScript :: ByteString tastyScript = $(embedFile "tasty.lua") --- | Push the Aeson module on the Lua stack.-pushModule :: LuaError e => LuaE e NumResults-pushModule = do- result <- dostring tastyScript- if result == OK- then return 1- else throwErrorAsException+-- | Push the tasty module on the Lua stack.+pushModule :: LuaError e => HaskellFunction e+pushModule = dostringTrace tastyScript >>= \case+ OK -> NumResults 1 <$ do+ -- add `arbitrary` table+ pushName "arbitrary"+ pushArbitraryTable+ rawset (nth 3)+ registerDefaultGenerators+ _ -> throwErrorAsException {-# INLINABLE pushModule #-}
src/Test/Tasty/Lua/Translate.hs view
@@ -1,10 +1,8 @@ {-| Module : Test.Tasty.Lua.Translate-Copyright : © 2019–2021 Albert Krewinkel+Copyright : © 2019–2022 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>-Stability : alpha-Portability : Requires GHC Translate test results from Lua into a Tasty @'TestTree'@. -}@@ -23,11 +21,9 @@ -- | Run tasty.lua tests from the given file and translate the result -- into a mock Tasty @'TestTree'@. translateResultsFromFile :: LuaError e => FilePath -> LuaE e Tasty.TestTree-translateResultsFromFile fp = do- result <- runTastyFile fp- case result of- Left errMsg -> return $ pathFailure fp errMsg- Right tree -> return $ Tasty.testGroup fp (map testTree tree)+translateResultsFromFile fp = runTastyFile fp >>= \case+ Left errMsg -> return $ pathFailure fp errMsg+ Right tree -> return $ Tasty.testGroup fp (map testTree tree) -- | Report failure of testing a path. pathFailure :: FilePath -> String -> Tasty.TestTree
− stack.yaml
@@ -1,4 +0,0 @@-resolver: lts-14.21--ghc-options:- "$locals": -fhide-source-paths
tasty-lua.cabal view
@@ -1,59 +1,78 @@+cabal-version: 2.2 name: tasty-lua-version: 1.0.0+version: 1.0.1 synopsis: Write tests in Lua, integrate into tasty. description: Allow users to define tasty tests from Lua.-homepage: https://github.com/hslua/tasty-lua+homepage: https://github.com/hslua/hslua license: MIT license-file: LICENSE author: Albert Krewinkel maintainer: albert+hslua@zeitkraut.de-copyright: © 2019–2021 Albert Krewinkel <albert+hslua@zeitkraut.de>+copyright: © 2019–2022 Albert Krewinkel <albert+hslua@zeitkraut.de> category: Foreign build-type: Simple extra-source-files: CHANGELOG.md , tasty.lua , test/test-tasty.lua- , stack.yaml-cabal-version: >=1.10 tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.3- , GHC == 8.10.4+ , GHC == 8.10.7 , GHC == 9.0.1+ , GHC == 9.2.1 source-repository head type: git- location: https://github.com/hslua/tasty-lua.git+ location: https://github.com/hslua/hslua.git+ subdir: tasty-lua -library- build-depends: base >= 4.9 && < 5+common common-options+ default-language: Haskell2010+ build-depends: base >= 4.8 && < 5 , bytestring >= 0.10.2 && < 0.12- , file-embed >= 0.0 && < 0.1- , hslua-core >= 2.0 && < 2.1- , hslua-marshalling >= 2.0 && < 2.1+ , hslua-core >= 2.0 && < 2.2+ , hslua-marshalling >= 2.0 && < 2.2+ , lua-arbitrary >= 1.0 && < 1.1 , tasty >= 1.2 && < 1.5- , text >= 1.0 && < 1.3+ , QuickCheck >= 2.9 && < 2.15+ default-extensions: LambdaCase+ , StrictData+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wnoncanonical-monad-instances+ -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -Wcpp-undef+ -Werror=missing-home-modules+ if impl(ghc >= 8.4)+ ghc-options: -Widentities+ -Wincomplete-uni-patterns+ -Wpartial-fields+ -fhide-source-paths++library+ import: common-options+ build-depends: file-embed >= 0.0 && < 0.1+ , text >= 1.2 && < 2.1 exposed-modules: Test.Tasty.Lua+ , Test.Tasty.Lua.Arbitrary , Test.Tasty.Lua.Core , Test.Tasty.Lua.Module , Test.Tasty.Lua.Translate hs-source-dirs: src- default-language: Haskell2010- ghc-options: -Wall+ other-extensions: OverloadedStrings+ , ScopedTypeVariables+ , TemplateHaskell test-suite test-tasty-lua- default-language: Haskell2010+ import: common-options type: exitcode-stdio-1.0 main-is: test-tasty-lua.hs hs-source-dirs: test- ghc-options: -Wall -threaded- build-depends: base- , directory+ ghc-options: -threaded+ build-depends: directory , filepath >= 1.4- , hslua-core- , hslua-marshalling- , tasty , tasty-lua , tasty-hunit
tasty.lua view
@@ -1,43 +1,109 @@ ------------------------------------------------------------------------ --- Assertors -local assertors = {}+--- New assert object. Behaves like original `assert` when called, and+--- comes with many other tests.+local assert = setmetatable({}, {+ __call = _G.assert, -- use global assert when called.+}) -local function register_assertor (name, callback, error_message)- assertors[name] = function (...)- local bool = callback(...)- if bool then+--- Special table allowing to use `assert.is.truthy` instead of+--- `assert.is_truthy.`+assert.is = setmetatable({}, {+ __index = function (t, k)+ return assert['is_' .. k]+ end+})++--- Special table allowing to use `assert.are.same` instead of+--- `assert.are_same.`+assert.are = setmetatable({}, {+ __index = function (t, k)+ return assert['are_' .. k]+ end+})++--- Special table allowing to use `assert.error.matches` instead of+--- `assert.error_matches.`+assert.error = setmetatable({}, {+ __index = function (t, k)+ return assert['error_' .. k]+ end+})++--- Create a new assertion function.+local function make_assertion (error_message, callback)+ return function (...)+ local assertion_holds, info = callback(...)+ -- Calling the assertion function produced an error, report it.+ if assertion_holds then return end - local success, formatted_message =- pcall(string.format, error_message, ...)+ -- Assertion failed, format and throw the error message+ local success, message+ if type(error_message) == 'function' then+ success, message = pcall(error_message, info, ...)+ elseif type(error_message) == 'string' then+ success, message = pcall(string.format, error_message, ...)+ else+ success, message = false, error_message+ end if not success then- error('assertion failed, and error message could not be formatted', 2)+ error('assertion failed, but error could not be formatted:\n' ..+ tostring(message), 1) end- error('\n' .. formatted_message or 'assertion failed!', 2)+ error('\n' .. message or 'assertion failed!', 2) end end --- Value is truthy-local function is_truthy (x)- return x ~= false and x ~= nil-end+assert.is_truthy = make_assertion(+ "expected a truthy value, got %s",+ function (x)+ return x ~= false and x ~= nil+ end+) --- Value is falsy-local function is_falsy (x)- return not is_truthy(x)-end+assert.is_falsy = make_assertion(+ "expected a falsy value, got %s",+ function (x)+ return not x+ end+) +--- Value is true+assert.is_true = make_assertion(+ "expected true, got %s",+ function (x)+ return x == true+ end+)++--- Value is false+assert.is_false = make_assertion(+ "expected false, got %s",+ function (x)+ return x == false+ end+)+ --- Value is nil-local function is_nil (x)- return x == nil-end+assert.is_nil = make_assertion(+ "expected nil, got %s",+ function (x)+ return x == nil+ end+) --- Values are equal-local function are_equal (x, y)- return x == y-end+assert.are_equal = make_assertion(+ "expected values to be equal, got '%s' and '%s'",+ function (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@@ -69,31 +135,54 @@ end --- Check if tables are the same-local function are_same(x, y)- return cycle_aware_compare(x, y, {})-end+assert.are_same = make_assertion(+ 'expected same values, got %s and %s',+ function (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+--- Checks that a error is raised and that the error satisfies the given+-- assertion.+assert.error_satisfies = make_assertion(+ function (actual)+ return ('assertion did not hold for error object:%s')+ :format(actual)+ end,+ function (fn, assertion)+ local success, err = pcall(fn)+ if success then+ return false+ end+ return pcall(assertion, err) end- return tostring(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'"+--- Checks that a error is raised and that the error equals an expected value.+assert.error_equals = make_assertion(+ function (actual, fun, expected)+ return ('expected error to equal %s, got: %s'):format(expected, actual)+ end,+ function (fn, expected)+ local success, err = pcall(fn)+ return not success and expected == err, err+ end )-register_assertor(- 'error_matches',- error_matches,- 'no error matching the given pattern was raised'++--- Checks that a error is raised and that the message matches the given+--- pattern.+assert.error_matches = make_assertion(+ function (actual, fun, expected)+ return ('expected error to match pattern \'%s\' but got: %s')+ :format(expected, actual)+ end,+ function (fn, pattern)+ local success, msg = pcall(fn)+ if success then+ return false+ end+ return tostring(msg):match(pattern), msg+ end ) ------------------------------------------------------------------------@@ -118,6 +207,12 @@ -- Test definitions local function test_case (name, callback)+ if callback == nil then+ -- let's try currying+ return function (callback_)+ return callback_ and test_case(name, callback_) or error('no test')+ end+ end local success, err_msg = pcall(callback) return success and test_success(name)@@ -137,8 +232,63 @@ } end +------------------------------------------------------------------------+-- Property tests++local maxshrinks = 10++local function doshrink(property, value, shrink)+ local shrunken = value+ local numshrinks = 0+ while numshrinks < maxshrinks do+ local candidates = shrink(shrunken)+ -- abort if shrinking failed, e.g., because the value could not be+ -- peeked.+ if candidates == nil then+ break+ end+ for i, cand in ipairs(candidates) do+ if not property(cand) then+ numshrinks = numshrinks + 1+ shrunken = cand+ goto continue+ end+ end+ -- no successful shrink happened, we are done+ break+ ::continue::+ end+ return shrunken, numshrinks+end++local function forall (arbitrary, property)+ if type(arbitrary) ~= 'table' then+ local msg =string.format(+ 'Unknown or invalid arbitrary generator: %s',+ tostring(arbitrary)+ )+ error(msg, 2)+ end+ local generator = arbitrary.generator+ local shrink = arbitrary.shrink+ return function ()+ local i = 0+ for value in generator() do+ i = i + 1+ if not property(value) then+ local shrunken, steps = doshrink(property, value, shrink)+ error(('falsifiable after %d steps; %d shrinking steps; ' ..+ 'property fails for %s')+ :format(i, steps, shrunken))+ end+ end+ return string.format("%d tests succeeded", i)+ end+end+ return {- assert = assertors,+ assert = assert,+ forall = forall, ok = ok, test_case = test_case, test_group = test_group
test/test-tasty-lua.hs view
@@ -2,37 +2,40 @@ {-# LANGUAGE TypeApplications #-} {-| Module : Main-Copyright : © 2019-2021 Albert Krewinkel+Copyright : © 2019-2022 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 HsLua.Core (Lua)+import Lua.Arbitrary () import System.Directory (withCurrentDirectory) import System.FilePath ((</>))+import Test.QuickCheck (Arbitrary (arbitrary)) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertEqual, testCase)-import Test.Tasty.Lua (pushModule, testLuaFile, translateResultsFromFile)+import Test.Tasty.Lua+ (pushModule, registerArbitrary, testLuaFile, translateResultsFromFile) import qualified HsLua.Core as Lua+import qualified HsLua.Marshalling as Lua main :: IO () main = do- luaTest <- withCurrentDirectory "test" . Lua.run @Lua.Exception $+ luaTest <- withCurrentDirectory "test" . Lua.run @Lua.Exception $ do+ registerCustom translateResultsFromFile "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 :: Lua ())+ [ testCase "can be pushed to the stack" . Lua.run $ do+ Lua.openlibs+ void pushModule :: Lua () , testCase "can be added to the preloader" . Lua.run $ do Lua.openlibs@@ -43,15 +46,40 @@ , testCase "can be loaded as tasty" . Lua.run $ do Lua.openlibs- Lua.requirehs "tasty" (void pushModule)+ Lua.requirehs "tasty" (const $ void pushModule) assertEqual' "loading the module fails " Lua.OK =<< Lua.dostring "require 'tasty'" , testGroup "testFileWith"- [ testLuaFile (Lua.run @Lua.Exception)+ [ testLuaFile+ (\x -> Lua.run @Lua.Exception $ do+ registerCustom+ x) "test-tasty.lua" ("test" </> "test-tasty.lua") ] ] assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua () assertEqual' msg expected = Lua.liftIO . assertEqual msg expected++registerCustom :: Lua ()+registerCustom = do+ registerArbitrary "custom" pushCustom nopeek+ registerArbitrary @[Integer] "integer_list"+ (Lua.pushList Lua.pushIntegral) (Lua.peekList Lua.peekIntegral)++-- | Custom type used for to check property testing.+newtype Custom = Custom Lua.Integer++instance Arbitrary Custom where+ arbitrary = Custom <$> arbitrary++pushCustom :: Lua.LuaError e => Lua.Pusher e Custom+pushCustom (Custom i) = do+ Lua.newtable+ Lua.pushName "int"+ Lua.pushinteger i+ Lua.rawset (Lua.nth 3)++nopeek :: Lua.Peeker e a+nopeek = const $ Lua.failPeek "nope" -- do not allow peeking
test/test-tasty.lua view
@@ -1,6 +1,8 @@ local tasty = require 'tasty' +local arbitrary = tasty.arbitrary local assert = tasty.assert+local forall = tasty.forall local test = tasty.test_case local group = tasty.test_group @@ -10,7 +12,7 @@ test('succeeds if error matches', function () assert.error_matches( function () error 'Futurama' end,- 'tura'+ 'Futura' ) end), test('fails if function succeeds', function ()@@ -19,6 +21,32 @@ end) }, + group 'error_satisfies' {+ test('succeeds if error satisfies the assertion', function ()+ assert.error_satisfies(+ function () error(true) end,+ assert.is_true+ )+ end),+ test('fails if function succeeds', function ()+ local success = pcall(assert.error_satifies, function () end, assert)+ assert.is_falsy(success)+ end)+ },++ group 'error_equals' {+ test('succeeds if error is equal', function ()+ assert.error_equals(+ function () error(42) end,+ 42+ )+ end),+ test('fails if function succeeds', function ()+ local success = pcall(assert.error_equals, function () end, '')+ assert.is_falsy(success)+ end)+ },+ group 'is_truthy' { test('zero is truthy', function() assert.is_truthy(0) end), test('true is truthy', function() assert.is_truthy(true) end),@@ -30,6 +58,22 @@ test('nil is falsy', function() assert.is_falsy(nil) end), }, + group 'is_true' {+ test('succeeds on `true`', function() assert.is_true(true) end),+ test('fails on 1', function()+ local success = pcall(assert.is_true, 1)+ assert.is_true(not success)+ end),+ },++ group 'is_false' {+ test('succeeds on `false`', function() assert.is_false(false) end),+ test('fails on nil', function()+ local success = pcall(assert.is_false, nil)+ assert.is_false(success)+ end),+ },+ group 'is_nil' { test('nil is nil', function () assert.is_nil(nil) end) },@@ -62,4 +106,77 @@ end), }, },+ group 'access via subtable' {+ test('assert.is.truthy', function ()+ assert(assert.is.truthy == assert.is_truthy)+ end),+ test('assert.are.equal', function ()+ assert(assert.are.equal == assert.are_equal)+ end),+ test('assert.error.matches', function ()+ assert(assert.error.matches == assert.error_matches)+ end),+ },+ group 'test currying' {+ test 'test name' (+ function ()+ return+ end+ )+ },+ group 'property testing'+ {+ test(+ 'booleans',+ forall(+ arbitrary.boolean,+ function (b) return type(b) == 'boolean' end+ )+ ),+ test(+ 'numbers',+ forall(+ arbitrary.number,+ function (n) return type(n) == 'number' end+ )+ ),+ test(+ 'integers',+ forall(+ arbitrary.integer,+ function (i) return type(i) == 'number' and math.floor(i) == i end+ )+ ),+ test(+ 'strings',+ forall(+ arbitrary.string,+ function (s) return type(s) == 'string' end+ )+ ),+ test(+ 'custom',+ forall(+ arbitrary.custom,+ function (t)+ return type(t) == 'table' and type(t.int) == 'number'+ end+ )+ ),+ test(+ 'list of integers',+ forall(+ arbitrary.integer_list,+ function (nums)+ if type(nums) ~= 'table' then return false end+ for _, i in ipairs(nums) do+ if type(i) ~= 'number' then+ return false+ end+ end+ return true+ end+ )+ )+ } }