falsify 0.1.0 → 0.1.1

raw patch · 6 files changed

+105/−41 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• falsify.cabal +2/−2
• src/Test/Falsify/Internal/Driver.hs +22/−1
• src/Test/Falsify/Predicate.hs +62/−32
• src/Test/Falsify/Range.hs +6/−2
• test/TestSuite/Prop/Generator/Compound.hs +7/−4

@@ -1,5 +1,11 @@ # Revision history for falsify +## 0.1.1 -- 2023-04-07++* Better verbose mode for test failures+* New predicates: `split` and `pairwise`.+* Shrink towards the _second_ half of the range in `withOrigin`+ ## 0.1.0 -- 2023-04-05  * First release

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               falsify-version:            0.1.0+version:            0.1.1 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@@ -15,7 +15,7 @@                     @<https://hackage.haskell.org/package/tasty tasty>@,                     and use "Test.Tasty.Falsify" as their main entrypoint                     into the library. The "Test.Falsify.Interactive" module-                    can be used to experiment with the libary in @ghci@.+                    can be used to experiment with the library in @ghci@.  license:            BSD-3-Clause license-file:       LICENSE

@@ -373,13 +373,34 @@          where            history = shrinkHistory (failureRun e) -      (_, DontExpectFailure, Just e) -> RenderedTestResult {+      (NotVerbose, DontExpectFailure, Just e) -> RenderedTestResult {              testPassed = False            , testOutput = unlines [                  "failed after " ++ countHistory history                , fst $ NE.last history                , "Logs for failed test run:"                , renderLog . runLog . snd $ NE.last history+               , showSeed $ failureSeed e+               ]+           }+         where+           history = shrinkHistory (failureRun e)++      (Verbose, DontExpectFailure, Just e) -> RenderedTestResult {+             testPassed = False+           , testOutput = unlines [+                 "failed after " ++ countHistory history+               , fst $ NE.last history+               , ""+               , "Logs for complete shrink history:"+               , ""+               , intercalate "\n" $ [+                     intercalate "\n" [+                         "Step " ++ show (step :: Word)+                       , renderLog (runLog run)+                       ]+                   | (step, (_result, run)) <- zip [1..] (NE.toList history)+                   ]                , showSeed $ failureSeed e                ]            }

@@ -24,6 +24,7 @@   , relatedBy     -- * Combinators   , dot+  , split   , on   , flip   , matchEither@@ -45,6 +46,7 @@   , even   , odd   , elem+  , pairwise   ) where  import Prelude hiding (all, flip, even, odd, pred, elem)@@ -230,16 +232,16 @@   Both :: Predicate xs -> Predicate xs -> Predicate xs    -- | Abstraction-  Lam :: (x -> Predicate xs) -> Predicate (x ': xs)+  Lam :: (Input x -> Predicate xs) -> Predicate (x ': xs)    -- | Partial application   At :: Predicate (x : xs) -> Input x -> Predicate xs    -- | Function compostion-  Dot :: Predicate (x : xs) -> Fn y x -> Predicate (y : xs)+  Dot :: Predicate (x' : xs) -> Fn x x' -> Predicate (x : xs) -  -- | Analogue of 'Prelude.on'-  On :: Predicate (x : x : xs) -> Fn y x -> Predicate (y : y : xs)+  -- | Analogue of 'Control.Arrow.(***)'+  Split :: Predicate (x' : y' : xs) -> (Fn x x', Fn y y') -> Predicate (x : y : xs)    -- | Analogue of 'Prelude.flip'   Flip :: Predicate (x : y : zs) -> Predicate (y : x : zs)@@ -329,9 +331,16 @@ dot :: Predicate (x : xs) -> Fn y x -> Predicate (y : xs) dot = Dot +-- | Analogue of 'Control.Arrow.(***)'+split ::+     Predicate (x' : y' : xs)+  -> (Fn x x', Fn y y')+  -> Predicate (x : y : xs)+split = Split+ -- | Analogue of 'Prelude.on' on :: Predicate (x : x : xs) -> Fn y x -> Predicate (y : y : xs)-on = On+on p f = p `split` (f, f)  -- | Analogue of 'Prelude.flip' flip :: Predicate (x : y : zs) -> Predicate (y : x : zs)@@ -411,12 +420,12 @@  evalLam ::      SListI xs-  => (x -> Predicate xs)+  => (Input x -> Predicate xs)   -> NP Input (x : xs)   -> Either Failure () evalLam f (x :* xs) =     first (addInputs [renderInput x]) $-      evalAt (f $ inputValue x) xs+      evalAt (f x) xs  evalDot ::      SListI xs@@ -430,18 +439,18 @@   where     (y, x') = applyFn f x -evalOn ::+evalSplit ::      SListI xs-  => Predicate (x : x : xs)-  -> Fn y x-  -> NP Input (y : y : xs)+  => Predicate (x' : y' : xs)+  -> (Fn x x', Fn y y')+  -> NP Input (x : y : xs)   -> Either Failure ()-evalOn p f (x0 :* x1 :* xs) =-    first (addInputs $ catMaybes [x0', x1']) $-      evalAt p (y0 :* y1 :* xs)+evalSplit p (f, g) (x :* y :* xs) =+    first (addInputs $ catMaybes [inp_x, inp_y]) $+      evalAt p (x' :* y' :* xs)   where-    (y0, x0') = applyFn f x0-    (y1, x1') = applyFn f x1+    (x', inp_x) = applyFn f x+    (y', inp_y) = applyFn g y  evalChoice ::      SListI xs@@ -456,17 +465,18 @@         Right b -> evalAt f (x{inputValue = b} :* xs)  evalAt :: SListI xs => Predicate xs -> NP Input xs -> Either Failure ()-evalAt (Prim p err) xs = evalPrim p err xs-evalAt Pass         _  = return ()-evalAt Fail         xs = Left $ Failure "Fail" (renderInputs xs)-evalAt (Both p1 p2) xs = evalAt p1 xs >> evalAt p2 xs-evalAt (Lam f)      xs = evalLam f xs-evalAt (p `At` x)   xs = evalAt p (x :* xs)-evalAt (p `Dot` f)  xs = evalDot p f xs-evalAt (p `On` f)   xs = evalOn  p f xs-evalAt (Flip p)     xs = let (x :* y :* zs) = xs in evalAt p (y :* x :* zs)-evalAt (Choose l r) xs = evalChoice l r xs-evalAt (Const p)    xs = evalAt p (SOP.tl xs)+evalAt (Prim p err)       xs = evalPrim p err xs+evalAt Pass               _  = return ()+evalAt Fail               xs = Left $ Failure "Fail" (renderInputs xs)+evalAt (Both p1 p2)       xs = evalAt p1 xs >> evalAt p2 xs+evalAt (Lam f)            xs = evalLam f xs+evalAt (p `At` x)         xs = evalAt p (x :* xs)+evalAt (p `Dot` f)        xs = evalDot p f xs+evalAt (p `Split` (f, g)) xs = evalSplit p (f, g) xs+evalAt (Flip p)           xs = let (x :* y :* zs) = xs in+                               evalAt p (y :* x :* zs)+evalAt (Choose l r)       xs = evalChoice l r xs+evalAt (Const p)          xs = evalAt p (SOP.tl xs)  {-------------------------------------------------------------------------------   Evaluation and partial evaluation@@ -485,14 +495,14 @@ -- >   .$ ("x", x) -- >   .$ ("y", y) (.$) :: Show x => Predicate (x : xs) -> (Var, x) -> Predicate xs-p .$ (n, x) = p `at` (n, show x, x)+p .$ (n, x) = p `at` (Var n, show x, x)  -- | Generation of '(.$)' that does not require a 'Show' instance at ::      Predicate (x : xs)-  -> (Var, String, x) -- ^ Renderded name, name for the input, and input proper+  -> (Expr, String, x) -- ^ Renderded name, expression, and input proper   -> Predicate xs-p `at` (n, r, x) = p `At` (Input (Var n) r x)+p `at` (e, r, x) = p `At` (Input e r x)  {-------------------------------------------------------------------------------   Specific predicates@@ -535,7 +545,8 @@ towards = \target -> pred .$ ("target", target)   where     pred :: Predicate [a, a, a]-    pred = Lam (\target -> ge `on` fn ("distanceToTarget", distanceTo target))+    pred = Lam $ \target ->+        ge `on` fn ("distanceToTarget", distanceTo (inputValue target))      distanceTo :: a -> a -> a     distanceTo target x@@ -562,5 +573,24 @@ odd  = satisfies ("odd ", Prelude.odd)  -- | Membership check-elem :: Eq a => Predicate '[[a], a]+elem :: Eq a => Predicate [[a], a] elem = flip $ binaryInfix ("`notElem`") Prelude.elem++-- | Apply predicate to every pair of consecutive elements in the list+pairwise :: forall a. Show a => Predicate [a, a] -> Predicate '[[a]]+pairwise p = Lam $ \xs ->+    foldMap+      (uncurry $ pred (inputExpr xs))+      (pairs $ zip [0..] (inputValue xs))+  where+    pairs :: forall x. [x] -> [(x, x)]+    pairs []           = []+    pairs [_]          = []+    pairs (x : y : zs) = (x, y) : pairs (y : zs)++    pred :: Expr -> (Word, a) -> (Word, a) -> Predicate '[]+    pred xs (i, x) (j, y) =+             p+        `at` (Infix "!!" xs (Var $ show i), show x, x)+        `at` (Infix "!!" xs (Var $ show j), show y, y)+

@@ -58,6 +58,10 @@ between = skewedBy 0  -- | Selection within the given bounds, shrinking towards the specified origin+--+-- All else being equal, prefers values in the /second/ half of the range+-- (in the common case of say @withOrigin (-100, 100) 0@, this means we prefer+-- positive values). withOrigin :: (Integral a, FiniteBits a) => (a, a) -> a -> Range a withOrigin (x, y) o   | not originInBounds@@ -79,8 +83,8 @@ -- would be at the origin, we would only ever produce that one value.   | otherwise =       towards o [-          between (o, x)-        , between (o, y)+          between (o, y)+        , between (o, x)         ]   where     originInBounds :: Bool

@@ -105,7 +105,7 @@ -- due to binary search prop_list_towardsShorterEven_minimum :: Property () prop_list_towardsShorterEven_minimum =-    testMinimum (P.elem .$ ("expected", [[6,4],[4,2]])) $ do+    testMinimum (P.elem .$ ("expected", [[6,4],[8,6]])) $ do       xs <- gen $ fmap (filter even) $                      Gen.list (Range.between (10, 20)) $                        Gen.int $ Range.withOrigin (0, 10) 5@@ -177,14 +177,17 @@  prop_tree_towardsSmaller1 :: Property () prop_tree_towardsSmaller1 =-    testMinimum (P.expect expected) $ do+    testMinimum (P.satisfies ("expected", expected)) $ do       t <- gen $ Gen.tree (Range.between (0, 100)) $                    Gen.int $ Range.between (0, 1)       -- "Every tree is height balanced"       unless (Tree.isHeightBalanced t) $ testFailed t   where-    expected :: Tree Int-    expected = Branch 0 Leaf (Branch 0 Leaf (Branch 0 Leaf Leaf))+    expected :: Tree Int -> Bool+    expected t = or [+          t == Branch 0 (Branch 0 Leaf (Branch 0 Leaf Leaf)) Leaf+        , t == Branch 0 Leaf (Branch 0 Leaf (Branch 0 Leaf Leaf))+        ]  prop_tree_towardsSmaller2 :: Property () prop_tree_towardsSmaller2 =