diff --git a/apps/random-tester/hang.factor b/apps/random-tester/hang.factor new file mode 100644 index 0000000000..06c3d149d2 --- /dev/null +++ b/apps/random-tester/hang.factor @@ -0,0 +1,96 @@ +USING: errors generic io kernel lazy-lists math namespaces +prettyprint random-tester2 sequences tools words ; +IN: random-tester + +: inputs-exhaustive ( -- seq ) + { + -100000000000000000 + -1 + 0 + 1 + 100000000000000000 + + -29/2 + 100000000000000000/999999999999999999 + + -1/0. + -3.14 + 0.0 + 3.14 + 1/0. + 0/0. + + C{ 1 -1 } + } ; + + +: inert ; +TUPLE: inert-object ; + +: inputs ( -- seq ) + { + 0 + ! -268435457 + inert + T{ inert-object f } + -29/2 + -3.14 + C{ 1 -1 } + W{ 55 } + { } + f + H{ } + V{ } + "" + SBUF" " + [ ] + DLL" libm.dylib" + ALIEN: 1 + T{ inert-object f } + } ; + +: cartesian-inputs ( n -- list ) + >r inputs >list r> + 1- [ drop inputs >list lcartesian-product ] each ; + +: word-inputs ( word -- seq ) + stack-effect [ effect-in length ] [ drop 2 ] recover + cartesian-inputs list>array ; + +: type-error? ( exception -- ? ) + [ swap execute or ] curry + >r { no-method? no-math-method? } f r> reduce ; + +: maybe-explode + dup sequence? [ [ ] each ] when ; + +SYMBOL: err +SYMBOL: type-error +SYMBOL: params +: throws? ( data... quot -- ? ) + err off type-error off + >r + dup clone params set + maybe-explode + r> + "<<<<>>>>tested" . + err get [ + dup type-error? dup [ + .s + ] unless + type-error set + ] when clear type-error get + ; + +: test-inputs ( word -- seq ) + [ word-inputs ] keep + unit [ + throws? not + ] curry map ; + diff --git a/apps/random-tester/load.factor b/apps/random-tester/load.factor index 3404605873..dddeff2a7b 100644 --- a/apps/random-tester/load.factor +++ b/apps/random-tester/load.factor @@ -1,7 +1,9 @@ +REQUIRES: libs/lazy-lists libs/shuffle ; PROVIDE: apps/random-tester { +files+ { "utils.factor" "random.factor" "random-tester.factor" "random-tester2.factor" + "type.factor" } } ; diff --git a/apps/random-tester/random-tester2.factor b/apps/random-tester/random-tester2.factor index 83abf0124a..f2606ee1d3 100644 --- a/apps/random-tester/random-tester2.factor +++ b/apps/random-tester/random-tester2.factor @@ -167,3 +167,4 @@ err off 100 random-int zero? [ code-gc ] when compile fooify ; + diff --git a/apps/random-tester/type.factor b/apps/random-tester/type.factor new file mode 100644 index 0000000000..20b2629c68 --- /dev/null +++ b/apps/random-tester/type.factor @@ -0,0 +1,126 @@ +USING: errors generic io kernel lazy-lists math namespaces +prettyprint random-tester2 sequences tools words ; +IN: random-tester + +: inputs-exhaustive ( -- seq ) + { + -100000000000000000 + -1 + 0 + 1 + 100000000000000000 + + -29/2 + 100000000000000000/999999999999999999 + + -1/0. + -3.14 + 0.0 + 3.14 + 1/0. + 0/0. + + C{ 1 -1 } + } ; + + +: inert ; +TUPLE: inert-object ; + +: inputs ( -- seq ) + { + 0 + ! -268435457 + inert + ! T{ inert-object f } + -29/2 + -3.14 + C{ 1 -1 } + W{ 55 } + { } + f + H{ } + V{ } + "" + SBUF" " + [ ] + DLL" libm.dylib" + ALIEN: 1 + T{ inert-object f } + } ; + +: make-inputs + [ + 0 , + ! ! -268435457 , + \ inert , + ! ! T{ inert-object f } , + -29/2 , + -3.14 , + C{ 1 -1 } , + W{ 55 } clone , + { } clone , + f , + H{ } clone , + V{ } clone , + "" , + SBUF" " clone , + [ ] clone , + DLL" libm.dylib" clone , + ALIEN: 1 , + T{ inert-object f } , + ] { } make ; + +! : cartesian-inputs ( n -- list ) + ! >r make-inputs >list r> + ! 1- [ drop make-inputs >list lcartesian-product ] each ; + +: cartesian-inputs ( n -- list ) + dup 2 > [ + drop { } >list + ] [ + >r make-inputs >list r> + 1- [ drop make-inputs >list lcartesian-product ] each + ] if ; + + +: word-inputs ( word -- seq ) + [ stack-effect effect-in length ] [ drop 0 ] recover + cartesian-inputs list>array ; + +: type-error? ( exception -- ? ) + [ swap execute or ] curry + >r { no-method? no-math-method? } f r> reduce ; + +: maybe-explode + dup sequence? [ [ ] each ] when ; + +SYMBOL: err +SYMBOL: type-error +SYMBOL: params +: throws? ( data... quot -- ? ) + err off type-error off + >r + dup clone params set + maybe-explode + r> + "<<<<>>>>tested" . + err get [ + dup type-error? dup [ + .s + ] unless + type-error set + ] when clear type-error get + ; + +: test-inputs ( word -- seq ) + [ word-inputs ] keep + unit [ + throws? not + ] curry map ; + diff --git a/apps/random-tester/utils.factor b/apps/random-tester/utils.factor index d8458ff242..190982798f 100644 --- a/apps/random-tester/utils.factor +++ b/apps/random-tester/utils.factor @@ -1,6 +1,6 @@ USING: kernel math sequences namespaces errors hashtables words -arrays parser compiler syntax io optimizer inference tools -prettyprint ; +arrays parser compiler syntax io optimizer inference shuffle +tools prettyprint ; IN: random-tester : pick-one ( seq -- elt ) @@ -12,3 +12,32 @@ IN: random-tester : coin-flip ( -- bool ) 2 random-int zero? ; : do-one ( seq -- ) pick-one call ; inline + +: nzero-array ( seq -- ) + dup length >r 0 r> [ pick set-nth ] each-with drop ; + +: zero-array + [ drop 0 ] map ; + +TUPLE: p-list seq max counter ; +: make-p-list ( seq -- tuple ) + dup length [ 1- ] keep zero-array ; + +: inc-seq ( seq max -- ) + 2dup [ < ] curry find-last over -1 = [ + 3drop nzero-array + ] [ + nipd 1+ 2over swap set-nth + 1+ over length rot nzero-array + ] if ; + +: get-permutation ( tuple -- seq ) + [ p-list-seq ] keep p-list-counter [ swap nth ] map-with ; + +: p-list-next ( tuple -- seq ) + [ get-permutation ] keep + [ p-list-counter ] keep p-list-max inc-seq ; + +: permutations ( seq -- seq ) + ; +