diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/src/Test/Tasty/Lua.hs b/src/Test/Tasty/Lua.hs --- a/src/Test/Tasty/Lua.hs +++ b/src/Test/Tasty/Lua.hs @@ -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 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) diff --git a/src/Test/Tasty/Lua/Arbitrary.hs b/src/Test/Tasty/Lua/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/src/Test/Tasty/Lua/Arbitrary.hs @@ -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 + +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 diff --git a/src/Test/Tasty/Lua/Core.hs b/src/Test/Tasty/Lua/Core.hs --- a/src/Test/Tasty/Lua/Core.hs +++ b/src/Test/Tasty/Lua/Core.hs @@ -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 -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 diff --git a/src/Test/Tasty/Lua/Module.hs b/src/Test/Tasty/Lua/Module.hs --- a/src/Test/Tasty/Lua/Module.hs +++ b/src/Test/Tasty/Lua/Module.hs @@ -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 -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 #-} diff --git a/src/Test/Tasty/Lua/Translate.hs b/src/Test/Tasty/Lua/Translate.hs --- a/src/Test/Tasty/Lua/Translate.hs +++ b/src/Test/Tasty/Lua/Translate.hs @@ -1,10 +1,8 @@ {-| Module : Test.Tasty.Lua.Translate -Copyright : © 2019–2021 Albert Krewinkel +Copyright : © 2019–2022 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel -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 diff --git a/stack.yaml b/stack.yaml deleted file mode 100644 --- a/stack.yaml +++ /dev/null @@ -1,4 +0,0 @@ -resolver: lts-14.21 - -ghc-options: - "$locals": -fhide-source-paths diff --git a/tasty-lua.cabal b/tasty-lua.cabal --- a/tasty-lua.cabal +++ b/tasty-lua.cabal @@ -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 +copyright: © 2019–2022 Albert Krewinkel 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 diff --git a/tasty.lua b/tasty.lua --- a/tasty.lua +++ b/tasty.lua @@ -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 diff --git a/test/test-tasty-lua.hs b/test/test-tasty-lua.hs --- a/test/test-tasty-lua.hs +++ b/test/test-tasty-lua.hs @@ -2,37 +2,40 @@ {-# LANGUAGE TypeApplications #-} {-| Module : Main -Copyright : © 2019-2021 Albert Krewinkel +Copyright : © 2019-2022 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel -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 diff --git a/test/test-tasty.lua b/test/test-tasty.lua --- a/test/test-tasty.lua +++ b/test/test-tasty.lua @@ -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 + ) + ) + } }