tasty-lua-1.1.1/0000755000000000000000000000000007346545000011626 5ustar0000000000000000tasty-lua-1.1.1/CHANGELOG.md0000644000000000000000000000662607346545000013451 0ustar0000000000000000# Changelog `tasty-lua` uses [PVP Versioning][]. ## tasty-lua-1.1.1 Released 2024-01-18. - Relaxed upper bound for tasty, text, and bytestring, allowing tasty-1.5, text-2.1, and bytestring-0.12. ## tasty-lua-1.1.0 Released 2023-03-13. - Fixed `peekOutcome`, allowing any result type. This gives much better results when working with custom error objects. ## tasty-lua-1.0.2 Released 2022-02-19. - Relaxed upper bound for hslua-\* packages to allow 2.2 versions. ## tasty-lua-1.0.1 Released 2022-01-29. - 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: - `tasty.arbitrary.boolean` - `tasty.arbitrary.integer` - `tasty.arbitrary.number` - `tasty.arbitrary.string` Additional generators can be added via the Haskell function `registerArbitrary`. - 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. - Added new assertion functions `is_true` and `is_false`, `error_equals`, and `error_satifies`. - Improved info message of `assert.error_matches`; the message now includes the expected pattern as well as the actual error. - Relaxed upper bound for hslua-core, hslua-marshalling. ## tasty-lua-0.2.3.2 Released 2021-01-11. - Relaxed upper bound for tasty, allowing `tasty-1.4.*`. ## tasty-lua-0.2.3.1 Released 2020-10-16. - Relaxed upper bound for hslua, allow `hslua-1.3.*`. ## tasty-lua-0.2.3 Released 2020-08-14. - CI now also builds with for GHC 8.10. - Errors are now explicitly converted to strings before matched when using `error_matches`. - Relax version limits for tasty and hslua, allowing tasty-1.3.* and hslua-1.2.*. ## tasty-lua-0.2.2 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 tasty-lua-1.1.1/LICENSE0000644000000000000000000000204407346545000012633 0ustar0000000000000000Copyright (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. tasty-lua-1.1.1/Setup.hs0000644000000000000000000000005607346545000013263 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-lua-1.1.1/src/Test/Tasty/0000755000000000000000000000000007346545000014440 5ustar0000000000000000tasty-lua-1.1.1/src/Test/Tasty/Lua.hs0000644000000000000000000001031307346545000015513 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-| Module : Test.Tasty.Lua Copyright : © 2019-2024 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Requires TemplateHaskell Convert Lua test results into a tasty test trees. -} module Test.Tasty.Lua ( -- * Lua module pushModule -- * Running tests , testLuaFile , translateResultsFromFile -- * Helpers , pathFailure , registerArbitrary ) where import Control.Exception (SomeException, try) import Data.Bifunctor (first) import Data.List (intercalate) 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) import Test.Tasty.Lua.Translate (pathFailure, translateResultsFromFile) -- | Run the given file as a single test. It is possible to use -- `tasty.lua` in the script. This test collects and summarizes all -- errors, but shows generally no information on the successful tests. testLuaFile :: forall e. LuaError e => (forall a. LuaE e a -> IO a) -> TestName -> FilePath -> TestTree testLuaFile runLua name fp = let testAction = TestCase $ do eitherResult <- runLua (runTastyFile @e fp) return $ case eitherResult of Left errMsg -> FailureSummary [([name], errMsg)] Right result -> summarize result in singleTest name testAction -- | Lua test case action newtype TestCase = TestCase (IO ResultSummary) instance IsTest TestCase where run _ (TestCase action) _ = do result <- try action return $ case result of Left e -> testFailed (show (e :: SomeException)) Right summary -> case summary of SuccessSummary n -> testPassed $ "+++ Success: " ++ show n ++ " Lua tests passed" FailureSummary fails -> testFailed $ concatMap stringifyFailureGist fails testOptions = return [] summarize :: [ResultTree] -> ResultSummary summarize = foldr ((<>) . collectSummary) (SuccessSummary 0) -- | Failure message generated by tasty.lua type LuaErrorMessage = String -- | Info about a single failure type FailureInfo = ([TestName], LuaErrorMessage) -- | Summary about a test result data ResultSummary = SuccessSummary Int -- ^ Number of successful tests | FailureSummary [FailureInfo] -- ^ Failure messages, together with the test paths -- | Convert a test failure, given as the pair of the test's path and -- its error message, into an error string. stringifyFailureGist :: FailureInfo -> String stringifyFailureGist (names, msg) = intercalate " // " names ++ ":\n" ++ msg ++ "\n\n" -- | Combine all failures (or successes) from a test result tree into a -- @'ResultSummary'@. If the tree contains only successes, the result -- will be @'SuccessSummary'@ with the number of successful tests; if -- there was at least one failure, the result will be -- @'FailureSummary'@, with a @'FailureInfo'@ for each failure. collectSummary :: ResultTree -> ResultSummary collectSummary (ResultTree name tree) = case tree of SingleTest Success -> SuccessSummary 1 SingleTest (Failure msg) -> FailureSummary [([name], msg)] TestGroup subtree -> foldMap (addGroup name . collectSummary) subtree -- | Add the name of the current test group to all failure summaries. addGroup :: TestName -> ResultSummary -> ResultSummary addGroup name (FailureSummary fs) = FailureSummary (map (first (name:)) fs) addGroup _name summary = summary instance Semigroup ResultSummary where (SuccessSummary n) <> (SuccessSummary m) = SuccessSummary (n + m) (SuccessSummary _) <> (FailureSummary fs) = FailureSummary fs (FailureSummary fs) <> (SuccessSummary _) = FailureSummary fs (FailureSummary fs) <> (FailureSummary gs) = FailureSummary (fs ++ gs) instance Monoid ResultSummary where mempty = SuccessSummary 0 mappend = (<>) -- GHC 8.2 compatibility tasty-lua-1.1.1/src/Test/Tasty/Lua/0000755000000000000000000000000007346545000015161 5ustar0000000000000000tasty-lua-1.1.1/src/Test/Tasty/Lua/Arbitrary.hs0000644000000000000000000000363707346545000017465 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-| Module : Test.Tasty.Lua.Arbitrary Copyright : © 2019-2024 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 tasty-lua-1.1.1/src/Test/Tasty/Lua/Core.hs0000644000000000000000000000476107346545000016415 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Test.Tasty.Lua.Core Copyright : © 2019-2024 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Core types and functions for tasty Lua tests. -} module Test.Tasty.Lua.Core ( runTastyFile , ResultTree (..) , Outcome (..) , UnnamedTree (..) ) where import Control.Monad ((<$!>), void) import HsLua.Core (LuaE, LuaError, pop, toboolean, top) import HsLua.Marshalling ( Peeker, lastly, liftLua, resultToEither, retrieving , peekFieldRaw, peekList, peekString, runPeek) import Test.Tasty.Lua.Module (pushModule) 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 -- test tree or the error message. runTastyFile :: LuaError e => FilePath -> LuaE e (Either String [ResultTree]) runTastyFile fp = do Lua.openlibs Lua.requirehs "tasty" (const . void $ pushModule) res <- Lua.dofileTrace (Just fp) if res /= Lua.OK then Left . Utf8.toString <$> Lua.tostring' top else resultToEither <$> runPeek (peekList peekResultTree top) -- | 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. data ResultTree = ResultTree Tasty.TestName UnnamedTree peekResultTree :: LuaError e => Peeker e ResultTree peekResultTree idx = do 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 | TestGroup [ResultTree] -- | Unmarshal an @'UnnamedTree'@. peekUnnamedTree :: LuaError e => Peeker e UnnamedTree peekUnnamedTree idx = liftLua (Lua.ltype idx) >>= \case Lua.TypeTable -> TestGroup <$!> peekList peekResultTree idx _ -> SingleTest <$!> peekOutcome idx -- | Test outcome data Outcome = Success | Failure String -- | Unmarshal a test outcome peekOutcome :: LuaError e => Peeker e Outcome peekOutcome idx = retrieving "test result" $ do liftLua (Lua.ltype idx) >>= \case Lua.TypeString -> Failure <$!> peekString idx Lua.TypeBoolean -> do b <- liftLua $ toboolean idx return $ if b then Success else Failure "???" _ -> Failure <$!> (liftLua (Lua.tostring' idx) *> peekString top) `lastly` pop 1 tasty-lua-1.1.1/src/Test/Tasty/Lua/Module.hs0000644000000000000000000000205507346545000016744 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-| Module : Test.Tasty.Lua.Module Copyright : © 2019-2024 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Tasty Lua module, providing the functions necessary to write tasty tests in Lua scripts. -} module Test.Tasty.Lua.Module ( pushModule ) where import Data.ByteString (ByteString) import Data.FileEmbed import HsLua.Core ( 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 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 #-} tasty-lua-1.1.1/src/Test/Tasty/Lua/Translate.hs0000644000000000000000000000356107346545000017457 0ustar0000000000000000{-| Module : Test.Tasty.Lua.Translate Copyright : © 2019-2024 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Translate test results from Lua into a Tasty @'TestTree'@. -} module Test.Tasty.Lua.Translate ( translateResultsFromFile , pathFailure ) where import HsLua.Core (LuaE, LuaError) import Test.Tasty.Lua.Core (Outcome (..), ResultTree (..), UnnamedTree (..), runTastyFile) import qualified Test.Tasty as Tasty import qualified Test.Tasty.Providers as Tasty -- | 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 = 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 pathFailure fp errMsg = Tasty.singleTest fp (MockTest (Failure errMsg)) -- | Convert internal (tasty.lua) result tree format into Tasty tree. testTree :: ResultTree -> Tasty.TestTree testTree (ResultTree name tree) = case tree of SingleTest outcome -> Tasty.singleTest name (MockTest outcome) TestGroup results -> Tasty.testGroup name (map testTree results) -- | Mock test which just returns the predetermined outcome. An -- @'Outcome'@ can be treated like a Tasty test, as it encodes all -- necessary information. Usually, calling @'run'@ would trigger the -- execution of the test, but in this case, the test has already been -- run when the Lua script was executed. newtype MockTest = MockTest Outcome instance Tasty.IsTest MockTest where run _ (MockTest outcome) _ = return $ case outcome of Success -> Tasty.testPassed "" Failure msg -> Tasty.testFailed msg testOptions = return [] tasty-lua-1.1.1/tasty-lua.cabal0000644000000000000000000000566607346545000014552 0ustar0000000000000000cabal-version: 2.2 name: tasty-lua version: 1.1.1 synopsis: Write tests in Lua, integrate into tasty. description: Allow users to define tasty tests from Lua. homepage: https://github.com/hslua/hslua license: MIT license-file: LICENSE author: Albert Krewinkel maintainer: tarleb@hslua.org copyright: © 2019-2024 Albert Krewinkel category: Foreign build-type: Simple extra-source-files: CHANGELOG.md , tasty.lua , test/test-tasty.lua tested-with: GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.3 , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8 , GHC == 9.4.8 , GHC == 9.6.3 , GHC == 9.8.1 source-repository head type: git location: https://github.com/hslua/hslua.git subdir: tasty-lua common common-options default-language: Haskell2010 build-depends: base >= 4.11 && < 5 , bytestring >= 0.10.2 && < 0.13 , hslua-core >= 2.3 && < 2.4 , hslua-marshalling >= 2.0 && < 2.4 , lua-arbitrary >= 1.0 && < 1.1 , tasty >= 1.2 && < 1.6 , 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.2 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 other-extensions: OverloadedStrings , ScopedTypeVariables , TemplateHaskell test-suite test-tasty-lua import: common-options type: exitcode-stdio-1.0 main-is: test-tasty-lua.hs hs-source-dirs: test ghc-options: -threaded build-depends: directory , filepath >= 1.4 , tasty-lua , tasty-hunit tasty-lua-1.1.1/tasty.lua0000644000000000000000000001564607346545000013511 0ustar0000000000000000------------------------------------------------------------------------ --- 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. }) --- 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 -- 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, but error could not be formatted:\n' .. tostring(message), 1) end error('\n' .. message or 'assertion failed!', 2) end end --- Value is truthy assert.is_truthy = make_assertion( "expected a truthy value, got %s", function (x) return x ~= false and x ~= nil end ) --- Value is falsy 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 assert.is_nil = make_assertion( "expected nil, got %s", function (x) return x == nil end ) --- Values are equal 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 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 assert.are_same = make_assertion( 'expected same values, got %s and %s', function (x, y) return cycle_aware_compare(x, y, {}) end ) --- 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 ) --- 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 ) --- 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 ) ------------------------------------------------------------------------ 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) 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) 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 ------------------------------------------------------------------------ -- 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 = assert, forall = forall, ok = ok, test_case = test_case, test_group = test_group } tasty-lua-1.1.1/test/0000755000000000000000000000000007346545000012605 5ustar0000000000000000tasty-lua-1.1.1/test/test-tasty-lua.hs0000644000000000000000000000503407346545000016043 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : Main Copyright : © 2019-2024 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel 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, 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 $ 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 $ do Lua.openlibs void pushModule :: Lua () , 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.loadstring "return package.preload.tasty" *> Lua.call 0 1 Lua.ltype (-1) , testCase "can be loaded as tasty" . Lua.run $ do Lua.openlibs Lua.requirehs "tasty" (const $ void pushModule) assertEqual' "loading the module fails " Lua.OK =<< Lua.dostring "require 'tasty'" , testGroup "testFileWith" [ 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 tasty-lua-1.1.1/test/test-tasty.lua0000644000000000000000000001105607346545000015434 0ustar0000000000000000local 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 return { group 'assertors' { group 'error_matches' { test('succeeds if error matches', function () assert.error_matches( function () error 'Futurama' end, 'Futura' ) end), test('fails if function succeeds', function () local success = pcall(assert.error_matches, function () end, '') assert.is_falsy(success) 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), test('empty string is truthy', function() assert.is_truthy '' end), }, group 'is_falsy' { test('false is falsy', function() assert.is_falsy(false) end), 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) }, group 'are_equal' { test('equal strings', function () assert.are_equal('test', 'test') end) }, group 'are_same' { test('numbers', function () assert.are_same(1, 1) end), test('nil', function () assert.are_same(nil, nil) end), test('table', function () assert.are_same({2, 3, 5, 7}, {2, 3, 5, 7}) end), test('unequal numbers', function () assert.error_matches( function () assert.are_same(0, 1) end, "expected same values, got 0 and 1" ) end), test('tables', function () assert.error_matches( function () assert.are_same({}, {1}) end, "expected same values, got" ) 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 ) ) } }