Skip to content

Commit bfce8f9

Browse files
committed
Update random testing to use first order values instead of
finite values. Fixes #1058
1 parent dbd73ea commit bfce8f9

File tree

1 file changed

+13
-9
lines changed

1 file changed

+13
-9
lines changed

src/SAWScript/Builtins.hs

+13-9
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ import Data.Monoid
2929
#endif
3030
import Control.Monad.State
3131
import Control.Monad.Reader (ask)
32+
import Control.Monad.Trans.Maybe (runMaybeT)
3233
import qualified Control.Exception as Ex
3334
import qualified Data.ByteString as StrictBS
3435
import qualified Data.ByteString.Lazy as BS
@@ -346,17 +347,18 @@ quickcheckGoal sc n = do
346347
tm0 <- propToPredicate sc (goalProp goal)
347348
tm <- scAbstractExts sc (getAllExts tm0) tm0
348349
ty <- scTypeOf sc tm
349-
maybeInputs <- scTestableType sc ty
350+
maybeInputs <- runMaybeT (scTestableType sc ty)
350351
let stats = solverStats "quickcheck" (scSharedSize tm)
351352
case maybeInputs of
352353
Just inputs -> do
353-
result <- scRunTestsTFIO sc n tm inputs
354+
result <- scRunTestsTFIO sc n tm (map snd inputs)
354355
case result of
355356
Nothing -> do
356357
printOutLn opts Info $ "checked " ++ show n ++ " cases."
357358
return (SV.Unsat stats, stats, Just (QuickcheckEvidence n (goalProp goal)))
358-
-- TODO: use reasonable names here
359-
Just cex -> return (SV.SatMulti stats (zip (repeat "_") (map toFirstOrderValue cex)), stats, Nothing)
359+
Just cexVals ->
360+
let cex = zip (map (Text.unpack . fst) inputs) cexVals
361+
in return (SV.SatMulti stats cex, stats, Nothing)
360362
Nothing -> fail $ "quickcheck:\n" ++
361363
"term has non-testable type:\n" ++
362364
showTerm ty ++ ", for term: " ++ showTerm tm
@@ -952,15 +954,17 @@ quickCheckPrintPrim :: Options -> SharedContext -> Integer -> TypedTerm -> IO ()
952954
quickCheckPrintPrim opts sc numTests tt = do
953955
let tm = ttTerm tt
954956
ty <- scTypeOf sc tm
955-
maybeInputs <- scTestableType sc ty
957+
maybeInputs <- runMaybeT (scTestableType sc ty)
956958
case maybeInputs of
957959
Just inputs -> do
958-
result <- scRunTestsTFIO sc numTests tm inputs
960+
result <- scRunTestsTFIO sc numTests tm (map snd inputs)
959961
case result of
960962
Nothing -> printOutLn opts Info $ "All " ++ show numTests ++ " tests passed!"
961-
Just counterExample -> printOutLn opts OnlyCounterExamples $
962-
"----------Counterexample----------\n" ++
963-
showList counterExample ""
963+
Just cexVals ->
964+
let cex = zip (map fst inputs) cexVals in
965+
printOutLn opts OnlyCounterExamples $
966+
"----------Counterexample----------\n" ++
967+
showList cex ""
964968
Nothing -> fail $ "quickCheckPrintPrim:\n" ++
965969
"term has non-testable type:\n" ++
966970
pretty (ttSchema tt)

0 commit comments

Comments
 (0)