falsify 0.2.0 → 0.3.0
raw patch · 18 files changed
+304/−112 lines, 18 filesdep −transformersdep ~QuickCheckdep ~basedep ~containersPVP ok
version bump matches the API change (PVP)
Dependencies removed: transformers
Dependency ranges changed: QuickCheck, base, containers, optparse-applicative
API changes (from Hackage documentation)
- Test.Falsify.GenDefault: instance (GHC.Exts.IsList l, Test.Falsify.GenDefault.GenDefault tag (GHC.Exts.Item l), GHC.TypeNats.KnownNat mn, GHC.TypeNats.KnownNat mx) => Test.Falsify.GenDefault.GenDefault tag (Test.Falsify.GenDefault.ViaList l mn mx)
- Test.Falsify.Generator: data (:->) :: Type -> Type -> Type
+ Test.Falsify.GenDefault: instance (GHC.IsList.IsList l, Test.Falsify.GenDefault.GenDefault tag (GHC.IsList.Item l), GHC.TypeNats.KnownNat mn, GHC.TypeNats.KnownNat mx) => Test.Falsify.GenDefault.GenDefault tag (Test.Falsify.GenDefault.ViaList l mn mx)
+ Test.Falsify.Generator: ($dmfunction) :: (Function a, Generic a, GFunction (Rep a)) => Gen b -> Gen (a :-> b)
+ Test.Falsify.Generator: data a :-> b
+ Test.Falsify.Generator: minimalValue :: Gen a -> a
+ Test.Falsify.Range: uniform :: (Integral a, FiniteBits a, Bounded a) => Range a
- Test.Falsify.Generator: Marked :: Mark -> f a -> Marked f a
+ Test.Falsify.Generator: Marked :: Mark -> f a -> Marked (f :: Type -> Type) a
- Test.Falsify.Generator: [getMark] :: Marked f a -> Mark
+ Test.Falsify.Generator: [getMark] :: Marked (f :: Type -> Type) a -> Mark
- Test.Falsify.Generator: [unmark] :: Marked f a -> f a
+ Test.Falsify.Generator: [unmark] :: Marked (f :: Type -> Type) a -> f a
- Test.Falsify.Generator: bst :: forall a b. Integral a => (a -> Gen b) -> Interval a -> Gen (Tree (a, b))
+ Test.Falsify.Generator: bst :: Integral a => (a -> Gen b) -> Interval a -> Gen (Tree (a, b))
- Test.Falsify.Generator: data Marked f a
+ Test.Falsify.Generator: data Marked (f :: Type -> Type) a
- Test.Falsify.Generator: firstThen :: forall a. a -> a -> Gen a
+ Test.Falsify.Generator: firstThen :: a -> a -> Gen a
- Test.Falsify.Generator: frequency :: forall a. [(Word, Gen a)] -> Gen a
+ Test.Falsify.Generator: frequency :: [(Word, Gen a)] -> Gen a
- Test.Falsify.Generator: fromShrinkTree :: forall a. Tree a -> Gen a
+ Test.Falsify.Generator: fromShrinkTree :: Tree a -> Gen a
- Test.Falsify.Generator: function :: (Function a, Generic a, GFunction (Rep a)) => Gen b -> Gen (a :-> b)
+ Test.Falsify.Generator: function :: Function a => Gen b -> Gen (a :-> b)
- Test.Falsify.Generator: path :: forall a p n. (a -> IsValidShrink p n) -> ShrinkTree a -> Gen (Either n (NonEmpty p))
+ Test.Falsify.Generator: path :: (a -> IsValidShrink p n) -> ShrinkTree a -> Gen (Either n (NonEmpty p))
- Test.Falsify.Generator: shrinkToOneOf :: forall a. a -> [a] -> Gen a
+ Test.Falsify.Generator: shrinkToOneOf :: a -> [a] -> Gen a
- Test.Falsify.Generator: shrinkWith :: forall a. (a -> [a]) -> Gen a -> Gen a
+ Test.Falsify.Generator: shrinkWith :: (a -> [a]) -> Gen a -> Gen a
- Test.Falsify.Generator: toShrinkTree :: forall a. Gen a -> Gen (Tree a)
+ Test.Falsify.Generator: toShrinkTree :: Gen a -> Gen (Tree a)
- Test.Falsify.Generator: tree :: forall a. Range Word -> Gen a -> Gen (Tree a)
+ Test.Falsify.Generator: tree :: Range Word -> Gen a -> Gen (Tree a)
- Test.Falsify.Interactive: falsify :: forall e a. Property' e a -> IO (Maybe e)
+ Test.Falsify.Interactive: falsify :: Property' e a -> IO (Maybe e)
- Test.Falsify.Interactive: falsify' :: forall e a. Property' e a -> IO (Maybe (NonEmpty e))
+ Test.Falsify.Interactive: falsify' :: Property' e a -> IO (Maybe (NonEmpty e))
- Test.Falsify.Interactive: shrink :: forall a. (a -> Bool) -> Gen a -> IO (Maybe a)
+ Test.Falsify.Interactive: shrink :: (a -> Bool) -> Gen a -> IO (Maybe a)
- Test.Falsify.Predicate: (.$) :: Show x => Predicate (x : xs) -> (Var, x) -> Predicate xs
+ Test.Falsify.Predicate: (.$) :: forall x (xs :: [Type]). Show x => Predicate (x ': xs) -> (Var, x) -> Predicate xs
- Test.Falsify.Predicate: alwaysFail :: Predicate xs
+ Test.Falsify.Predicate: alwaysFail :: forall (xs :: [Type]). Predicate xs
- Test.Falsify.Predicate: alwaysPass :: Predicate xs
+ Test.Falsify.Predicate: alwaysPass :: forall (xs :: [Type]). Predicate xs
- Test.Falsify.Predicate: at :: Predicate (x : xs) -> (Var, String, x) -> Predicate xs
+ Test.Falsify.Predicate: at :: forall x (xs :: [Type]). Predicate (x ': xs) -> (Var, String, x) -> Predicate xs
- Test.Falsify.Predicate: binary :: (a -> b -> Bool) -> (Expr -> Expr -> Err) -> Predicate [a, b]
+ Test.Falsify.Predicate: binary :: (a -> b -> Bool) -> (Expr -> Expr -> Err) -> Predicate '[a, b]
- Test.Falsify.Predicate: data Predicate :: [Type] -> Type
+ Test.Falsify.Predicate: data Predicate (a :: [Type])
- Test.Falsify.Predicate: dot :: Predicate (x : xs) -> Fn y x -> Predicate (y : xs)
+ Test.Falsify.Predicate: dot :: forall x (xs :: [Type]) y. Predicate (x ': xs) -> Fn y x -> Predicate (y ': xs)
- Test.Falsify.Predicate: elem :: Eq a => Predicate [[a], a]
+ Test.Falsify.Predicate: elem :: Eq a => Predicate '[[a], a]
- Test.Falsify.Predicate: eq :: Eq a => Predicate [a, a]
+ Test.Falsify.Predicate: eq :: Eq a => Predicate '[a, a]
- Test.Falsify.Predicate: eval :: Predicate '[] -> Either Err ()
+ Test.Falsify.Predicate: eval :: Predicate ('[] :: [Type]) -> Either Err ()
- Test.Falsify.Predicate: flip :: Predicate (x : (y : zs)) -> Predicate (y : (x : zs))
+ Test.Falsify.Predicate: flip :: forall x y (zs :: [Type]). Predicate (x ': (y ': zs)) -> Predicate (y ': (x ': zs))
- Test.Falsify.Predicate: ge :: Ord a => Predicate [a, a]
+ Test.Falsify.Predicate: ge :: Ord a => Predicate '[a, a]
- Test.Falsify.Predicate: gt :: Ord a => Predicate [a, a]
+ Test.Falsify.Predicate: gt :: Ord a => Predicate '[a, a]
- Test.Falsify.Predicate: le :: Ord a => Predicate [a, a]
+ Test.Falsify.Predicate: le :: Ord a => Predicate '[a, a]
- Test.Falsify.Predicate: lt :: Ord a => Predicate [a, a]
+ Test.Falsify.Predicate: lt :: Ord a => Predicate '[a, a]
- Test.Falsify.Predicate: matchBool :: Predicate xs -> Predicate xs -> Predicate (Bool : xs)
+ Test.Falsify.Predicate: matchBool :: forall (xs :: [Type]). Predicate xs -> Predicate xs -> Predicate (Bool ': xs)
- Test.Falsify.Predicate: matchEither :: Predicate (a : xs) -> Predicate (b : xs) -> Predicate (Either a b : xs)
+ Test.Falsify.Predicate: matchEither :: forall a (xs :: [Type]) b. Predicate (a ': xs) -> Predicate (b ': xs) -> Predicate (Either a b ': xs)
- Test.Falsify.Predicate: ne :: Eq a => Predicate [a, a]
+ Test.Falsify.Predicate: ne :: Eq a => Predicate '[a, a]
- Test.Falsify.Predicate: on :: Predicate (x : (x : xs)) -> Fn y x -> Predicate (y : (y : xs))
+ Test.Falsify.Predicate: on :: forall x (xs :: [Type]) y. Predicate (x ': (x ': xs)) -> Fn y x -> Predicate (y ': (y ': xs))
- Test.Falsify.Predicate: pairwise :: forall a. Show a => Predicate [a, a] -> Predicate '[[a]]
+ Test.Falsify.Predicate: pairwise :: Show a => Predicate '[a, a] -> Predicate '[[a]]
- Test.Falsify.Predicate: relatedBy :: (Var, a -> b -> Bool) -> Predicate [a, b]
+ Test.Falsify.Predicate: relatedBy :: (Var, a -> b -> Bool) -> Predicate '[a, b]
- Test.Falsify.Predicate: split :: Predicate (x' : (y' : xs)) -> (Fn x x', Fn y y') -> Predicate (x : (y : xs))
+ Test.Falsify.Predicate: split :: forall x' y' (xs :: [Type]) x y. Predicate (x' ': (y' ': xs)) -> (Fn x x', Fn y y') -> Predicate (x ': (y ': xs))
- Test.Falsify.Predicate: towards :: forall a. (Show a, Ord a, Num a) => a -> Predicate [a, a]
+ Test.Falsify.Predicate: towards :: (Show a, Ord a, Num a) => a -> Predicate '[a, a]
- Test.Falsify.Property: assert :: Predicate '[] -> Property' String ()
+ Test.Falsify.Property: assert :: Predicate ('[] :: [Type]) -> Property' String ()
- Test.Falsify.Property: testGen :: forall a. Show a => Predicate '[a] -> Gen a -> Property' String ()
+ Test.Falsify.Property: testGen :: Show a => Predicate '[a] -> Gen a -> Property' String ()
- Test.Falsify.Property: testMinimum :: forall e. Show e => Predicate '[e] -> Property' e () -> Property' String ()
+ Test.Falsify.Property: testMinimum :: Show e => Predicate '[e] -> Property' e () -> Property' String ()
- Test.Falsify.Property: testShrinking :: forall e. Show e => Predicate [e, e] -> Property' e () -> Property' String ()
+ Test.Falsify.Property: testShrinking :: Show e => Predicate '[e, e] -> Property' e () -> Property' String ()
- Test.Falsify.Property: testShrinkingOfGen :: Show a => Predicate [a, a] -> Gen a -> Property' String ()
+ Test.Falsify.Property: testShrinkingOfGen :: Show a => Predicate '[a, a] -> Gen a -> Property' String ()
- Test.Falsify.Range: between :: forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
+ Test.Falsify.Range: between :: (Integral a, FiniteBits a) => (a, a) -> Range a
- Test.Falsify.Range: eval :: forall f a. Applicative f => (Precision -> f ProperFraction) -> Range a -> f a
+ Test.Falsify.Range: eval :: Applicative f => (Precision -> f WordN) -> Range a -> f a
- Test.Falsify.Range: skewedBy :: forall a. (FiniteBits a, Integral a) => Double -> (a, a) -> Range a
+ Test.Falsify.Range: skewedBy :: (FiniteBits a, Integral a) => Double -> (a, a) -> Range a
- Test.Falsify.Range: towards :: forall a. (Ord a, Num a) => a -> [Range a] -> Range a
+ Test.Falsify.Range: towards :: (Ord a, Num a) => a -> [Range a] -> Range a
Files
- CHANGELOG.md +13/−0
- falsify.cabal +19/−14
- src/Test/Falsify/GenDefault.hs +3/−3
- src/Test/Falsify/Generator.hs +5/−2
- src/Test/Falsify/Internal/Generator.hs +1/−0
- src/Test/Falsify/Internal/Generator/Definition.hs +8/−0
- src/Test/Falsify/Internal/ProperFraction.hs +58/−0
- src/Test/Falsify/Internal/Range.hs +8/−43
- src/Test/Falsify/Predicate.hs +1/−1
- src/Test/Falsify/Range.hs +64/−11
- src/Test/Falsify/Reexported/Generator/Compound.hs +5/−1
- src/Test/Falsify/Reexported/Generator/Function.hs +5/−0
- src/Test/Falsify/Reexported/Generator/Precision.hs +14/−25
- src/Test/Falsify/Reexported/Generator/Simple.hs +1/−1
- test/Main.hs +2/−1
- test/TestSuite/Prop/Generator/Shrinking.hs +35/−2
- test/TestSuite/Regression.hs +55/−0
- test/TestSuite/Sanity/Range.hs +7/−8
CHANGELOG.md view
@@ -1,5 +1,18 @@ # Revision history for falsify +## 0.3.0 -- 2026-03-05++* Introduce new `Range` constructor called `between`, which can be used for+ better uniform selection of large bit-size `Integral` types.+ [#81, reported by Andrea Vezzosi]+* Support generating functions from empty types [#84, Sjoerd Visscher]+* Add `minimalValue` function [#86, Sjoerd Visscher]+* Fix overflow in `Fun Int8` [#89, reported by Jake McArthur]+* The primitive `Range` constructor is now based on `WordN` rather than+ `ProperFraction`. Most users will not notice this difference, but the+ signature of the primitive `eval` function has changed.+* Relax package bounds and test with ghc 9.14.1+ ## 0.2.0 -- 2023-11-08 * Avoid use of `Expr` in `at` (#48)
falsify.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: falsify-version: 0.2.0+version: 0.3.0 synopsis: Property-based testing with internal integrated shrinking description: This library provides property based testing with support for internal integrated shrinking: integrated in the sense@@ -28,8 +28,12 @@ tested-with: GHC==8.10.7 , GHC==9.0.2 , GHC==9.2.8- , GHC==9.4.7- , GHC==9.6.3+ , GHC==9.4.8+ , GHC==9.6.7+ , GHC==9.8.4+ , GHC==9.10.3+ , GHC==9.12.2+ , GHC==9.14.1 source-repository head type: git@@ -41,7 +45,7 @@ -Wredundant-constraints -Widentities build-depends:- base >= 4.12 && < 4.19+ base >= 4.12 && < 4.23 default-language: Haskell2010 default-extensions:@@ -99,6 +103,7 @@ Test.Falsify.Internal.Generator Test.Falsify.Internal.Generator.Definition Test.Falsify.Internal.Generator.Shrinking+ Test.Falsify.Internal.ProperFraction Test.Falsify.Internal.Property Test.Falsify.Internal.Range Test.Falsify.Internal.SampleTree@@ -118,18 +123,17 @@ build-depends: , base16-bytestring >= 1.0 && < 1.1 , binary >= 0.8 && < 0.9- , bytestring >= 0.10 && < 0.12- , containers >= 0.6 && < 0.7- , data-default >= 0.7 && < 0.8+ , bytestring >= 0.10 && < 0.13+ , containers >= 0.6 && < 0.9+ , data-default >= 0.7 && < 0.9 , mtl >= 2.2 && < 2.4 , optics-core >= 0.3 && < 0.5- , optparse-applicative >= 0.16 && < 0.18+ , optparse-applicative >= 0.16 && < 0.20 , selective >= 0.4 && < 0.8 , sop-core >= 0.5 && < 0.6 , splitmix >= 0.1 && < 0.2 , tagged >= 0.8 && < 0.9- , tasty >= 1.3 && < 1.5- , transformers >= 0.5 && < 0.7+ , tasty >= 1.3 && < 1.6 , vector >= 0.12 && < 0.14 other-extensions: CPP@@ -145,9 +149,6 @@ Main.hs other-modules: TestSuite.GenDefault- TestSuite.Sanity.Predicate- TestSuite.Sanity.Range- TestSuite.Sanity.Selective TestSuite.Prop.Generator.Compound TestSuite.Prop.Generator.Function TestSuite.Prop.Generator.Marking@@ -156,10 +157,14 @@ TestSuite.Prop.Generator.Selective TestSuite.Prop.Generator.Shrinking TestSuite.Prop.Generator.Simple+ TestSuite.Regression+ TestSuite.Sanity.Predicate+ TestSuite.Sanity.Range+ TestSuite.Sanity.Selective TestSuite.Util.List TestSuite.Util.Tree build-depends:- , QuickCheck >= 2.14 && < 2.15+ , QuickCheck >= 2.14 && < 2.19 , tasty-hunit >= 0.10 && < 0.11 -- Inherit bounds from the main library
src/Test/Falsify/GenDefault.hs view
@@ -14,7 +14,7 @@ , ViaGeneric (..) ) where -import Control.Applicative (liftA2)+import qualified Control.Applicative as Ap import Data.Proxy (Proxy (..)) import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), (:+:) (..), (:*:) (..)) import Test.Falsify.Generator (Gen)@@ -40,7 +40,7 @@ newtype ViaIntegral a = ViaIntegral {unViaIntegral :: a} instance (Integral a, FiniteBits a, Bounded a) => GenDefault tag (ViaIntegral a) where- genDefault _ = fmap ViaIntegral (Gen.inRange (Range.between (minBound, maxBound)))+ genDefault _ = fmap ViaIntegral (Gen.inRange Range.uniform) -- | DerivingVia wrapper for Enum types newtype ViaEnum a = ViaEnum {unViaEnum :: a}@@ -76,7 +76,7 @@ ggenDefault = fmap M1 . ggenDefault instance (GGenDefault tag a, GGenDefault tag b) => GGenDefault tag (a :*: b) where- ggenDefault p = liftA2 (:*:) (ggenDefault p) (ggenDefault p)+ ggenDefault p = Ap.liftA2 (:*:) (ggenDefault p) (ggenDefault p) instance (GGenDefault tag a, GGenDefault tag b) => GGenDefault tag (a :+: b) where ggenDefault p = Gen.choose (fmap L1 (ggenDefault p)) (fmap R1 (ggenDefault p))
src/Test/Falsify/Generator.hs view
@@ -3,7 +3,7 @@ -- Intended for qualified import. -- -- > import Test.Falsify.Generator (Gen)--- > import qualified Test.Falsify.Generator qualified as Gen+-- > import qualified Test.Falsify.Generator as Gen module Test.Falsify.Generator ( -- * Definition Gen -- opaque@@ -79,16 +79,19 @@ , exhaustive , captureLocalTree , bindWithoutShortcut+ , minimalValue ) where import Prelude hiding (either, elem, properFraction) import Data.Falsify.List import Data.Falsify.Marked+import Data.Falsify.Tree+ import Test.Falsify.Internal.Generator+import Test.Falsify.Internal.ProperFraction import Test.Falsify.Reexported.Generator.Compound import Test.Falsify.Reexported.Generator.Function import Test.Falsify.Reexported.Generator.Precision import Test.Falsify.Reexported.Generator.Shrinking import Test.Falsify.Reexported.Generator.Simple-import Data.Falsify.Tree
src/Test/Falsify/Internal/Generator.hs view
@@ -10,6 +10,7 @@ -- * Execution , runGen , shrinkFrom+ , minimalValue -- * Primitive generators , prim , primWith
src/Test/Falsify/Internal/Generator/Definition.hs view
@@ -2,6 +2,7 @@ -- * Definition Gen(..) , bindWithoutShortcut+ , minimalValue -- * Primitive generators , prim , primWith@@ -128,6 +129,13 @@ [SampleTree s l' r | l' <- ls] , [SampleTree s l r' | r' <- rs] ]++-- | Get the value produced by the generator on the minimal sample tree.+--+-- Having `Gen a` is a proof that `a` is inhabited, so this function+-- gives access to a witness.+minimalValue :: Gen a -> a+minimalValue g = fst (runGen g Minimal) {------------------------------------------------------------------------------- Generator independence
+ src/Test/Falsify/Internal/ProperFraction.hs view
@@ -0,0 +1,58 @@+module Test.Falsify.Internal.ProperFraction (+ ProperFraction(ProperFraction)+ -- * Construction and generation+ , mkFraction+ , properFraction+ ) where++import Prelude hiding (properFraction)++import GHC.Show+import GHC.Stack++import Test.Falsify.Reexported.Generator.Precision+import Test.Falsify.Internal.Generator++{-------------------------------------------------------------------------------+ Definition+-------------------------------------------------------------------------------}++-- | Value @x@ such that @0 <= x < 1@+newtype ProperFraction = UnsafeProperFraction { getProperFraction :: Double }+ deriving stock (Eq, Ord)+ deriving newtype (Num, Fractional)++-- | Show instance relies on the 'ProperFraction' pattern synonym+instance Show ProperFraction where+ showsPrec p (UnsafeProperFraction f) = showParen (p >= appPrec1) $+ showString "ProperFraction "+ . showsPrec appPrec1 f++mkProperFraction :: HasCallStack => Double -> ProperFraction+mkProperFraction f+ | 0 <= f && f < 1 = UnsafeProperFraction f+ | otherwise = error $ "mkProperFraction: not a proper fraction: " ++ show f++pattern ProperFraction :: Double -> ProperFraction+pattern ProperFraction f <- (getProperFraction -> f)+ where+ ProperFraction = mkProperFraction++{-# COMPLETE ProperFraction #-}++{-------------------------------------------------------------------------------+ Construction+-------------------------------------------------------------------------------}++-- | Compute fraction from @n@-bit word+mkFraction :: WordN -> ProperFraction+mkFraction (WordN (Precision p) x) =+ ProperFraction $ (fromIntegral x) / (2 ^ p)++-- | Uniform selection of fraction, shrinking towards 0+--+-- Precondition: precision must be at least 1 bit (a zero-bit number is constant+-- 0; it is meaningless to have a fraction in a point range).+properFraction :: HasCallStack => Precision -> Gen ProperFraction+properFraction (Precision 0) = error "fraction: 0 precision"+properFraction p = mkFraction <$> wordN p
src/Test/Falsify/Internal/Range.hs view
@@ -2,53 +2,14 @@ module Test.Falsify.Internal.Range ( -- * Definition Range(..)- , ProperFraction(ProperFraction)- , Precision(..) ) where import Data.List.NonEmpty (NonEmpty)-import Data.Word-import GHC.Show-import GHC.Stack -{-------------------------------------------------------------------------------- Proper fractions--------------------------------------------------------------------------------}---- | Value @x@ such that @0 <= x < 1@-newtype ProperFraction = UnsafeProperFraction { getProperFraction :: Double }- deriving stock (Eq, Ord)- deriving newtype (Num, Fractional)---- | Show instance relies on the 'ProperFraction' pattern synonym-instance Show ProperFraction where- showsPrec p (UnsafeProperFraction f) = showParen (p >= appPrec1) $- showString "ProperFraction "- . showsPrec appPrec1 f--mkProperFraction :: HasCallStack => Double -> ProperFraction-mkProperFraction f- | 0 <= f && f < 1 = UnsafeProperFraction f- | otherwise = error $ "mkProperFraction: not a proper fraction: " ++ show f--pattern ProperFraction :: Double -> ProperFraction-pattern ProperFraction f <- (getProperFraction -> f)- where- ProperFraction = mkProperFraction--{-# COMPLETE ProperFraction #-}--{-------------------------------------------------------------------------------- Precision--------------------------------------------------------------------------------}---- | Precision (in bits)-newtype Precision = Precision Word8- deriving stock (Show, Eq, Ord)- deriving newtype (Num, Enum)+import Test.Falsify.Reexported.Generator.Precision {-------------------------------------------------------------------------------- Range+ Definition -------------------------------------------------------------------------------} -- | Range of values@@ -56,10 +17,14 @@ -- | Constant (point) range Constant :: a -> Range a - -- | Construct values in the range from a 'ProperFraction'+ -- | Construct value from 'WordN' of the given precision -- -- This is the main constructor for 'Range'.- FromProperFraction :: Precision -> (ProperFraction -> a) -> Range a+ --+ -- Typically this 'WordN' is used to construct a fraction which is then used+ -- to index the range (see 'fromProperFraction'), though some generators use+ -- the 'WordN' directly.+ FromWordN :: Precision -> (WordN -> a) -> Range a -- | Evaluate each range and choose the \"smallest\" --
src/Test/Falsify/Predicate.hs view
@@ -1,7 +1,7 @@ -- | Predicates -- -- Intended for qualified import.-+-- -- > import Test.Falsify.Predicate (Predicate, (.$)) -- > import qualified Test.Falsify.Predicate as P module Test.Falsify.Predicate (
src/Test/Falsify/Range.hs view
@@ -1,8 +1,14 @@ -- | Numerical ranges+--+-- Intended for qualified import.+--+-- > import Test.Falsify.Range (Range)+-- > import qualified Test.Falsify.Range as Range module Test.Falsify.Range ( Range -- opaque -- * Constructors -- ** Linear+ , uniform , between , enum , withOrigin@@ -21,13 +27,16 @@ ) where import Data.Bits+import Data.Functor.Identity import Data.List.NonEmpty (NonEmpty(..)) import Data.Ord+import Data.Word import qualified Data.List.NonEmpty as NE +import Test.Falsify.Internal.ProperFraction import Test.Falsify.Internal.Range-import Data.Functor.Identity+import Test.Falsify.Reexported.Generator.Precision {------------------------------------------------------------------------------- Primitive ranges@@ -44,7 +53,7 @@ -- * for all @x <= y@, @f x <= f y@, /or/ -- * for all @x <= y@, @f y <= f x@ fromProperFraction :: Precision -> (ProperFraction -> a) -> Range a-fromProperFraction = FromProperFraction+fromProperFraction p f = FromWordN p $ f . mkFraction -- | Generate value in any of the specified ranges, then choose the one -- that is closest to the specified origin@@ -66,7 +75,51 @@ Constructing ranges -------------------------------------------------------------------------------} +-- | Uniform selection anywhere in the full range @[minBound .. maxBound]@+--+-- Shrinks towards zero.+--+-- If you don't need specific bounds, you should probably use 'uniform' instead+-- of 'between', especially for large bit sizes, because we can more easily+-- guarantee a true uniform selection here.+uniform :: forall a. (Integral a, FiniteBits a, Bounded a) => Range a+uniform = FromWordN precision $ \(WordN _ x) ->+ if isUnsigned+ then toUnsigned x+ else toSigned x+ where+ precision :: Precision+ precision = Precision $ fromIntegral $ finiteBitSize (undefined :: a)++ isUnsigned :: Bool+ isUnsigned = signum (-1 :: a) == 1++ toUnsigned :: Word64 -> a+ toUnsigned = fromIntegral++ -- For signed numbers we must be careful. Consider Int8, starting with an+ -- 8-bit precision Word64. That Word64 might shrink from 255 to 254; if we+ -- just cast this to Int8, the corresponding values would be -1 and -2,+ -- violating the requirement that we shrink towards zero. We therefore need+ -- to "reflect" the negative range.+ --+ -- NOTE: 'fromIntegral' just does a bit-wise cast, e.g+ --+ -- > fromIntegral (200 :: Word64) :: Int8+ -- > == (-56)+ toSigned :: Word64 -> a+ toSigned x+ | x <= maxPos = fromIntegral x+ | otherwise = (maxBound :: a) - fromIntegral x+ where+ -- maxBound must fit within 64-bits+ -- (assuming @a@ does not exceed 64 bits, of course)+ maxPos :: Word64+ maxPos = fromIntegral (maxBound :: a)+ -- | Uniform selection between the given bounds, shrinking towards first bound+--+-- See also 'uniform'. between :: forall a. (Integral a, FiniteBits a) => (a, a) -> Range a between = skewedBy 0 @@ -117,7 +170,7 @@ Skew To introduce skew, we want something that is reasonably simply to implement- but also has some reasonal properties. Suppose a skew of @s@ means that we+ but also has some reasonable properties. Suppose a skew of @s@ means that we generate value from the lower 20% of the range 60% of the time. Then: - Symmetry around the antidiagonal: we will generate a value from the@@ -235,8 +288,8 @@ -- To avoid this heavy bias, we instead do this: -- -- > 0..............1..............2..............3- -- > [ /\ /\ ]- -- > ^^^^^^^^^^^^^^ ^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^+ -- > [ /| /| /]+ -- > ^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^ -- > 0 1 2 -- -- By insisting that the fraction is a /proper/ fraction (i.e., not equal to@@ -274,7 +327,7 @@ -- | Origin of the range (value we shrink towards) origin :: Range a -> a-origin = runIdentity . eval (\_precision -> Identity $ ProperFraction 0)+origin = runIdentity . eval (\p -> Identity $ WordN p 0) {------------------------------------------------------------------------------- Evaluation@@ -285,15 +338,15 @@ -- Most users will probably never need to call this function. eval :: forall f a. Applicative f- => (Precision -> f ProperFraction) -> Range a -> f a-eval genFraction = go+ => (Precision -> f WordN) -> Range a -> f a+eval genWordN = go where go :: forall x. Range x -> f x go r = case r of- Constant x -> pure x- FromProperFraction p f -> f <$> genFraction p- Smallest rs -> smallest <$> sequenceA (fmap go rs)+ Constant x -> pure x+ FromWordN p f -> f <$> genWordN p+ Smallest rs -> smallest <$> sequenceA (fmap go rs) smallest :: Ord b => NonEmpty (x, b) -> x smallest = fst . NE.head . NE.sortBy (comparing snd)
src/Test/Falsify/Reexported/Generator/Compound.hs view
@@ -375,8 +375,12 @@ <$> go (Interval (Inclusive lo) (Exclusive mid)) <*> go (Interval (Exclusive mid) (Inclusive hi)) where+ -- Go through 'Integer' to avoid overflow+ mid' :: Integer+ mid' = fromIntegral lo + ((fromIntegral hi - fromIntegral lo) `div` 2)+ mid :: a- mid = lo + ((hi - lo) `div` 2)+ mid = fromInteger mid' {------------------------------------------------------------------------------- Shrink trees
src/Test/Falsify/Reexported/Generator/Function.hs view
@@ -23,6 +23,7 @@ import Data.List (intercalate) import Data.Maybe (fromMaybe, mapMaybe) import Data.Ratio (Ratio)+import Data.Void (Void) import Data.Word import GHC.Generics import Numeric.Natural@@ -248,6 +249,7 @@ instance Function () instance Function Bool+instance Function Void instance (Function a, Function b) => Function (Either a b) @@ -358,6 +360,9 @@ instance GFunction f => GFunction (M1 i c f) where gFunction = fmap (functionMap unM1 M1) . gFunction @f++instance GFunction V1 where+ gFunction _ = pure Nil instance GFunction U1 where gFunction = fmap (functionMap unwrap wrap) . unit
src/Test/Falsify/Reexported/Generator/Precision.hs view
@@ -1,27 +1,29 @@ -- | Fixed precision generators module Test.Falsify.Reexported.Generator.Precision ( -- * @n@-bit words- WordN(..)+ Precision(..)+ , WordN(..)+ -- * Construction and generation+ , truncateAt , wordN- -- ** Fractions- , properFraction ) where -import Prelude hiding (properFraction)- import Data.Bits import Data.Word-import GHC.Stack import Test.Falsify.Internal.Generator-import Test.Falsify.Internal.Range import Test.Falsify.Internal.SampleTree (sampleValue) import Test.Falsify.Internal.Search {-------------------------------------------------------------------------------- @n@-bit word+ Definition -------------------------------------------------------------------------------} +-- | Precision (in bits)+newtype Precision = Precision Word8+ deriving stock (Show, Eq, Ord)+ deriving newtype (Num, Enum)+ -- | @n@-bit word data WordN = WordN Precision Word64 deriving (Show, Eq, Ord)@@ -29,6 +31,10 @@ forgetPrecision :: WordN -> Word64 forgetPrecision (WordN _ x) = x +{-------------------------------------------------------------------------------+ Construction and generation+-------------------------------------------------------------------------------}+ -- | Make @n@-bit word (@n <= 64@) -- -- Bits outside the requested precision will be zeroed.@@ -65,20 +71,3 @@ . forgetPrecision . truncateAt p . sampleValue--{-------------------------------------------------------------------------------- Fractions--------------------------------------------------------------------------------}---- | Compute fraction from @n@-bit word-mkFraction :: WordN -> ProperFraction-mkFraction (WordN (Precision p) x) =- ProperFraction $ (fromIntegral x) / (2 ^ p)---- | Uniform selection of fraction, shrinking towards 0------ Precondition: precision must be at least 1 bit (a zero-bit number is constant--- 0; it is meaningless to have a fraction in a point range).-properFraction :: HasCallStack => Precision -> Gen ProperFraction-properFraction (Precision 0) = error "fraction: 0 precision"-properFraction p = mkFraction <$> wordN p
src/Test/Falsify/Reexported/Generator/Simple.hs view
@@ -46,7 +46,7 @@ -- | Generate value in the specified range inRange :: Range a -> Gen a-inRange r = Range.eval properFraction r+inRange r = Range.eval wordN r -- | Deprecated alias for 'inRange' integral :: Range a -> Gen a
test/Main.hs view
@@ -3,10 +3,10 @@ import Test.Tasty import qualified TestSuite.GenDefault- import qualified TestSuite.Sanity.Predicate import qualified TestSuite.Sanity.Range import qualified TestSuite.Sanity.Selective+import qualified TestSuite.Regression import qualified TestSuite.Prop.Generator.Compound import qualified TestSuite.Prop.Generator.Function@@ -24,6 +24,7 @@ , TestSuite.Sanity.Selective.tests , TestSuite.Sanity.Predicate.tests ]+ , TestSuite.Regression.tests , testGroup "Prop" [ TestSuite.Prop.Generator.Prim.tests , TestSuite.Prop.Generator.Selective.tests
test/TestSuite/Prop/Generator/Shrinking.hs view
@@ -1,7 +1,10 @@ module TestSuite.Prop.Generator.Shrinking (tests) where import Control.Monad+import Data.Bits import Data.Default+import Data.Int+import Data.Proxy import Data.Word import Test.Tasty import Test.Tasty.Falsify@@ -10,14 +13,27 @@ import qualified Test.Falsify.Generator as Gen import qualified Test.Falsify.Predicate as P+import qualified Test.Falsify.Range as Range import TestSuite.Util.List tests :: TestTree tests = testGroup "TestSuite.Prop.Generator.Shrinking" [ testGroup "prim" [- testPropertyWith expectFailure "prim" prop_prim_minimum- ]+ testPropertyWith expectFailure "prim" prop_prim_minimum+ ]+ , testGroup "uniform" [+ testProperty "Word8" $ prop_uniform (Proxy @Word8)+ , testProperty "Word16" $ prop_uniform (Proxy @Word16)+ , testProperty "Word32" $ prop_uniform (Proxy @Word32)+ , testProperty "Word64" $ prop_uniform (Proxy @Word64)+ , testProperty "Word" $ prop_uniform (Proxy @Word)+ , testProperty "Int8" $ prop_uniform (Proxy @Int8)+ , testProperty "Int16" $ prop_uniform (Proxy @Int16)+ , testProperty "Int32" $ prop_uniform (Proxy @Int32)+ , testProperty "Int64" $ prop_uniform (Proxy @Int64)+ , testProperty "Int" $ prop_uniform (Proxy @Int)+ ] , testGroup "shrinkTo" [ testProperty "shrinking" prop_shrinkTo_shrinking , testProperty "minimum" prop_shrinkTo_minimum@@ -57,6 +73,23 @@ testMinimum (P.expect 1) $ do x <- gen Gen.prim unless (even x) $ testFailed x++{-------------------------------------------------------------------------------+ uniform+-------------------------------------------------------------------------------}++prop_uniform :: forall a.+ (Show a, FiniteBits a, Integral a, Bounded a)+ => Proxy a -> Property ()+prop_uniform _ =+ testShrinkingOfGen (P.relatedBy ("validShrink", validShrink)) $+ Gen.inRange Range.uniform+ where+ -- We must be getting closer to 0+ validShrink :: a -> a -> Bool+ validShrink orig shrunk+ | orig >= 0 = shrunk < orig+ | otherwise = shrunk > orig {------------------------------------------------------------------------------- shrinkTo
+ test/TestSuite/Regression.hs view
@@ -0,0 +1,55 @@+module TestSuite.Regression (tests) where++import Control.Monad+import Data.Int+import Data.Word+import Test.Tasty+import Test.Tasty.HUnit++import Test.Falsify.GenDefault+import Test.Falsify.GenDefault.Std+import Test.Falsify.Generator (Gen)+import Test.Falsify.Interactive++import qualified Test.Falsify.Generator as Gen+import qualified Test.Falsify.Range as Range++{-------------------------------------------------------------------------------+ Lists of tests+-------------------------------------------------------------------------------}++tests :: TestTree+tests = testGroup "TestSuite.Regression" [+ testCase "issue81" test_issue81+ , testCase "issue89" test_issue89+ ]++{-------------------------------------------------------------------------------+ Specific tests+-------------------------------------------------------------------------------}++test_issue81 :: Assertion+test_issue81 = do+ checkNumOdd $ (length . filter odd) <$> replicateM n (genDefault @Std @Int undefined)+ checkNumOdd $ (length . filter odd) <$> replicateM n (genDefault @Std @Int64 undefined)+ checkNumOdd $ (length . filter odd) <$> replicateM n (genDefault @Std @Word64 undefined)+ checkNumOdd $ (length . filter odd) <$> replicateM n (genDefault @Std @Word32 undefined)+ checkNumOdd $ (length . filter odd) <$> replicateM n (genDefault @Std @Int32 undefined)+ where+ n = 100000++ checkNumOdd :: Gen Int -> Assertion+ checkNumOdd g = do+ numOdd <- sample g+ -- If we generate 100,000 numbers, the probability of generating less+ -- than 1000 odd numbers is astronomically small. So if this happens,+ -- it (almost) certainly is a bug.+ assertBool "not enough odd numbers" $ numOdd > 1000++test_issue89 :: Assertion+test_issue89 = do+ replicateM_ 10 $ do+ f <- sample (Gen.fun (Gen.inRange (Range.between (0 :: Int, 100))))+ let x = 0 :: Int8+ y = Gen.applyFun f x+ assertBool "inRange" $ 0 <= y && y <= 100
test/TestSuite/Sanity/Range.hs view
@@ -4,13 +4,15 @@ import Data.Bifunctor import Data.Map (Map) import Data.Maybe (fromMaybe)+import Data.Word import Test.Tasty import Test.Tasty.HUnit import Text.Printf import qualified Data.Map as Map -import Test.Falsify.Range (Range, Precision(..), ProperFraction(..))+import Test.Falsify.Generator (WordN(..))+import Test.Falsify.Range (Range, Precision(..)) import qualified Test.Falsify.Range as Range @@ -63,15 +65,12 @@ -- each value in the range is produced. stats :: forall a. Ord a => Range a -> [(a, Percentage)] stats r =- count Map.empty $ Range.eval genFraction r+ count Map.empty $ Range.eval genWordN r where- genFraction :: Precision -> [ProperFraction]- genFraction (Precision p)+ genWordN :: Precision -> [WordN]+ genWordN (Precision p) | p >= 16 = error $ "stats: precision " ++ show p ++ " too high"- | otherwise = [- ProperFraction $ fromIntegral x / fromIntegral ((2 :: Word) ^ p)- | x <- [0 .. (2 :: Word) ^ p - 1]- ]+ | otherwise = [WordN (Precision p) x | x <- [0 .. (2 :: Word64) ^ p - 1]] count :: Map a Word -> [a] -> [(a, Percentage)] count acc (x:xs) = count (Map.alter (Just . (+1) . fromMaybe 0) x acc) xs