@@ -29,6 +29,7 @@ import Data.Monoid
29
29
#endif
30
30
import Control.Monad.State
31
31
import Control.Monad.Reader (ask )
32
+ import Control.Monad.Trans.Maybe (runMaybeT )
32
33
import qualified Control.Exception as Ex
33
34
import qualified Data.ByteString as StrictBS
34
35
import qualified Data.ByteString.Lazy as BS
@@ -346,17 +347,18 @@ quickcheckGoal sc n = do
346
347
tm0 <- propToPredicate sc (goalProp goal)
347
348
tm <- scAbstractExts sc (getAllExts tm0) tm0
348
349
ty <- scTypeOf sc tm
349
- maybeInputs <- scTestableType sc ty
350
+ maybeInputs <- runMaybeT ( scTestableType sc ty)
350
351
let stats = solverStats " quickcheck" (scSharedSize tm)
351
352
case maybeInputs of
352
353
Just inputs -> do
353
- result <- scRunTestsTFIO sc n tm inputs
354
+ result <- scRunTestsTFIO sc n tm ( map snd inputs)
354
355
case result of
355
356
Nothing -> do
356
357
printOutLn opts Info $ " checked " ++ show n ++ " cases."
357
358
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 )
360
362
Nothing -> fail $ " quickcheck:\n " ++
361
363
" term has non-testable type:\n " ++
362
364
showTerm ty ++ " , for term: " ++ showTerm tm
@@ -952,15 +954,17 @@ quickCheckPrintPrim :: Options -> SharedContext -> Integer -> TypedTerm -> IO ()
952
954
quickCheckPrintPrim opts sc numTests tt = do
953
955
let tm = ttTerm tt
954
956
ty <- scTypeOf sc tm
955
- maybeInputs <- scTestableType sc ty
957
+ maybeInputs <- runMaybeT ( scTestableType sc ty)
956
958
case maybeInputs of
957
959
Just inputs -> do
958
- result <- scRunTestsTFIO sc numTests tm inputs
960
+ result <- scRunTestsTFIO sc numTests tm ( map snd inputs)
959
961
case result of
960
962
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 " "
964
968
Nothing -> fail $ " quickCheckPrintPrim:\n " ++
965
969
" term has non-testable type:\n " ++
966
970
pretty (ttSchema tt)
0 commit comments