fix more compiler errors
parent
dba4c0d589
commit
364ea217ef
|
@ -3,7 +3,7 @@ USING: sequences tools.test concurrency.exchangers
|
||||||
concurrency.count-downs concurrency.promises locals kernel
|
concurrency.count-downs concurrency.promises locals kernel
|
||||||
threads ;
|
threads ;
|
||||||
|
|
||||||
:: exchanger-test ( -- )
|
:: exchanger-test ( -- string )
|
||||||
[let |
|
[let |
|
||||||
ex [ <exchanger> ]
|
ex [ <exchanger> ]
|
||||||
c [ 2 <count-down> ]
|
c [ 2 <count-down> ]
|
||||||
|
|
|
@ -11,7 +11,7 @@ kernel threads locals accessors calendar ;
|
||||||
|
|
||||||
[ f ] [ flag-test-1 ] unit-test
|
[ f ] [ flag-test-1 ] unit-test
|
||||||
|
|
||||||
:: flag-test-2 ( -- )
|
:: flag-test-2 ( -- ? )
|
||||||
[let | f [ <flag> ] |
|
[let | f [ <flag> ] |
|
||||||
[ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
|
[ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
|
||||||
f lower-flag
|
f lower-flag
|
||||||
|
|
|
@ -22,7 +22,7 @@ M: foo call-responder*
|
||||||
"x" [ 1+ ] schange
|
"x" [ 1+ ] schange
|
||||||
"x" sget number>string "text/html" <content> ;
|
"x" sget number>string "text/html" <content> ;
|
||||||
|
|
||||||
: url-responder-mock-test ( -- )
|
: url-responder-mock-test ( -- string )
|
||||||
[
|
[
|
||||||
<request>
|
<request>
|
||||||
"GET" >>method
|
"GET" >>method
|
||||||
|
@ -34,7 +34,7 @@ M: foo call-responder*
|
||||||
[ write-response-body drop ] with-string-writer
|
[ write-response-body drop ] with-string-writer
|
||||||
] with-destructors ;
|
] with-destructors ;
|
||||||
|
|
||||||
: sessions-mock-test ( -- )
|
: sessions-mock-test ( -- string )
|
||||||
[
|
[
|
||||||
<request>
|
<request>
|
||||||
"GET" >>method
|
"GET" >>method
|
||||||
|
|
|
@ -4,7 +4,7 @@ IN: hash2.tests
|
||||||
[ t ] [ 1 2 { 1 2 } 2= ] unit-test
|
[ t ] [ 1 2 { 1 2 } 2= ] unit-test
|
||||||
[ f ] [ 1 3 { 1 2 } 2= ] unit-test
|
[ f ] [ 1 3 { 1 2 } 2= ] unit-test
|
||||||
|
|
||||||
: sample-hash ( -- )
|
: sample-hash ( -- hash )
|
||||||
5 <hash2>
|
5 <hash2>
|
||||||
dup 2 3 "foo" roll set-hash2
|
dup 2 3 "foo" roll set-hash2
|
||||||
dup 4 2 "bar" roll set-hash2
|
dup 4 2 "bar" roll set-hash2
|
||||||
|
|
|
@ -54,7 +54,7 @@ IN: heaps.tests
|
||||||
: sort-entries ( entries -- entries' )
|
: sort-entries ( entries -- entries' )
|
||||||
[ [ key>> ] compare ] sort ;
|
[ [ key>> ] compare ] sort ;
|
||||||
|
|
||||||
: delete-test ( n -- ? )
|
: delete-test ( n -- obj1 obj2 )
|
||||||
[
|
[
|
||||||
random-alist
|
random-alist
|
||||||
<min-heap> [ heap-push-all ] keep
|
<min-heap> [ heap-push-all ] keep
|
||||||
|
|
|
@ -255,11 +255,11 @@ IN: math.intervals.tests
|
||||||
0 pick interval-contains? over first \ recip eq? and [
|
0 pick interval-contains? over first \ recip eq? and [
|
||||||
2drop t
|
2drop t
|
||||||
] [
|
] [
|
||||||
[ [ random-element ] dip first execute ] 2keep
|
[ [ random-element ] dip first execute( a -- b ) ] 2keep
|
||||||
second execute interval-contains?
|
second execute( a -- b ) interval-contains?
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
[ t ] [ 80000 [ drop unary-test ] all? ] unit-test
|
[ t ] [ 80000 iota [ drop unary-test ] all? ] unit-test
|
||||||
|
|
||||||
: random-binary-op ( -- pair )
|
: random-binary-op ( -- pair )
|
||||||
{
|
{
|
||||||
|
@ -286,11 +286,11 @@ IN: math.intervals.tests
|
||||||
0 pick interval-contains? over first { / /i mod rem } member? and [
|
0 pick interval-contains? over first { / /i mod rem } member? and [
|
||||||
3drop t
|
3drop t
|
||||||
] [
|
] [
|
||||||
[ [ [ random-element ] bi@ ] dip first execute ] 3keep
|
[ [ [ random-element ] bi@ ] dip first execute( a b -- c ) ] 3keep
|
||||||
second execute interval-contains?
|
second execute( a b -- c ) interval-contains?
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
[ t ] [ 80000 [ drop binary-test ] all? ] unit-test
|
[ t ] [ 80000 iota [ drop binary-test ] all? ] unit-test
|
||||||
|
|
||||||
: random-comparison ( -- pair )
|
: random-comparison ( -- pair )
|
||||||
{
|
{
|
||||||
|
@ -305,7 +305,7 @@ IN: math.intervals.tests
|
||||||
[ [ [ random-element ] bi@ ] dip first execute ] 3keep
|
[ [ [ random-element ] bi@ ] dip first execute ] 3keep
|
||||||
second execute dup incomparable eq? [ 2drop t ] [ = ] if ;
|
second execute dup incomparable eq? [ 2drop t ] [ = ] if ;
|
||||||
|
|
||||||
[ t ] [ 40000 [ drop comparison-test ] all? ] unit-test
|
[ t ] [ 40000 iota [ drop comparison-test ] all? ] unit-test
|
||||||
|
|
||||||
[ t ] [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
|
[ t ] [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
|
||||||
|
|
||||||
|
@ -322,7 +322,7 @@ IN: math.intervals.tests
|
||||||
[ t ] [ -10 10 [a,b] interval-abs 0 10 [a,b] = ] unit-test
|
[ t ] [ -10 10 [a,b] interval-abs 0 10 [a,b] = ] unit-test
|
||||||
|
|
||||||
! Test that commutative interval ops really are
|
! Test that commutative interval ops really are
|
||||||
: random-interval-or-empty ( -- )
|
: random-interval-or-empty ( -- obj )
|
||||||
10 random 0 = [ empty-interval ] [ random-interval ] if ;
|
10 random 0 = [ empty-interval ] [ random-interval ] if ;
|
||||||
|
|
||||||
: random-commutative-op ( -- op )
|
: random-commutative-op ( -- op )
|
||||||
|
@ -333,7 +333,7 @@ IN: math.intervals.tests
|
||||||
} random ;
|
} random ;
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
80000 [
|
80000 iota [
|
||||||
drop
|
drop
|
||||||
random-interval-or-empty random-interval-or-empty
|
random-interval-or-empty random-interval-or-empty
|
||||||
random-commutative-op
|
random-commutative-op
|
||||||
|
|
|
@ -56,6 +56,6 @@ TUPLE: color
|
||||||
! Test reshaping with a mirror
|
! Test reshaping with a mirror
|
||||||
1 2 3 color boa <mirror> "mirror" set
|
1 2 3 color boa <mirror> "mirror" set
|
||||||
|
|
||||||
[ ] [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval ] unit-test
|
[ ] [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" (( -- )) eval ] unit-test
|
||||||
|
|
||||||
[ 1 ] [ "red" "mirror" get at ] unit-test
|
[ 1 ] [ "red" "mirror" get at ] unit-test
|
||||||
|
|
|
@ -83,7 +83,7 @@ M: hash-0-b hashcode* 2drop 0 ;
|
||||||
: random-string ( -- str )
|
: random-string ( -- str )
|
||||||
1000000 random ; ! [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ;
|
1000000 random ; ! [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ;
|
||||||
|
|
||||||
: random-assocs ( -- hash phash )
|
: random-assocs ( n -- hash phash )
|
||||||
[ random-string ] replicate
|
[ random-string ] replicate
|
||||||
[ H{ } clone [ '[ swap _ set-at ] each-index ] keep ]
|
[ H{ } clone [ '[ swap _ set-at ] each-index ] keep ]
|
||||||
[ PH{ } clone swap [ spin new-at ] each-index ]
|
[ PH{ } clone swap [ spin new-at ] each-index ]
|
||||||
|
@ -92,7 +92,7 @@ M: hash-0-b hashcode* 2drop 0 ;
|
||||||
: ok? ( assoc1 assoc2 -- ? )
|
: ok? ( assoc1 assoc2 -- ? )
|
||||||
[ assoc= ] [ [ assoc-size ] bi@ = ] 2bi and ;
|
[ assoc= ] [ [ assoc-size ] bi@ = ] 2bi and ;
|
||||||
|
|
||||||
: test-persistent-hashtables-1 ( n -- )
|
: test-persistent-hashtables-1 ( n -- ? )
|
||||||
random-assocs ok? ;
|
random-assocs ok? ;
|
||||||
|
|
||||||
[ t ] [ 10 test-persistent-hashtables-1 ] unit-test
|
[ t ] [ 10 test-persistent-hashtables-1 ] unit-test
|
||||||
|
@ -106,7 +106,7 @@ M: hash-0-b hashcode* 2drop 0 ;
|
||||||
[ t ] [ 10000 test-persistent-hashtables-1 ] unit-test
|
[ t ] [ 10000 test-persistent-hashtables-1 ] unit-test
|
||||||
[ t ] [ 50000 test-persistent-hashtables-1 ] unit-test
|
[ t ] [ 50000 test-persistent-hashtables-1 ] unit-test
|
||||||
|
|
||||||
: test-persistent-hashtables-2 ( n -- )
|
: test-persistent-hashtables-2 ( n -- ? )
|
||||||
random-assocs
|
random-assocs
|
||||||
dup keys [
|
dup keys [
|
||||||
[ nip over delete-at ] [ swap pluck-at nip ] 3bi
|
[ nip over delete-at ] [ swap pluck-at nip ] 3bi
|
||||||
|
|
|
@ -11,7 +11,7 @@ IN: random.mersenne-twister.tests
|
||||||
100 [ 100 random ] replicate ;
|
100 [ 100 random ] replicate ;
|
||||||
|
|
||||||
: test-rng ( seed quot -- )
|
: test-rng ( seed quot -- )
|
||||||
[ <mersenne-twister> ] dip with-random ;
|
[ <mersenne-twister> ] dip with-random ; inline
|
||||||
|
|
||||||
[ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test
|
[ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -31,7 +31,7 @@ yield
|
||||||
|
|
||||||
[ [ 3 throw ] "A" suspend ] [ 3 = ] must-fail-with
|
[ [ 3 throw ] "A" suspend ] [ 3 = ] must-fail-with
|
||||||
|
|
||||||
:: spawn-namespace-test ( -- )
|
:: spawn-namespace-test ( -- ? )
|
||||||
[let | p [ <promise> ] g [ gensym ] |
|
[let | p [ <promise> ] g [ gensym ] |
|
||||||
[
|
[
|
||||||
g "x" set
|
g "x" set
|
||||||
|
|
|
@ -374,9 +374,9 @@ SYMBOL: deploy-vocab
|
||||||
[:c]
|
[:c]
|
||||||
[print-error]
|
[print-error]
|
||||||
'[
|
'[
|
||||||
[ _ execute ] [
|
[ _ execute( obj -- ) ] [
|
||||||
_ execute nl
|
_ execute( obj -- ) nl
|
||||||
_ execute
|
_ execute( obj -- )
|
||||||
] recover
|
] recover
|
||||||
] %
|
] %
|
||||||
] if
|
] if
|
||||||
|
|
|
@ -357,7 +357,7 @@ DEFER: corner-case-1
|
||||||
|
|
||||||
[ 4 ] [ 2 2 [ + ] curry 1array case ] unit-test
|
[ 4 ] [ 2 2 [ + ] curry 1array case ] unit-test
|
||||||
|
|
||||||
: test-case-8 ( n -- )
|
: test-case-8 ( n -- string )
|
||||||
{
|
{
|
||||||
{ 1 [ "foo" ] }
|
{ 1 [ "foo" ] }
|
||||||
} case ;
|
} case ;
|
||||||
|
|
|
@ -3,7 +3,7 @@ continuations debugger parser memory arrays words
|
||||||
kernel.private accessors eval ;
|
kernel.private accessors eval ;
|
||||||
IN: continuations.tests
|
IN: continuations.tests
|
||||||
|
|
||||||
: (callcc1-test) ( -- )
|
: (callcc1-test) ( n obj -- n' obj )
|
||||||
[ 1- dup ] dip ?push
|
[ 1- dup ] dip ?push
|
||||||
over 0 = [ "test-cc" get continue-with ] when
|
over 0 = [ "test-cc" get continue-with ] when
|
||||||
(callcc1-test) ;
|
(callcc1-test) ;
|
||||||
|
@ -59,7 +59,7 @@ IN: continuations.tests
|
||||||
! : callstack-overflow callstack-overflow f ;
|
! : callstack-overflow callstack-overflow f ;
|
||||||
! [ callstack-overflow ] must-fail
|
! [ callstack-overflow ] must-fail
|
||||||
|
|
||||||
: don't-compile-me ( -- ) { } [ ] each ;
|
: don't-compile-me ( n -- ) { } [ ] each ;
|
||||||
|
|
||||||
: foo ( -- ) callstack "c" set 3 don't-compile-me ;
|
: foo ( -- ) callstack "c" set 3 don't-compile-me ;
|
||||||
: bar ( -- a b ) 1 foo 2 ;
|
: bar ( -- a b ) 1 foo 2 ;
|
||||||
|
|
|
@ -27,7 +27,7 @@ IN: kernel.tests
|
||||||
|
|
||||||
[ ] [ :c ] unit-test
|
[ ] [ :c ] unit-test
|
||||||
|
|
||||||
: (overflow-d-alt) ( -- ) 3 ;
|
: (overflow-d-alt) ( -- n ) 3 ;
|
||||||
|
|
||||||
: overflow-d-alt ( -- ) (overflow-d-alt) overflow-d-alt ;
|
: overflow-d-alt ( -- ) (overflow-d-alt) overflow-d-alt ;
|
||||||
|
|
||||||
|
@ -107,7 +107,7 @@ IN: kernel.tests
|
||||||
! Regression
|
! Regression
|
||||||
: (loop) ( a b c d -- )
|
: (loop) ( a b c d -- )
|
||||||
[ pick ] dip swap [ pick ] dip swap
|
[ pick ] dip swap [ pick ] dip swap
|
||||||
< [ [ 1+ ] 3dip (loop) ] [ 2drop 2drop ] if ; inline
|
< [ [ 1+ ] 3dip (loop) ] [ 2drop 2drop ] if ; inline recursive
|
||||||
|
|
||||||
: loop ( obj obj -- )
|
: loop ( obj obj -- )
|
||||||
H{ } values swap [ dup length swap ] dip 0 -roll (loop) ;
|
H{ } values swap [ dup length swap ] dip 0 -roll (loop) ;
|
||||||
|
|
|
@ -2,7 +2,7 @@ USING: io lint kernel math tools.test ;
|
||||||
IN: lint.tests
|
IN: lint.tests
|
||||||
|
|
||||||
! Don't write code like this
|
! Don't write code like this
|
||||||
: lint1 ( -- ) [ "hi" print ] [ ] if ; ! when
|
: lint1 ( obj -- ) [ "hi" print ] [ ] if ; ! when
|
||||||
|
|
||||||
[ { { lint1 { [ [ ] if ] } } } ] [ \ lint1 lint-word ] unit-test
|
[ { { lint1 { [ [ ] if ] } } } ] [ \ lint1 lint-word ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -7,7 +7,7 @@ SYMBOL: sum
|
||||||
: range ( r from to -- n )
|
: range ( r from to -- n )
|
||||||
over - 1 + rot [
|
over - 1 + rot [
|
||||||
-rot [ over + pick call drop ] each 2drop f
|
-rot [ over + pick call drop ] each 2drop f
|
||||||
] bshift 2nip ;
|
] bshift 2nip ; inline
|
||||||
|
|
||||||
[ 55 ] [
|
[ 55 ] [
|
||||||
0 sum set
|
0 sum set
|
||||||
|
|
Loading…
Reference in New Issue