+++ /dev/null
-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>
- "<<<<<testing" .
- .s
- 3dup . . .
- "-----" . flush
- [ call ] [ err on ] recover
- .s
- ">>>>>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 ;
-
clear-hash build-graph
- be>
-
>r r>
set-callstack set-word set-word-prop
set-nested-style-stream-style
set-pathname-string
set-check-create-vocab
- <check-create>
+ <check-create> check-create?
reset-generic forget-class
create forget-word forget-vocab forget forget-tuple
- check-create?
remove-word-prop empty-method
continue-with <continuation>
set-word-def set-word-name
set-word-props set-word-primitive
- close readln read1 read (lines) with-server
- stream-read
- stream-readln stream-read1 lines contents stream-copy
- stream-write log-stream stream-format set-line-reader-cr
- stream-flush (readln)
-
- word-xt.
-
stdio
-
- .s
+ close readln (readln) read1 read with-server
+ stream-read stream-readln stream-read1 lines (lines)
+ contents stream-copy stream-flush
+ stream-write log-stream stream-format set-line-reader-cr
double>bits float>bits >bignum
intern-slots class-predicates delete (delete) prune memq?
normalize norm vneg vmax vmin v- v+ [v-]
- bin> oct> le> be> hex> concat string>number
+ bin> oct> le> be> hex> string>number
gensym random-int counter <byte-array>
<word> <client-stream> <server> <client>
- <duplex-stream>
- <file-writer> <file-reader> <file-r/w>
+ <duplex-stream> <file-writer> <file-reader> <file-r/w>
init-namespaces unxref-word set-global set off on
nest
set-restart-obj
+@ inc dec
- ! 0.0 5000000 condition
- condition
-
changed-words
callstack namespace namestack global vocabularies
file. (file.) path+ parent-dir directory.
- <continuation> continue-with
+ .s . word-xt.
+ <continuation> continue-with
set-delegate
+
closure
tabular-output simple-slots
- join
-
-
+ join concat
}
{ "arrays" "errors" "generic" "graphs" "hashtables" "io"
"kernel" "math" "namespaces"
: run-random-tester2
100000000000000 [ 6 3 random-test ] times ;
-
! A worthwhile test that has not been run extensively
1000 [ drop gensym ] map "syms" set
: pick-one [ length random-int ] keep nth ;
-: fooify
+: fooify-test
"syms" get pick-one
2000 random-int >quotation
over set-word-def
100 random-int zero? [ code-gc ] when
compile fooify ;
-
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 ;
dup clone params set
maybe-explode
r>
- dup [ nth-byte ] = [ .s ] when
! .s
- dup last-time get = [ dup . dup last-time set ] unless
+ dup last-time get = [ dup . flush dup last-time set ] unless
[ call ] [ err on ] recover
err get [
dup type-error? dup [