packages feed

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 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