Shrinking.hs

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

import qualified Test.QuickCheck as QuickCheck

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
        ]
    , 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
        ]
    , testGroup "firstThen" [
          testProperty "shrinking" prop_firstThen_shrinking
        , testProperty "minimum"   prop_firstThen_minimum
        ]
    , testGroup "shrinkWith" [
          testGroup "minimum" [
              testProperty "minimum" prop_shrinkWith_minimum_word
            , testGroup "list" [
                   testProperty (show i) $ prop_shrinkWith_minimum_list i
                 | i <- [20,  40,  60,  80, 100, 120, 140, 160, 180]
                 ]
            ]
        ]
    ]
  where
    expectFailure :: TestOptions
    expectFailure = def {
          expectFailure    = ExpectFailure
        , overrideNumTests = Just 10_000
        }

{-------------------------------------------------------------------------------
  prim
-------------------------------------------------------------------------------}

-- Binary search is not guaranteed to always find the minimum value. For
-- example, if we are looking for counter-examples to the property that "all
-- numbers are even", and we start with 3, then binary search will only try 0
-- and 2, both of which are even, and hence conclude that 3 is the minimum
-- counter-example. This is true in QuickCheck, also.
prop_prim_minimum :: Property ()
prop_prim_minimum =
    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
-------------------------------------------------------------------------------}

prop_shrinkTo_shrinking :: Property ()
prop_shrinkTo_shrinking =
   testShrinkingOfGen (P.relatedBy ("validShrink", validShrink)) $
     Gen.shrinkToOneOf 3 [0 :: Word .. 2]
  where
    -- 'shrinkToOneOf' only shrinks /once/, so the original (pre-shrink) value
    -- /must/ be 3.
    validShrink :: Word -> Word -> Bool
    validShrink 3 0 = True
    validShrink 3 1 = True
    validShrink 3 2 = True
    validShrink _ _ = False

prop_shrinkTo_minimum :: Property ()
prop_shrinkTo_minimum =
    testMinimum (P.expect 1) $ do
      x <- gen $ Gen.shrinkToOneOf 3 [0 :: Word .. 2]
      unless (even x) $ testFailed x

{-------------------------------------------------------------------------------
  firstThen
-------------------------------------------------------------------------------}

prop_firstThen_shrinking :: Property ()
prop_firstThen_shrinking =
   testShrinkingOfGen (P.relatedBy ("validShrink", validShrink)) $
     Gen.firstThen True False
  where
    validShrink :: Bool -> Bool -> Bool
    validShrink True False = True
    validShrink _    _     = False

prop_firstThen_minimum :: Property ()
prop_firstThen_minimum =
    testMinimum (P.expect False) $ do
      x <- gen $ Gen.firstThen True False
      testFailed x

{-------------------------------------------------------------------------------
  shrinkWith
-------------------------------------------------------------------------------}

-- This is obviously not a valid general-purpose shrinking function for
-- 'Word64', but that is not important here.
shrinkWord :: Word64 -> [Word64]
shrinkWord n = takeWhile (< n) [0 .. 100]

prop_shrinkWith_minimum_word :: Property ()
prop_shrinkWith_minimum_word =
    testMinimum (P.expect 1) $ do
      x <- gen $ Gen.shrinkWith shrinkWord Gen.prim
      unless (even x) $ testFailed x

-- | Test performance of 'shrinkWith'
--
-- We test this for lists of increasing size, to verify that this is not growing
-- exponentially with the size of the list (and thereby verifying that we are
-- not exploring the full shrink tree of those lists, because they certainly
-- /are/ exponential in size).
prop_shrinkWith_minimum_list :: Int -> Property ()
prop_shrinkWith_minimum_list listLength =
    testMinimum (P.expect [1,0]) $ do
      xs <- gen $ Gen.shrinkWith (QuickCheck.shrinkList shrinkWord) $
              replicateM listLength Gen.prim
      unless (pairwiseAll (<=) xs) $ testFailed xs