Skip to content
Browse files

smart println function.

  • Loading branch information...
1 parent ebe987b commit 02275da89e563c75341d490a455b8ad8bcee45c2 @leepike committed Apr 19, 2012
Showing with 10 additions and 20 deletions.
  1. +4 −7 src/Test/SmartCheck/Common.hs
  2. +3 −3 src/Test/SmartCheck/Extrapolate.hs
  3. +3 −10 src/Test/SmartCheck/Reduce.hs
View
11 src/Test/SmartCheck/Common.hs
@@ -2,7 +2,7 @@ module Test.SmartCheck.Common
( samples
, iterateArb
, resultify
- , smartPrefix
+ , smartPrtLn
) where
import Test.SmartCheck.Types
@@ -76,7 +76,6 @@ iterateArb d idx tries sz prop =
---------------------------------------------------------------------------------
--- XXX need to protect by calling (protectRose . reduceRose) ?
resultify :: (a -> Q.Property) -> a -> IO Q.Result
resultify prop a = do
Q.MkRose r _ <- res fs
@@ -87,16 +86,14 @@ resultify prop a = do
fs = Q.unProp $ f err err :: Q.Rose Q.Result
res = Q.protectRose . Q.reduceRose
--- case fs' of
--- (Q.MkRose res' _) -> res'
--- io -> res (Q.ioRose io)
-
-
err = error "in propify: should not evaluate."
---------------------------------------------------------------------------------
smartPrefix :: String
smartPrefix = "*** "
+smartPrtLn :: String -> IO ()
+smartPrtLn = putStrLn . (smartPrefix ++)
+
---------------------------------------------------------------------------------
View
6 src/Test/SmartCheck/Extrapolate.hs
@@ -25,9 +25,9 @@ extrapolate :: (Data a, SubTypes a)
=> Q.Args -> Maybe a -> (a -> Q.Property) -> IO ()
extrapolate args md prop = do
putStrLn ""
- when (isNothing md) (putStrLn $ smartPrefix ++ "No value to extrapolate.")
- unless (isNothing md) $ do putStrLn $ smartPrefix ++ "Extrapolating ..."
- putStrLn $ smartPrefix ++ "Extrapolated value:"
+ when (isNothing md) (smartPrtLn "No value to extrapolate.")
+ unless (isNothing md) $ do smartPrtLn "Extrapolating ..."
+ smartPrtLn "Extrapolated value:"
idxs <- iter (mkSubstForest d) (Idx 0 0) []
renderWithVars d idxs
View
13 src/Test/SmartCheck/Reduce.hs
@@ -24,16 +24,16 @@ smartRun args prop = do
res <- runQC args genProp
if (isJust res) then runSmart (fromJust res)
else do putStrLn ""
- putStrLn $ smartPrefix ++ "No value to smart-shrink!"
+ smartPrtLn "No value to smart-shrink!"
return Nothing
where
runSmart r = do
putStrLn ""
- putStrLn $ smartPrefix ++ "Smart Shrinking ... "
+ smartPrtLn "Smart Shrinking ... "
new <- smartShrink args r prop
- putStrLn $ smartPrefix ++ "Smart-shrunk value:"
+ smartPrtLn "Smart-shrunk value:"
print new
return (Just new)
@@ -68,7 +68,6 @@ smartShrink args d prop = iter d (Idx 0 0)
-- XXX We could shrink base values, but I'm not sure if
-- it's worth it. Doesn't affect extrapolation or make
-- counter-examples more readable.
-
-- then case getAtIdx d' idx of
-- Nothing -> iter d' (idx { column = column idx + 1 })
-- Just v -> mkVals v
@@ -102,10 +101,4 @@ smartShrink args d prop = iter d (Idx 0 0)
done = length pts <= level idx
nextLevel = length (pts !! level idx) <= column idx
- -- mkVals SubT { unSubT = v } =
- -- let vs = map (replaceAtIdx d' idx) (Q.shrink v) in
- -- case find notProp (catMaybes vs) of
- -- Nothing -> iter d' (idx { column = column idx + 1 })
- -- Just x -> iter x (idx { column = column idx + 1 })
-
---------------------------------------------------------------------------------

0 comments on commit 02275da

Please sign in to comment.
Something went wrong with that request. Please try again.