tinycheck 0.1.0.0 → 0.2.0
raw patch · 6 files changed
+278/−39 lines, 6 filesdep +deepseqdep +tasty-benchdep +transformers
Dependencies added: deepseq, tasty-bench, transformers
Files
- CHANGELOG.md +6/−2
- bench/Main.hs +85/−0
- src/Data/TestCases.hs +11/−2
- src/Test/Tasty/TinyCheck.hs +107/−26
- test/Test/Combinators.hs +36/−0
- tinycheck.cabal +33/−9
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for tinycheck -## 0.1.0.0 -- YYYY-mm-dd+## 0.2.0 -* First version. Released on an unsuspecting world.+* Improved Tasty integration++## 0.1.0.0++* First version.
+ bench/Main.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}++{- | Benchmarks for tinycheck's test-case generators.++Each benchmark measures how quickly @take N (getTestCases gen)@ can produce+and fully force @N@ values, for a representative set of generators.+This captures both the enumeration cost and the cost of building the values.+-}+module Main where++-- base+import GHC.Generics (Generic, Generically (..))++-- deepseq+import Control.DeepSeq (NFData)++-- tasty-bench+import Test.Tasty.Bench++-- tinycheck++import Data.Functor ((<&>))+import Data.TestCases (Arbitrary (..), getTestCases)+import Test.Tasty (localOption, mkTimeout)++-- * Real-life data structure: binary search tree++data Tree a = Leaf | Node (Tree a) a (Tree a)+ deriving stock (Show, Eq, Foldable, Generic)+ deriving anyclass (NFData)+ deriving (Arbitrary) via Generically (Tree a)++-- * Benchmark helpers++-- | Counts used for generators.+counts :: [Int]+counts = [100, 1000, 10_000]++{- | Benchmark a single generator at a given list of counts.+The group name is the type/description; each leaf is labelled by the count.+The generator is instantiated fresh for every individual benchmark run+so that no list spine is shared or retained between runs.+-}+benchGenWith :: forall a. (Arbitrary a, NFData a) => [Int] -> String -> Benchmark+benchGenWith ns name =+ bgroup name $+ ns <&> \n ->+ localOption (mkTimeout 5_000_000) $+ bench (show n) $+ nf (\n' -> take n' $ getTestCases $ arbitrary @a) n++-- | 'benchGenWith' at 'counts'+benchGen :: forall a. (Arbitrary a, NFData a) => String -> Benchmark+benchGen = benchGenWith @a counts++-- * Main++main :: IO ()+main =+ defaultMain+ [ bgroup+ "primitives"+ [ benchGen @Int "Int"+ , benchGen @Char "Char"+ , benchGen @Integer "Integer"+ ]+ , bgroup+ "composites"+ [ benchGen @(Int, Int) "(Int, Int)"+ , benchGen @(Maybe Int) "Maybe Int"+ , benchGen @(Either Int Bool) "Either Int Bool"+ ]+ , bgroup+ "lists"+ [ benchGen @[Int] "[Int]"+ , benchGen @[Bool] "[Bool]"+ ]+ , bgroup+ "Tree Int"+ [ benchGen @(Tree Int) "Tree Int"+ ]+ ]
src/Data/TestCases.hs view
@@ -62,7 +62,7 @@ where -- base-import Control.Monad (ap, forM_, replicateM, unless)+import Control.Monad (forM_, replicateM, unless) import Data.Char (GeneralCategory (..), chr, generalCategory) import Data.Coerce (coerce) import Data.Complex (Complex (..))@@ -229,7 +229,16 @@ instance Applicative TestCases where pure = testCase- (<*>) = ap++ -- Apply each function to the entire argument generator and interleave results.+ --+ -- Written as @'foldMap' ('fmap' f) fs@ rather than @'ap'@, this avoids the+ -- inner @'foldMap' ('pure' . f)@ that @'ap'@ would generate: instead of+ -- wrapping each @f x@ in a singleton and then immediately unwrapping it+ -- via @'<>'@, we apply @f@ to the whole @xs@ list in one @'map'@ pass.+ -- The outer @'foldMap'@ then interleaves those result lists with @'<>'@.+ --+ TestCases fs <*> xs = foldMap (`fmap` xs) fs {- | Bind via 'foldMap', which accumulates results with the interleaving '<>'.
src/Test/Tasty/TinyCheck.hs view
@@ -11,6 +11,10 @@ \(xs :: [Int]) -> reverse (reverse xs) == xs , testProperty "length . nub <= length" $ \(xs :: [Int]) -> length (nub xs) <= length xs+, testProperty "manual generators" $ do+ xs <- forAllShow "xs" (arbitrary :: TestCases [Int])+ ys <- forAllShow "ys" (arbitrary :: TestCases [Int])+ assert $ length (xs ++ ys) == length xs + length ys ] :} -}@@ -18,6 +22,12 @@ -- * Defining properties Property, property,+ assert,+ assertEqual,+ forAll,+ forAllWith,+ forAllShow,+ debug, (==>), -- * Checking properties@@ -35,10 +45,13 @@ where -- base-import Control.Monad (void) import Data.List (isInfixOf) import Data.Proxy (Proxy (..)) +-- transformers+import Control.Monad.Trans.Except (ExceptT (..), runExceptT)+import Control.Monad.Trans.Writer.Strict (WriterT (..), runWriter, writer)+ -- tagged import Data.Tagged (Tagged (..)) @@ -53,49 +66,117 @@ -- * Property -{- | A testable property: a 'TestCases' of outcomes, each being either-'Right ()' for a pass or 'Left msg' for a failure with a message.+{- | Enumerate test cases, log, and assert conditions. -Build one with 'property' (or its operator alias '==>') or simply-use a function @a -> Bool@ / @a -> Property@ directly via 'testProperty'.+Build properties with @do@-notation:++> testProperty "commutativity" $ do+> -- Enumerate test cases+> x <- forAll generatorX+> -- Log the generated case+> y <- forAllShow "y" generatorY+> -- Log debug information+> debug $ "x + y = " <> show (x + y)+> -- Assert the property holds for the generated case+> assert $ x + y == (y :: Int) + x++For a plain 'Bool' or a function, you can pass it directly to 'testProperty' via the 'Testable' class. -}-newtype Property = Property (TestCases (Either String ()))+newtype Property a = Property (TestCases (Either String a, [String]))+ deriving (Functor, Applicative, Monad) via (ExceptT String (WriterT [String] TestCases)) --- | Promote a 'Bool' to a 'Property'. Failures carry no extra message.-property :: Bool -> Property-property True = Property $ TestCases [Right ()]-property False = Property $ TestCases [Left "falsified"]+instance MonadFail Property where+ fail = Property . pure . (,[]) . Left +-- | Promote a 'Bool' to a 'Property ()'. Failures carry no extra message.+property :: Bool -> Property ()+property True = pure ()+property False = fail "falsified"++{- | Assert a boolean condition within a 'Property' @do@-block.+Fails with @\"falsified\"@ if the condition is 'False'.++> testProperty "commutativity" $ do+> x <- forAll arbitrary+> y <- forAll arbitrary+> assert $ x + y == (y :: Int) + x+-}+assert :: Bool -> Property ()+assert = property++-- | Like 'assert', logging the expected and actual values on failure.+assertEqual :: (Eq a, Show a) => a -> a -> Property ()+assertEqual expected actual = do+ debug $ "Expected: " <> show expected+ debug $ "Actual: " <> show actual+ assert (expected == actual)++{- | Sample from a 'TestCases' generator in the 'Property' monad.++> testProperty "my test" $ do+> x <- forAll generator1+> y <- forAll generator2+> assert $ somePredicate x y+-}+forAll :: TestCases a -> Property a+forAll gen = Property $ fmap ((,[]) . Right) gen++{- | Like 'forAll', but prepend the rendered value to any failure message produced by the continuation.++Useful when the generator is not 'Show'-able or when you want a custom rendering:++> testProperty "sorted" $ do+> xs <- forAllWith (\xs -> "First 3 generated elements = " <> show (take 3 xs)) (arbitrary :: TestCases [Int])+> assert $ sort xs == xs+-}+forAllWith :: (a -> String) -> TestCases a -> Property a+forAllWith showFn gen = Property $ fmap (\a -> (Right a, [showFn a])) gen++{- | Like 'forAllWith', specialised to 'show', with a tag prepended to the rendered value.++In a @do@-block, the tag and value appear in the failure log as @"tag: value"@:++> testProperty "sorted" $ do+> xs <- forAllShow "xs" (arbitrary :: TestCases [Int])+> assert $ sort xs == xs+-}+forAllShow :: (Show a) => String -> TestCases a -> Property a+forAllShow tag = forAllWith (\a -> tag <> ": " <> show a)++{- | Append a line of debug information to the log for the current test case.+The line appears in the failure message if the property fails; it is discarded on success.++> do+> x <- forAll arbitrary+> debug $ "x = " <> show (x :: Int)+> assert $ x > 0+-}+debug :: String -> Property ()+debug msg = Property $ pure (Right (), [msg])+ {- | Conditional property: if the precondition is 'False' the test case is /discarded/ (treated as a pass), just like QuickCheck's @==>@. -}-(==>) :: Bool -> Property -> Property+(==>) :: Bool -> Property () -> Property () True ==> p = p-False ==> _ = Property $ TestCases [Right ()]+False ==> _ = pure () infixr 0 ==> -- * Testable class --- | Types that can be converted to a 'Property'.+-- | Types that can be converted to a 'Property ()'. class Testable a where- toProperty :: a -> Property+ toProperty :: a -> Property () instance Testable Bool where toProperty = property -instance Testable Property where+instance Testable (Property ()) where toProperty = id instance (Arbitrary a, Show a, Testable prop) => Testable (a -> prop) where- toProperty f = Property $ do- a <- arbitrary- let Property outcomes = toProperty (f a)- -- Annotate failures with the offending input.- fmap (void . prependInput a) outcomes- where- prependInput a (Left msg) = Left $ show a <> "\n" <> msg- prependInput _ r = r+ toProperty f = forAllWith show arbitrary >>= toProperty . f -- * Option: number of test cases @@ -123,9 +204,9 @@ let TinyCheckTests n = lookupOption opts Property cases = toProperty prop results = take n (getTestCases cases)- case sequence_ results of- Right () -> pure $ testPassed $ "OK, checked " <> show (length results) <> " cases"- Left msg -> pure $ testFailed msg+ case runWriter $ runExceptT $ mapM_ (ExceptT . writer) results of+ (Right (), _) -> pure $ testPassed $ "OK, checked " <> show (length results) <> " cases"+ (Left msg, logs) -> pure $ testFailed $ unlines logs <> msg -- * Public API
test/Test/Combinators.hs view
@@ -74,6 +74,42 @@ /= ((,) <$> "abc" <*> [1, 2, 3, 4, 5, 6]) ] , testGroup+ "do-notation / assert / forAll"+ [ testProperty "assert True passes" $+ assert True+ , testProperty "forAll: all elements of a generator satisfy a predicate" $+ forAll (TestCases [1 .. 10 :: Int])+ >>= \n -> assert (n > 0)+ , testProperty "do-block: two generators, Bool result" $ do+ x <- forAll $ TestCases [1 .. 5 :: Int]+ y <- forAll $ TestCases [1 .. 5 :: Int]+ assert $ x + y > 0+ , testProperty "do-block: two generators, Bool property" $ do+ x <- forAll $ TestCases [1 .. 5 :: Int]+ y <- forAll $ TestCases [1 .. 5 :: Int]+ assert $ x * y == y * x+ , testProperty "do-block: two arbitrary lists" $ do+ xs <- forAll (arbitrary :: TestCases [Int])+ ys <- forAll (arbitrary :: TestCases [Int])+ assert $ length (xs <> ys) == length xs + length ys+ , testProperty "do-block: sort is idempotent" $ do+ xs <- forAll (arbitrary :: TestCases [Int])+ assert $ sort (sort xs) == sort xs+ , expectFailureWithN 1 "first 3:" "forAllWith: logs rendered value on failure" $ do+ xs <- forAllWith (\xs -> "first 3: " <> show (take 3 xs)) (TestCases [[-1, -2, -3]] :: TestCases [Int])+ assert $ all (> 0) xs+ , expectFailureWithN 1 "xs:" "forAllShow: logs tag: value on failure" $ do+ xs <- forAllShow "xs" (TestCases [[-1]] :: TestCases [Int])+ assert $ all (> 0) xs+ , expectFailureWithN 1 "debug info" "debug: log line appears in failure message" $ do+ debug "debug info"+ assert False+ , testProperty "assertEqual: passes for equal values" $+ assertEqual (42 :: Int) 42+ , expectFailureWithN 1 "Expected: 1" "assertEqual: shows expected and actual on failure" $+ assertEqual (1 :: Int) 2+ ]+ , testGroup "CoArbitrary newtype wrappers (nontrivial functions)" [ testProperty "IntegralCoArbitrary: some f distinguishes 0 from 1" $ -- A constant function satisfies f 0 == f 1 for all inputs, but the
tinycheck.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: tinycheck-version: 0.1.0.0+version: 0.2.0 synopsis: A lightweight enumeration-based property testing library description: Tinycheck is a deterministic property testing library.@@ -29,11 +29,27 @@ default: False manual: True +flag dump-core+ description: Emit GHC Core output (.dump-simpl files) for inspection+ default: False+ manual: True+ common opts ghc-options: -Wall if flag(dev) ghc-options: -Werror++ if flag(dump-core)+ ghc-options:+ -ddump-simpl+ -ddump-to-file+ -dsuppress-coercions+ -dsuppress-type-applications+ -dsuppress-idinfo+ -dsuppress-module-prefixes+ -dppr-case-as-let+ -O2 default-extensions: DataKinds DefaultSignatures@@ -45,11 +61,9 @@ TypeFamilies default-language: GHC2021- build-depends: base >=4.17 && <4.22--common test-opts- import: opts- build-depends: tasty >=1.5 && <1.6+ build-depends:+ base >=4.17 && <4.22,+ tasty >=1.5 && <1.6, library import: opts@@ -60,12 +74,12 @@ build-depends: generics-sop >=0.5 && <0.6, tagged >=0.8 && <0.9,- tasty >=1.5 && <1.6,+ transformers >=0.5.6.2 && <0.7, hs-source-dirs: src test-suite tinycheck-test- import: test-opts+ import: opts type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs@@ -86,8 +100,18 @@ build-depends: tinycheck test-suite example-tree- import: test-opts+ import: opts type: exitcode-stdio-1.0 hs-source-dirs: examples main-is: Tree.hs build-depends: tinycheck++benchmark tinycheck-bench+ import: opts+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Main.hs+ build-depends:+ deepseq >=1.4 && <1.6,+ tasty-bench >=0.3 && <0.5,+ tinycheck,