more cleanup in random-tester
erg
parent
bb92e43a43
commit
d03f46e784
|
|
@ -1,96 +0,0 @@
|
|||
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 ;
|
||||
|
||||
|
|
@ -23,8 +23,6 @@ SYMBOL: wordbank
|
|||
|
||||
clear-hash build-graph
|
||||
|
||||
be>
|
||||
|
||||
>r r>
|
||||
|
||||
set-callstack set-word set-word-prop
|
||||
|
|
@ -38,10 +36,9 @@ SYMBOL: wordbank
|
|||
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>
|
||||
|
||||
|
|
@ -59,52 +56,42 @@ SYMBOL: wordbank
|
|||
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"
|
||||
|
|
@ -162,17 +149,15 @@ err off
|
|||
: 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 ;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -2,28 +2,6 @@ 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 ;
|
||||
|
||||
|
|
@ -72,9 +50,8 @@ SYMBOL: last-time
|
|||
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 [
|
||||
|
|
|
|||
Loading…
Reference in New Issue