Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Tweaks, refactoring.

  • Loading branch information...
commit 18315f2eb7a6eb7f553181649f19a77e33b2a2f7 1 parent 9fb8f01
Lee Pike authored
1  examples/Div0.hs
View
@@ -67,7 +67,6 @@ divTest = smartCheck args div_prop
-- { maxSuccess = 1000
-- , maxSize = 20 }
, treeShow = PrintString
- , constrGen = False
}
---------------------------------------------------------------------------------
25 src/Test/SmartCheck/Extrapolate.hs
View
@@ -41,7 +41,6 @@ extrapolate args d origProp ds = do
where
forest = mkSubstForest d ()
-
iter' = iter d test next origProp
-- In this call to iterateArb, we want to claim we can extrapolate iff at
@@ -54,19 +53,17 @@ extrapolate args d origProp ds = do
origProp
-- Control-flow.
- next _ res forest' idx idxs = result
- where
- result =
- case res of
- -- None of the tries satisfy prop. Prevent recurring down this tree,
- -- since we can generalize (we do this with sub, which replaces the
- -- subForest with []).
- FailedProp -> iter' (forestReplaceChop forest' idx ())
- idx { column = column idx + 1 }
- (idx : idxs)
- _ -> iter' forest'
- idx { column = column idx + 1 }
- idxs
+ next _ res forest' idx idxs =
+ case res of
+ -- None of the tries satisfy prop. Prevent recurring down this tree,
+ -- since we can generalize (we do this with sub, which replaces the
+ -- subForest with []).
+ FailedProp -> iter' (forestReplaceChop forest' idx ())
+ idx { column = column idx + 1 }
+ (idx : idxs)
+ _ -> iter' forest'
+ idx { column = column idx + 1 }
+ idxs
prop idxs newProp a =
(not $ matchesShapes a (d : ds) idxs) Q.==> newProp a
23 src/Test/SmartCheck/Reduce.hs
View
@@ -44,12 +44,11 @@ smartShrink args d prop = iter' d (mkForest d) (Idx 0 0) >>= return . fst
iter y test next notProp forest_ idx' (errorMsg "next-idxs")
--------------------------------------
- test :: a -> Idx -> IO (Result a)
+ test :: a -> Idx -> IO (Maybe a)
test x idx =
case maxSize of
- -- Not really failed precondition, but we aren't testing this value.
-- We'll continue down the tree.
- Nothing -> return FailedPreCond
+ Nothing -> return Nothing
Just maxVal -> go maxVal
where
@@ -68,13 +67,16 @@ smartShrink args d prop = iter' d (mkForest d) (Idx 0 0) >>= return . fst
case v of
-- This sees if some subterm directly fails the property. If so, we'll
-- take it, if it's well-typed.
- Just v' -> return (Result v')
+ Just v' -> return (Just v')
-- Otherwise, we'll do maxFailure tests of max, trying to pass the
-- precondition to find a failure. We claim to find a failure if some
-- test satisfies the precondition and satisfies
--
-- (Q.expectFailure . originalProp).
- Nothing -> iterateArb x idx (maxFailure args) maxVal notProp
+ Nothing -> do r <- iterateArb x idx (maxFailure args) maxVal notProp
+ return $ case r of
+ Result a -> Just a
+ _ -> Nothing
testHole :: SubT -> IO (Maybe a)
testHole SubT { unSubT = v } =
@@ -91,17 +93,14 @@ smartShrink args d prop = iter' d (mkForest d) (Idx 0 0) >>= return . fst
--------------------------------------
- next :: a -> Result a -> Forest () -> Idx -> [Idx] -> IO (a, [Idx])
+ next :: a -> Maybe a -> Forest () -> Idx -> [Idx] -> IO (a, [Idx])
next x res forest idx _ =
case res of
-- Found a try that fails prop. We'll now test try, and start trying to
-- reduce from the top!
- Result y -> iter' y (mkForest y) (Idx 0 0)
+ Just y -> iter' y (mkForest y) (Idx 0 0)
-- Either couldn't satisfy the precondition or nothing satisfied the
-- property. Either way, we can't shrink it.
- FailedPreCond -> cont
- FailedProp -> cont
- where
- cont = iter' x forest idx { column = column idx + 1 }
+ Nothing -> iter' x forest idx { column = column idx + 1 }
- --------------------------------------
+---------------------------------------------------------------------------------
8 src/Test/SmartCheck/SmartGen.hs
View
@@ -112,16 +112,16 @@ resultify prop a = do
---------------------------------------------------------------------------------
-type Next a = a -> Result a -> Forest () -> Idx -> [Idx] -> IO (a, [Idx])
-type Test a = a -> Idx -> IO (Result a)
+type Next a b = a -> b -> Forest () -> Idx -> [Idx] -> IO (a, [Idx])
+type Test a b = a -> Idx -> IO b
-- Do a breadth-first traversal of the data, trying to replace holes. When we
-- find an index we can replace, add its index to the index list. Recurse down
-- the structure, following subtrees that have *not* been replaced.
iter :: SubTypes a
=> a -- ^ Failed value
- -> Test a -- ^ Test to use
- -> Next a -- ^ What to do after the test
+ -> Test a b -- ^ Test to use
+ -> Next a b -- ^ What to do after the test
-> (a -> Q.Property) -- ^ Property
-> Forest () -- ^ Just care about structure (size), not values
-> Idx -- ^ Starting index to extrapolate
2  src/Test/SmartCheck/Types.hs
View
@@ -61,7 +61,7 @@ scStdArgs = ScArgs { treeShow = PrintTree
, maxFailure = Q.maxDiscard Q.stdArgs + Q.maxSuccess Q.stdArgs
, qcArgs = Q.stdArgs
, extrap = True
- , constrGen = False
+ , constrGen = True
}
---------------------------------------------------------------------------------
Please sign in to comment.
Something went wrong with that request. Please try again.