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

fixing compiler errors in basis

db4
Doug Coleman 2009-04-17 12:46:04 -05:00
parent aad6a3d504
commit dba4c0d589
34 changed files with 96 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/tests/folding.factor
View File

@ -12,7 +12,7 @@ IN: compiler.tests
IN: compiler.tests.folding IN: compiler.tests.folding
GENERIC: foldable-generic ( a -- b ) foldable GENERIC: foldable-generic ( a -- b ) foldable
M: integer foldable-generic f <array> ; M: integer foldable-generic f <array> ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ ] [ [ ] [
@ -20,7 +20,7 @@ IN: compiler.tests
USING: math arrays ; USING: math arrays ;
IN: compiler.tests.folding IN: compiler.tests.folding
: fold-test ( -- x ) 10 foldable-generic ; : fold-test ( -- x ) 10 foldable-generic ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ t ] [ [ t ] [

12
basis/compiler/tests/redefine1.factor
View File

@ -11,7 +11,7 @@ M: integer method-redefine-generic-1 3 + ;
[ 6 ] [ method-redefine-test-1 ] unit-test [ 6 ] [ method-redefine-test-1 ] unit-test
[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" eval ] unit-test [ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" (( -- )) eval ] unit-test
[ 7 ] [ method-redefine-test-1 ] unit-test [ 7 ] [ method-redefine-test-1 ] unit-test
@ -27,7 +27,7 @@ M: integer method-redefine-generic-2 3 + ;
[ 6 ] [ method-redefine-test-2 ] unit-test [ 6 ] [ method-redefine-test-2 ] unit-test
[ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval ] unit-test [ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" (( -- )) eval ] unit-test
[ 7 ] [ method-redefine-test-2 ] unit-test [ 7 ] [ method-redefine-test-2 ] unit-test
@ -43,10 +43,10 @@ M: integer method-redefine-generic-2 3 + ;
[ t ] [ \ hey optimized>> ] unit-test [ t ] [ \ hey optimized>> ] unit-test
[ t ] [ \ there optimized>> ] unit-test [ t ] [ \ there optimized>> ] unit-test
[ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test [ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" (( -- )) eval ] unit-test
[ f ] [ \ hey optimized>> ] unit-test [ f ] [ \ hey optimized>> ] unit-test
[ f ] [ \ there optimized>> ] unit-test [ f ] [ \ there optimized>> ] unit-test
[ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test [ ] [ "IN: compiler.tests : hey ( -- ) ;" (( -- )) eval ] unit-test
[ t ] [ \ there optimized>> ] unit-test [ t ] [ \ there optimized>> ] unit-test
: good ( -- ) ; : good ( -- ) ;
@ -59,7 +59,7 @@ M: integer method-redefine-generic-2 3 + ;
[ f ] [ \ good compiled-usage assoc-empty? ] unit-test [ f ] [ \ good compiled-usage assoc-empty? ] unit-test
[ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test [ ] [ "IN: compiler.tests : good ( -- ) 3 ;" (( -- )) eval ] unit-test
[ f ] [ \ good optimized>> ] unit-test [ f ] [ \ good optimized>> ] unit-test
[ f ] [ \ bad optimized>> ] unit-test [ f ] [ \ bad optimized>> ] unit-test
@ -67,7 +67,7 @@ M: integer method-redefine-generic-2 3 + ;
[ t ] [ \ good compiled-usage assoc-empty? ] unit-test [ t ] [ \ good compiled-usage assoc-empty? ] unit-test
[ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test [ ] [ "IN: compiler.tests : good ( -- ) ;" (( -- )) eval ] unit-test
[ t ] [ \ good optimized>> ] unit-test [ t ] [ \ good optimized>> ] unit-test
[ t ] [ \ bad optimized>> ] unit-test [ t ] [ \ bad optimized>> ] unit-test

4
basis/compiler/tests/redefine10.factor
View File

@ -13,7 +13,7 @@ IN: compiler.tests
MIXIN: my-mixin MIXIN: my-mixin
INSTANCE: fixnum my-mixin INSTANCE: fixnum my-mixin
: my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ; : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ ] [ [ ] [
@ -21,7 +21,7 @@ IN: compiler.tests
USE: math USE: math
IN: compiler.tests.redefine10 IN: compiler.tests.redefine10
INSTANCE: float my-mixin INSTANCE: float my-mixin
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ 2.0 ] [ [ 2.0 ] [

2
basis/compiler/tests/redefine11.factor
View File

@ -17,7 +17,7 @@ IN: compiler.tests
M: my-mixin my-generic drop 0 ; M: my-mixin my-generic drop 0 ;
M: object my-generic drop 1 ; M: object my-generic drop 1 ;
: my-inline ( -- b ) { } my-generic ; : my-inline ( -- b ) { } my-generic ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ ] [ [ ] [

2
basis/compiler/tests/redefine12.factor
View File

@ -15,6 +15,6 @@ M: object g drop t ;
TUPLE: jeah ; TUPLE: jeah ;
[ ] [ "USE: kernel IN: compiler.tests.redefine12 M: jeah g drop f ;" eval ] unit-test [ ] [ "USE: kernel IN: compiler.tests.redefine12 M: jeah g drop f ;" (( -- )) eval ] unit-test
[ f ] [ T{ jeah } h ] unit-test [ f ] [ T{ jeah } h ] unit-test

2
basis/compiler/tests/redefine2.factor
View File

@ -5,7 +5,7 @@ arrays words assocs eval words.symbol ;
DEFER: redefine2-test DEFER: redefine2-test
[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval ] unit-test [ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" (( -- )) eval ] unit-test
[ t ] [ \ redefine2-test symbol? ] unit-test [ t ] [ \ redefine2-test symbol? ] unit-test

2
basis/compiler/tests/redefine3.factor
View File

@ -18,7 +18,7 @@ M: empty-mixin sheeple drop "wake up" ;
[ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
[ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
[ ] [ "IN: compiler.tests USE: arrays INSTANCE: array empty-mixin" eval ] unit-test [ ] [ "IN: compiler.tests USE: arrays INSTANCE: array empty-mixin" (( -- )) eval ] unit-test
[ "wake up" ] [ sheeple-test ] unit-test [ "wake up" ] [ sheeple-test ] unit-test
[ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test [ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test

2
basis/compiler/tests/redefine4.factor
View File

@ -7,6 +7,6 @@ USING: io.streams.string kernel tools.test eval ;
[ "" ] [ [ declaration-test ] with-string-writer ] unit-test [ "" ] [ [ declaration-test ] with-string-writer ] unit-test
[ ] [ "IN: compiler.tests USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval ] unit-test [ ] [ "IN: compiler.tests USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" (( -- )) eval ] unit-test
[ "X" ] [ [ declaration-test ] with-string-writer ] unit-test [ "X" ] [ [ declaration-test ] with-string-writer ] unit-test

4
basis/compiler/tests/redefine5.factor
View File

@ -14,7 +14,7 @@ IN: compiler.tests
GENERIC: my-generic ( a -- b ) GENERIC: my-generic ( a -- b )
M: object my-generic [ <=> ] sort ; M: object my-generic [ <=> ] sort ;
: my-inline ( a -- b ) my-generic ; : my-inline ( a -- b ) my-generic ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ ] [ [ ] [
@ -23,7 +23,7 @@ IN: compiler.tests
IN: compiler.tests.redefine5 IN: compiler.tests.redefine5
TUPLE: my-tuple ; TUPLE: my-tuple ;
M: my-tuple my-generic drop 0 ; M: my-tuple my-generic drop 0 ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ 0 ] [ [ 0 ] [

4
basis/compiler/tests/redefine6.factor
View File

@ -14,7 +14,7 @@ IN: compiler.tests
MIXIN: my-mixin MIXIN: my-mixin
M: my-mixin my-generic drop 0 ; M: my-mixin my-generic drop 0 ;
: my-inline ( a -- b ) { my-mixin } declare my-generic ; : my-inline ( a -- b ) { my-mixin } declare my-generic ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ ] [ [ ] [
@ -24,7 +24,7 @@ IN: compiler.tests
TUPLE: my-tuple ; TUPLE: my-tuple ;
M: my-tuple my-generic drop 1 ; M: my-tuple my-generic drop 1 ;
INSTANCE: my-tuple my-mixin INSTANCE: my-tuple my-mixin
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ 1 ] [ [ 1 ] [

4
basis/compiler/tests/redefine7.factor
View File

@ -13,7 +13,7 @@ IN: compiler.tests
MIXIN: my-mixin MIXIN: my-mixin
INSTANCE: fixnum my-mixin INSTANCE: fixnum my-mixin
: my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ; : my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ ] [ [ ] [
@ -21,7 +21,7 @@ IN: compiler.tests
USE: math USE: math
IN: compiler.tests.redefine7 IN: compiler.tests.redefine7
INSTANCE: float my-mixin INSTANCE: float my-mixin
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ 2.0 ] [ [ 2.0 ] [

4
basis/compiler/tests/redefine8.factor
View File

@ -16,7 +16,7 @@ IN: compiler.tests
! We add the bogus quotation here to hinder inlining ! We add the bogus quotation here to hinder inlining
! since otherwise we cannot trigger this bug. ! since otherwise we cannot trigger this bug.
M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ; M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ ] [ [ ] [
@ -24,7 +24,7 @@ IN: compiler.tests
USE: math USE: math
IN: compiler.tests.redefine8 IN: compiler.tests.redefine8
INSTANCE: float my-mixin INSTANCE: float my-mixin
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ 2.0 ] [ [ 2.0 ] [

4
basis/compiler/tests/redefine9.factor
View File

@ -16,7 +16,7 @@ IN: compiler.tests
! We add the bogus quotation here to hinder inlining ! We add the bogus quotation here to hinder inlining
! since otherwise we cannot trigger this bug. ! since otherwise we cannot trigger this bug.
M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ; M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ ] [ [ ] [
@ -25,7 +25,7 @@ IN: compiler.tests
IN: compiler.tests.redefine9 IN: compiler.tests.redefine9
TUPLE: my-tuple ; TUPLE: my-tuple ;
INSTANCE: my-tuple my-mixin INSTANCE: my-tuple my-mixin
"> eval "> (( -- )) eval
] unit-test ] unit-test
[ [

2
basis/compiler/tests/simple.factor
View File

@ -237,6 +237,6 @@ M: f single-combination-test-2 single-combination-test-4 ;
10 [ 10 [
[ "compiler.tests.foo" forget-vocab ] with-compilation-unit [ "compiler.tests.foo" forget-vocab ] with-compilation-unit
[ t ] [ [ t ] [
"USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" eval "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" (( -- obj )) eval
] unit-test ] unit-test
] times ] times

2
basis/compiler/tree/cleanup/cleanup-tests.factor
View File

@ -197,7 +197,7 @@ M: fixnum annotate-entry-test-1 drop ;
[ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2) [ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2)
] if ; inline recursive ] if ; inline recursive
: annotate-entry-test-2 ( from to -- ) 0 -rot (annotate-entry-test-2) ; inline : annotate-entry-test-2 ( from to -- obj ) 0 -rot (annotate-entry-test-2) ; inline
[ f ] [ [ f ] [
[ { bignum } declare annotate-entry-test-2 ] [ { bignum } declare annotate-entry-test-2 ]

12
basis/compiler/tree/normalization/normalization-tests.factor
View File

@ -17,7 +17,7 @@ sequences accessors tools.test kernel math ;
[ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test [ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
: foo ( -- ) swap ; inline recursive : foo ( a b -- b a ) swap ; inline recursive
: recursive-inputs ( nodes -- n ) : recursive-inputs ( nodes -- n )
[ #recursive? ] find nip child>> first in-d>> length ; [ #recursive? ] find nip child>> first in-d>> length ;
@ -34,18 +34,18 @@ sequences accessors tools.test kernel math ;
[ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test [ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test
DEFER: bbb DEFER: bbb
: aaa ( x -- ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive : aaa ( obj x -- obj ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive
: bbb ( x -- ) [ drop 0 ] dip aaa ; inline recursive : bbb ( obj x -- obj ) [ drop 0 ] dip aaa ; inline recursive
[ ] [ [ bbb ] test-normalization ] unit-test [ ] [ [ bbb ] test-normalization ] unit-test
: ccc ( -- ) ccc drop 1 ; inline recursive : ccc ( obj -- 1 ) ccc drop 1 ; inline recursive
[ ] [ [ ccc ] test-normalization ] unit-test [ ] [ [ ccc ] test-normalization ] unit-test
DEFER: eee DEFER: eee
: ddd ( -- ) eee ; inline recursive : ddd ( a b -- a b ) eee ; inline recursive
: eee ( -- ) swap ddd ; inline recursive : eee ( a b -- a b ) swap ddd ; inline recursive
[ ] [ [ eee ] test-normalization ] unit-test [ ] [ [ eee ] test-normalization ] unit-test

2
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -680,7 +680,7 @@ TUPLE: littledan-2 { from read-only } { to read-only } ;
: (littledan-3-test) ( x -- ) : (littledan-3-test) ( x -- )
length 1+ f <array> (littledan-3-test) ; inline recursive length 1+ f <array> (littledan-3-test) ; inline recursive
: littledan-3-test ( x -- ) : littledan-3-test ( -- )
0 f <array> (littledan-3-test) ; inline 0 f <array> (littledan-3-test) ; inline
[ ] [ [ littledan-3-test ] final-classes drop ] unit-test [ ] [ [ littledan-3-test ] final-classes drop ] unit-test

2
basis/compiler/tree/recursive/recursive-tests.factor
View File

@ -57,7 +57,7 @@ compiler.tree.combinators ;
\ (each-integer) label-is-loop? \ (each-integer) label-is-loop?
] unit-test ] unit-test
: loop-test-2 ( a -- ) : loop-test-2 ( a b -- a' )
dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline recursive dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline recursive
[ t ] [ [ t ] [

10
basis/delegate/delegate-tests.factor
View File

@ -35,7 +35,7 @@ M: hello bing hello-test ;
[ 3 ] [ 1 0 <hello> 2 whoa ] unit-test [ 3 ] [ 1 0 <hello> 2 whoa ] unit-test
[ 3 ] [ 1 0 <hello> f <goodbye> 2 whoa ] unit-test [ 3 ] [ 1 0 <hello> f <goodbye> 2 whoa ] unit-test
[ ] [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" eval ] times ] unit-test [ ] [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" (( -- )) eval ] times ] unit-test
[ H{ { goodbye T{ consultation f baz goodbye [ these>> ] } } } ] [ baz protocol-consult ] unit-test [ H{ { goodbye T{ consultation f baz goodbye [ these>> ] } } } ] [ baz protocol-consult ] unit-test
[ H{ } ] [ bee protocol-consult ] unit-test [ H{ } ] [ bee protocol-consult ] unit-test
@ -63,22 +63,22 @@ CONSULT: beta hey value>> 1- ;
[ 0 ] [ 1 <hey> three ] unit-test [ 0 ] [ 1 <hey> three ] unit-test
[ { hey } ] [ alpha protocol-users ] unit-test [ { hey } ] [ alpha protocol-users ] unit-test
[ { hey } ] [ beta protocol-users ] unit-test [ { hey } ] [ beta protocol-users ] unit-test
[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: alpha one ;" eval ] unit-test [ ] [ "USE: delegate IN: delegate.tests PROTOCOL: alpha one ;" (( -- )) eval ] unit-test
[ f ] [ hey \ two method ] unit-test [ f ] [ hey \ two method ] unit-test
[ f ] [ hey \ four method ] unit-test [ f ] [ hey \ four method ] unit-test
[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: beta two three four ;" eval ] unit-test [ ] [ "USE: delegate IN: delegate.tests PROTOCOL: beta two three four ;" (( -- )) eval ] unit-test
[ { hey } ] [ alpha protocol-users ] unit-test [ { hey } ] [ alpha protocol-users ] unit-test
[ { hey } ] [ beta protocol-users ] unit-test [ { hey } ] [ beta protocol-users ] unit-test
[ 2 ] [ 1 <hey> one ] unit-test [ 2 ] [ 1 <hey> one ] unit-test
[ 0 ] [ 1 <hey> two ] unit-test [ 0 ] [ 1 <hey> two ] unit-test
[ 0 ] [ 1 <hey> three ] unit-test [ 0 ] [ 1 <hey> three ] unit-test
[ 0 ] [ 1 <hey> four ] unit-test [ 0 ] [ 1 <hey> four ] unit-test
[ ] [ "USING: math accessors delegate ; IN: delegate.tests CONSULT: beta hey value>> 2 - ;" eval ] unit-test [ ] [ "USING: math accessors delegate ; IN: delegate.tests CONSULT: beta hey value>> 2 - ;" (( -- )) eval ] unit-test
[ 2 ] [ 1 <hey> one ] unit-test [ 2 ] [ 1 <hey> one ] unit-test
[ -1 ] [ 1 <hey> two ] unit-test [ -1 ] [ 1 <hey> two ] unit-test
[ -1 ] [ 1 <hey> three ] unit-test [ -1 ] [ 1 <hey> three ] unit-test
[ -1 ] [ 1 <hey> four ] unit-test [ -1 ] [ 1 <hey> four ] unit-test
[ ] [ "IN: delegate.tests FORGET: alpha" eval ] unit-test [ ] [ "IN: delegate.tests FORGET: alpha" (( -- )) eval ] unit-test
[ f ] [ hey \ one method ] unit-test [ f ] [ hey \ one method ] unit-test
TUPLE: slot-protocol-test-1 a b ; TUPLE: slot-protocol-test-1 a b ;

2
basis/fry/fry-tests.factor
View File

@ -56,7 +56,7 @@ sequences eval accessors ;
3 '[ [ [ _ 1array ] call 1array ] call 1array ] call 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
] unit-test ] unit-test
[ "USING: fry locals.backend ; f '[ load-local _ ]" eval ] [ "USING: fry locals.backend ; f '[ load-local _ ]" (( -- quot )) eval ]
[ error>> >r/r>-in-fry-error? ] must-fail-with [ error>> >r/r>-in-fry-error? ] must-fail-with
[ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [ [ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [

4
basis/help/crossref/crossref-tests.factor
View File

@ -4,7 +4,7 @@ definitions assocs sequences kernel namespaces parser arrays
io.streams.string continuations debugger compiler.units eval ; io.streams.string continuations debugger compiler.units eval ;
[ ] [ [ ] [
"IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" (( -- )) eval
] unit-test ] unit-test
[ $subsection ] [ [ $subsection ] [
@ -23,7 +23,7 @@ io.streams.string continuations debugger compiler.units eval ;
] unit-test ] unit-test
[ ] [ [ ] [
"IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" (( -- )) eval
] unit-test ] unit-test
[ ] [ [ ] [

2
basis/help/definitions/definitions-tests.factor
View File

@ -32,7 +32,7 @@ IN: help.definitions.tests
"hello" "help.definitions.tests" lookup "help" word-prop "hello" "help.definitions.tests" lookup "help" word-prop
] unit-test ] unit-test
[ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" eval ] unit-test [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" (( -- )) eval ] unit-test
[ ] [ "xxx" "help.definitions.tests" lookup print-topic ] unit-test [ ] [ "xxx" "help.definitions.tests" lookup print-topic ] unit-test

4
basis/help/syntax/syntax-tests.factor
View File

@ -4,12 +4,12 @@ IN: help.syntax.tests
[ [
[ "foobar" ] [ [ "foobar" ] [
"IN: help.syntax.tests USE: help.syntax ABOUT: \"foobar\"" eval "IN: help.syntax.tests USE: help.syntax ABOUT: \"foobar\"" (( -- )) eval
"help.syntax.tests" vocab vocab-help "help.syntax.tests" vocab vocab-help
] unit-test ] unit-test
[ { "foobar" } ] [ [ { "foobar" } ] [
"IN: help.syntax.tests USE: help.syntax ABOUT: { \"foobar\" }" eval "IN: help.syntax.tests USE: help.syntax ABOUT: { \"foobar\" }" (( -- )) eval
"help.syntax.tests" vocab vocab-help "help.syntax.tests" vocab vocab-help
] unit-test ] unit-test

2
basis/help/topics/topics-tests.factor
View File

@ -29,7 +29,7 @@ SYMBOL: foo
} "\n" join } "\n" join
[ [
"testfile" source-file file set "testfile" source-file file set
eval (( -- )) eval
] with-scope ] with-scope
] unit-test ] unit-test

4
basis/listener/listener-tests.factor
View File

@ -25,7 +25,7 @@ SYNTAX: hello "Hi" print ;
"\\ + 1 2 3 4" parse-interactive "\\ + 1 2 3 4" parse-interactive
"cont" get continue-with "cont" get continue-with
] ignore-errors ] ignore-errors
"USE: debugger :1" eval "USE: debugger :1" (( -- quot )) eval
] callcc1 ] callcc1
] unit-test ] unit-test
] with-file-vocabs ] with-file-vocabs
@ -50,7 +50,7 @@ SYNTAX: hello "Hi" print ;
[ [
[ ] [ [ ] [
"IN: listener.tests : hello ( -- )\n\"world\" ;" parse-interactive "IN: listener.tests : hello ( -- string )\n\"world\" ;" parse-interactive
drop drop
] unit-test ] unit-test
] with-file-vocabs ] with-file-vocabs

26
basis/locals/locals-tests.factor
View File

@ -261,7 +261,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n" CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n"
[ ] [ new-definition eval ] unit-test [ ] [ new-definition (( -- )) eval ] unit-test
[ t ] [ [ t ] [
[ \ a-word-with-locals see ] with-string-writer [ \ a-word-with-locals see ] with-string-writer
@ -461,7 +461,7 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
[ [
"USING: locals fry math ; 1 '[ [let | A [ 10 ] | A _ + ] ]" "USING: locals fry math ; 1 '[ [let | A [ 10 ] | A _ + ] ]"
eval call (( -- )) eval call
] [ error>> >r/r>-in-fry-error? ] must-fail-with ] [ error>> >r/r>-in-fry-error? ] must-fail-with
:: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline :: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline
@ -473,10 +473,10 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
[ f ] [ 2 funny-macro-test ] unit-test [ f ] [ 2 funny-macro-test ] unit-test
! Some odd parser corner cases ! Some odd parser corner cases
[ "USE: locals [let" eval ] [ error>> unexpected-eof? ] must-fail-with [ "USE: locals [let" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with
[ "USE: locals [let |" eval ] [ error>> unexpected-eof? ] must-fail-with [ "USE: locals [let |" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with
[ "USE: locals [let | a" eval ] [ error>> unexpected-eof? ] must-fail-with [ "USE: locals [let | a" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with
[ "USE: locals [|" eval ] [ error>> unexpected-eof? ] must-fail-with [ "USE: locals [|" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with
[ 25 ] [ 5 [| a | { [ a sq ] } cond ] call ] unit-test [ 25 ] [ 5 [| a | { [ a sq ] } cond ] call ] unit-test
[ 25 ] [ 5 [| | { [| a | a sq ] } ] call first call ] unit-test [ 25 ] [ 5 [| | { [| a | a sq ] } ] call first call ] unit-test
@ -491,19 +491,19 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
[ 3 ] [ 3 [| a | \ a ] call ] unit-test [ 3 ] [ 3 [| a | \ a ] call ] unit-test
[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" eval ] must-fail [ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" (( -- )) eval ] must-fail
[ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" eval ] must-fail [ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" (( -- )) eval ] must-fail
[ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" eval ] must-fail [ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" (( -- )) eval ] must-fail
[ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" eval ] must-fail [ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" (( -- )) eval ] must-fail
[ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" eval ] must-fail [ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" (( -- )) eval ] must-fail
[ "USE: locals [| | { :> a } ]" eval ] must-fail [ "USE: locals [| | { :> a } ]" (( -- )) eval ] must-fail
[ "USE: locals 3 :> a" eval ] must-fail [ "USE: locals 3 :> a" (( -- )) eval ] must-fail
[ 3 ] [ 3 [| | :> a a ] call ] unit-test [ 3 ] [ 3 [| | :> a a ] call ] unit-test

4
basis/macros/macros-tests.factor
View File

@ -13,11 +13,11 @@ unit-test
[ t ] [ \ see-test macro? ] unit-test [ t ] [ \ see-test macro? ] unit-test
[ t ] [ [ t ] [
"USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup eval "USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup (( -- )) eval
[ \ see-test see ] with-string-writer = [ \ see-test see ] with-string-writer =
] unit-test ] unit-test
[ f ] [ \ see-test macro? ] unit-test [ f ] [ \ see-test macro? ] unit-test
[ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval ] unit-test [ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" (( -- )) eval ] unit-test

4
basis/memoize/memoize-tests.factor
View File

@ -9,7 +9,7 @@ MEMO: fib ( m -- n )
[ 89 ] [ 10 fib ] unit-test [ 89 ] [ 10 fib ] unit-test
[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1+ ] 4 ndip ;" eval ] must-fail [ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1+ ] 4 ndip ;" (( -- )) eval ] must-fail
MEMO: see-test ( a -- b ) reverse ; MEMO: see-test ( a -- b ) reverse ;
@ -17,7 +17,7 @@ MEMO: see-test ( a -- b ) reverse ;
[ [ \ see-test see ] with-string-writer ] [ [ \ see-test see ] with-string-writer ]
unit-test unit-test
[ ] [ "IN: memoize.tests : fib ( -- ) ;" eval ] unit-test [ ] [ "IN: memoize.tests : fib ( -- ) ;" (( -- )) eval ] unit-test
[ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test [ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test

10
basis/peg/ebnf/ebnf-tests.factor
View File

@ -444,12 +444,12 @@ foo=<foreign any-char> 'd'
"ad" parser4 "ad" parser4
] unit-test ] unit-test
{ t } [ { } [
"USING: kernel peg.ebnf ; \"a\\n\" [EBNF foo='a' '\n' => [[ drop \"\n\" ]] EBNF]" eval drop t "USING: kernel peg.ebnf ; \"a\\n\" [EBNF foo='a' '\n' => [[ drop \"\n\" ]] EBNF] drop" (( -- )) eval
] unit-test ] unit-test
[ [
"USING: peg.ebnf ; <EBNF foo='a' foo='b' EBNF>" eval drop "USING: peg.ebnf ; <EBNF foo='a' foo='b' EBNF>" (( -- )) eval drop
] must-fail ] must-fail
{ t } [ { t } [
@ -521,12 +521,12 @@ Tok = Spaces (Number | Special )
"\\" [EBNF foo="\\" EBNF] "\\" [EBNF foo="\\" EBNF]
] unit-test ] unit-test
[ "USE: peg.ebnf [EBNF EBNF]" eval ] must-fail [ "USE: peg.ebnf [EBNF EBNF]" (( -- )) eval ] must-fail
[ <" USE: peg.ebnf [EBNF [ <" USE: peg.ebnf [EBNF
lol = a lol = a
lol = b lol = b
EBNF] "> eval EBNF] "> (( -- )) eval
] [ ] [
error>> [ redefined-rule? ] [ name>> "lol" = ] bi and error>> [ redefined-rule? ] [ name>> "lol" = ] bi and
] must-fail-with ] must-fail-with

24
basis/prettyprint/prettyprint-tests.factor
View File

@ -90,7 +90,7 @@ unit-test
[ \ blah see ] with-string-writer "\n" ?tail drop 6 tail* [ \ blah see ] with-string-writer "\n" ?tail drop 6 tail*
] unit-test ] unit-test
: check-see ( expect name -- ) : check-see ( expect name -- ? )
[ [
use [ clone ] change use [ clone ] change
@ -105,6 +105,7 @@ unit-test
GENERIC: method-layout ( a -- b ) GENERIC: method-layout ( a -- b )
M: complex method-layout M: complex method-layout
drop
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
; ;
@ -116,8 +117,9 @@ M: object method-layout ;
[ [
{ {
"USING: math prettyprint.tests ;" "USING: kernel math prettyprint.tests ;"
"M: complex method-layout" "M: complex method-layout"
" drop"
" \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\"" " \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\""
" ;" " ;"
"" ""
@ -180,15 +182,15 @@ DEFER: parse-error-file
"string-layout-test" string-layout check-see "string-layout-test" string-layout check-see
] unit-test ] unit-test
: narrow-test ( -- str ) : narrow-test ( -- array )
{ {
"USING: arrays combinators continuations kernel sequences ;" "USING: arrays combinators continuations kernel sequences ;"
"IN: prettyprint.tests" "IN: prettyprint.tests"
": narrow-layout ( obj -- )" ": narrow-layout ( obj1 obj2 -- obj3 )"
" {" " {"
" { [ dup continuation? ] [ append ] }" " { [ dup continuation? ] [ append ] }"
" { [ dup not ] [ drop reverse ] }" " { [ dup not ] [ drop reverse ] }"
" { [ dup pair? ] [ delete ] }" " { [ dup pair? ] [ [ delete ] keep ] }"
" } cond ;" " } cond ;"
} ; } ;
@ -196,7 +198,7 @@ DEFER: parse-error-file
"narrow-layout" narrow-test check-see "narrow-layout" narrow-test check-see
] unit-test ] unit-test
: another-narrow-test ( -- str ) : another-narrow-test ( -- array )
{ {
"IN: prettyprint.tests" "IN: prettyprint.tests"
": another-narrow-layout ( -- obj )" ": another-narrow-layout ( -- obj )"
@ -252,18 +254,14 @@ M: class-see-layout class-see-layout ;
! Regression ! Regression
[ t ] [ [ t ] [
"IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n" "IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
dup eval dup (( -- )) eval
"generic-decl-test" "prettyprint.tests" lookup "generic-decl-test" "prettyprint.tests" lookup
[ see ] with-string-writer = [ see ] with-string-writer =
] unit-test ] unit-test
[ [ + ] ] [ [ [ + ] ] [ [ \ + (step-into-execute) ] (remove-breakpoints) ] unit-test
[ \ + (step-into-execute) ] (remove-breakpoints)
] unit-test
[ [ (step-into-execute) ] ] [ [ [ (step-into-execute) ] ] [ [ (step-into-execute) ] (remove-breakpoints) ] unit-test
[ (step-into-execute) ] (remove-breakpoints)
] unit-test
[ [ 2 2 + . ] ] [ [ [ 2 2 + . ] ] [
[ 2 2 \ + (step-into-execute) . ] (remove-breakpoints) [ 2 2 \ + (step-into-execute) . ] (remove-breakpoints)

2
basis/regexp/parser/parser-tests.factor
View File

@ -4,7 +4,7 @@ IN: regexp.parser.tests
: regexp-parses ( string -- ) : regexp-parses ( string -- )
[ [ ] ] dip '[ _ parse-regexp drop ] unit-test ; [ [ ] ] dip '[ _ parse-regexp drop ] unit-test ;
: regexp-fails ( string -- ) : regexp-fails ( string -- regexp )
'[ _ parse-regexp ] must-fail ; '[ _ parse-regexp ] must-fail ;
{ {

6
basis/regexp/regexp-tests.factor
View File

@ -262,11 +262,11 @@ IN: regexp-tests
! Comment inside a regular expression ! Comment inside a regular expression
[ t ] [ "ac" "a(?#boo)c" <regexp> matches? ] unit-test [ t ] [ "ac" "a(?#boo)c" <regexp> matches? ] unit-test
[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval ] unit-test [ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" (( -- )) eval ] unit-test
[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval ] unit-test [ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" (( -- )) eval ] unit-test
[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval ] unit-test [ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" (( -- )) eval ] unit-test
[ "ab" ] [ "ab" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test [ "ab" ] [ "ab" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
[ "abc" ] [ "abc" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test [ "abc" ] [ "abc" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test

4
basis/stack-checker/stack-checker-tests.factor
View File

@ -524,7 +524,7 @@ ERROR: custom-error ;
{ 2 1 } [ [ + ] inference-invalidation-b ] must-infer-as { 2 1 } [ [ + ] inference-invalidation-b ] must-infer-as
[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- a b ) 1 2 ;" eval ] unit-test [ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- a b ) 1 2 ;" (( -- )) eval ] unit-test
[ 3 ] [ inference-invalidation-c ] unit-test [ 3 ] [ inference-invalidation-c ] unit-test
@ -536,7 +536,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ;
\ inference-invalidation-d must-infer \ inference-invalidation-d must-infer
[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- ) ;" eval ] unit-test [ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- ) ;" (( -- )) eval ] unit-test
[ [ inference-invalidation-d ] infer ] must-fail [ [ inference-invalidation-d ] infer ] must-fail

4
basis/tools/annotations/annotations-tests.factor
View File

@ -18,7 +18,7 @@ M: integer some-generic 1+ ;
[ 4 ] [ 3 some-generic ] unit-test [ 4 ] [ 3 some-generic ] unit-test
[ ] [ "IN: tools.annotations.tests USE: math M: integer some-generic 1- ;" eval ] unit-test [ ] [ "IN: tools.annotations.tests USE: math M: integer some-generic 1- ;" (( -- )) eval ] unit-test
[ 2 ] [ 3 some-generic ] unit-test [ 2 ] [ 3 some-generic ] unit-test
@ -33,7 +33,7 @@ M: object another-generic ;
\ another-generic watch \ another-generic watch
[ ] [ "IN: tools.annotations.tests GENERIC: another-generic ( a -- b )" eval ] unit-test [ ] [ "IN: tools.annotations.tests GENERIC: another-generic ( a -- b )" (( -- )) eval ] unit-test
[ ] [ \ another-generic reset ] unit-test [ ] [ \ another-generic reset ] unit-test