new module tools.test.fuzz: quickcheck-style probabilistic testing, based on Andrew Pennebaker's factcheck vocab

basis/tools/test/fuzz/authors.txt

@@ -0,0 +1,2 @@
+Andrew Pennebaker
+Joe Groff

basis/tools/test/fuzz/fuzz-tests.factor

@@ -0,0 +1,53 @@
+! (c)2011 Joe Groff bsd license
+USING: accessors fry kernel macros math namespaces sequences
+source-files.errors tools.test tools.test.fuzz
+tools.test.fuzz.private ;
+IN: tools.test.fuzz.tests
+
+SYMBOL: generator-stack
+: with-generator-stack ( seq quot -- )
+    [ reverse V{ } like generator-stack ] dip with-variable ; inline
+: generate-from-stack ( -- n )
+    generator-stack get pop ;
+
+6 fuzz-test-trials [
+
+    [ { } ] [
+        { -4 -2 0 2 4 6 } [
+            [ generate-from-stack ] [ even? ] fuzz-test-failures
+        ] with-generator-stack
+    ] unit-test
+
+    [ { { -1 } { 1 } { 5 } } ] [
+        { -4 -1 1 2 5 6 } [
+            [ generate-from-stack ] [ even? ] fuzz-test-failures
+        ] with-generator-stack
+    ] unit-test
+
+    { -4 -2 0 2 4 6 } [
+        [ generate-from-stack ] [ even? ] fuzz-test
+    ] with-generator-stack
+
+    {
+        1
+        T{ fuzz-test-failure
+            { failures { { -1 } { 1 } { 5 } } }
+            { predicate [ even? ] }
+            { trials 6 }
+        }
+    } [
+        [
+            { -4 -2 0 2 4 6 } [
+                [ generate-from-stack ] [ even? ] fuzz-test
+            ] with-generator-stack
+            { -4 -1 1 2 5 6 } [
+                [ generate-from-stack ] [ even? ] fuzz-test
+            ] with-generator-stack
+        ] fake-unit-test
+        [ length ] [ first error>> ] bi
+    ] unit-test
+
+] with-variable
+
+notify-error-observers
+

basis/tools/test/fuzz/fuzz.factor

@@ -0,0 +1,41 @@
+! (c)2011 Andrew Pennebaker, Joe Groff
+USING: accessors combinators.smart fry io kernel make math
+math.parser namespaces prettyprint random sequences strings
+summary tools.test tools.test.private ;
+IN: tools.test.fuzz
+
+! Fuzz testing parameters
+SYMBOL: fuzz-test-trials
+fuzz-test-trials [ 100 ] initialize
+
+: fuzz-test-failures* ( trials generator: ( -- ..a ) predicate: ( ..a -- ? ) -- failures )
+    '[
+        _ { } output>sequence [ _ input<sequence ] [ f swap ? ] bi
+    ] replicate sift ; inline
+
+: fuzz-test-failures ( generator: ( -- ..a ) predicate: ( ..a -- ? ) -- failures )
+    [ fuzz-test-trials get ] 2dip fuzz-test-failures* ; inline
+
+<PRIVATE
+
+TUPLE: fuzz-test-failure failures predicate trials ;
+
+C: <fuzz-test-failure> fuzz-test-failure
+
+M: fuzz-test-failure summary
+    [
+        "Fuzz test predicate failed for " %
+        dup failures>> length #
+        " out of " %
+        trials>> #
+        " trials" %
+    ] "" make ;
+
+: (fuzz-test) ( generator predicate -- error ? )
+    [ fuzz-test-failures [ f f ] ]
+    [ '[ _ fuzz-test-trials get <fuzz-test-failure> t ] ] bi
+    if-empty ; inline
+
+PRIVATE>
+
+TEST: fuzz-test