steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added some if/when/unless testing 

added some non-partial-evaluation tests with inter-compile-1
cvs
Doug Coleman 2006-01-23 06:03:40 +00:00
parent a0722fa3e0
commit 9c9589aac2
2 changed files with 24 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
contrib/random-tester/random-tester.factor
View File

@ -112,8 +112,7 @@ IN: random-tester
: 2float>float ( f f -- f ) ( -- word ) { * + - /f max min } ; : 2float>float ( f f -- f ) ( -- word ) { * + - /f max min } ;
: 2complex>complex ( c c -- c ) ( -- word ) { * + - /f } ; : 2complex>complex ( c c -- c ) ( -- word ) { * + - /f } ;
: random-integer-quotation ( -- quot ) : (random-integer-quotation) ( -- quot )
[
random-integer , random-integer ,
max-length random-int max-length random-int
[ [
@ -121,7 +120,15 @@ IN: random-tester
[ integer>integer nth-rand , ] [ integer>integer nth-rand , ]
[ random-integer , 2integer>integer nth-rand , ] [ random-integer , 2integer>integer nth-rand , ]
] do-one ] do-one
] times ] times ;
: random-integer-quotation ( -- quot )
[
(random-integer-quotation)
] [ ] make ;
: random-integer-quotation-1 ( -- quot )
[
(random-integer-quotation) 2integer>integer nth-rand ,
] [ ] make ; ] [ ] make ;
: (random-ratio-quotation) ( -- quot ) : (random-ratio-quotation) ( -- quot )
@ -171,12 +178,19 @@ IN: random-tester
SYMBOL: last SYMBOL: last
: interp-compile-check ( quot -- ) : interp-compile-check ( quot -- )
! dup . dup .
[ last set ] keep [ last set ] keep
[ call ] keep compile-1 [ call ] keep compile-1
2dup swap unparse write " " write unparse print 2dup swap unparse write " " write unparse print
= [ "problem in math" throw ] unless ; = [ "problem in math" throw ] unless ;
: interp-compile-check-1 ( quot -- )
dup .
[ last set ] keep
[ call ] 2keep compile-1
2dup swap unparse write " " write unparse print
= [ "problem in math" throw ] unless ;
: interp-compile-check* ( quot -- ) : interp-compile-check* ( quot -- )
dup . dup .
>r 100 200 300 400 r> [ call 4array ] keep >r 100 200 300 400 r> [ call 4array ] keep

2
contrib/random-tester/random.factor
View File

@ -5,7 +5,7 @@ USING: optimizer compiler-frontend compiler-backend inference ;
IN: random-tester IN: random-tester
! Tweak me ! Tweak me
: max-length 5 ; inline : max-length 7 ; inline
: max-value 1000000000 ; inline : max-value 1000000000 ; inline
: 10% ( -- bool ) 10 random-int 8 > ; : 10% ( -- bool ) 10 random-int 8 > ;