fixing compiler errors in basis
Doug Coleman
parent
aad6a3d504
commit
dba4c0d589
|
|
@ -12,7 +12,7 @@ IN: compiler.tests
|
|||
IN: compiler.tests.folding
|
||||
GENERIC: foldable-generic ( a -- b ) foldable
|
||||
M: integer foldable-generic f <array> ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
@ -20,7 +20,7 @@ IN: compiler.tests
|
|||
USING: math arrays ;
|
||||
IN: compiler.tests.folding
|
||||
: fold-test ( -- x ) 10 foldable-generic ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ M: integer method-redefine-generic-1 3 + ;
|
|||
|
||||
[ 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
|
||||
|
||||
|
|
@ -27,7 +27,7 @@ M: integer method-redefine-generic-2 3 + ;
|
|||
|
||||
[ 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
|
||||
|
||||
|
|
@ -43,10 +43,10 @@ M: integer method-redefine-generic-2 3 + ;
|
|||
|
||||
[ t ] [ \ hey 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 ] [ \ there optimized>> ] unit-test
|
||||
[ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test
|
||||
[ ] [ "IN: compiler.tests : hey ( -- ) ;" (( -- )) eval ] unit-test
|
||||
[ t ] [ \ there optimized>> ] unit-test
|
||||
|
||||
: good ( -- ) ;
|
||||
|
|
@ -59,7 +59,7 @@ M: integer method-redefine-generic-2 3 + ;
|
|||
|
||||
[ 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 ] [ \ bad optimized>> ] unit-test
|
||||
|
|
@ -67,7 +67,7 @@ M: integer method-redefine-generic-2 3 + ;
|
|||
|
||||
[ 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 ] [ \ bad optimized>> ] unit-test
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ IN: compiler.tests
|
|||
MIXIN: my-mixin
|
||||
INSTANCE: fixnum my-mixin
|
||||
: my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
@ -21,7 +21,7 @@ IN: compiler.tests
|
|||
USE: math
|
||||
IN: compiler.tests.redefine10
|
||||
INSTANCE: float my-mixin
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ 2.0 ] [
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ IN: compiler.tests
|
|||
M: my-mixin my-generic drop 0 ;
|
||||
M: object my-generic drop 1 ;
|
||||
: my-inline ( -- b ) { } my-generic ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
|
|||
|
|
@ -15,6 +15,6 @@ M: object g drop t ;
|
|||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ arrays words assocs eval words.symbol ;
|
|||
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ M: empty-mixin sheeple drop "wake up" ;
|
|||
[ 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
|
||||
|
||||
[ ] [ "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
|
||||
[ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
|
||||
|
|
|
|||
|
|
@ -7,6 +7,6 @@ USING: io.streams.string kernel tools.test eval ;
|
|||
|
||||
[ "" ] [ [ 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
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ IN: compiler.tests
|
|||
GENERIC: my-generic ( a -- b )
|
||||
M: object my-generic [ <=> ] sort ;
|
||||
: my-inline ( a -- b ) my-generic ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
@ -23,7 +23,7 @@ IN: compiler.tests
|
|||
IN: compiler.tests.redefine5
|
||||
TUPLE: my-tuple ;
|
||||
M: my-tuple my-generic drop 0 ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ 0 ] [
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ IN: compiler.tests
|
|||
MIXIN: my-mixin
|
||||
M: my-mixin my-generic drop 0 ;
|
||||
: my-inline ( a -- b ) { my-mixin } declare my-generic ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
@ -24,7 +24,7 @@ IN: compiler.tests
|
|||
TUPLE: my-tuple ;
|
||||
M: my-tuple my-generic drop 1 ;
|
||||
INSTANCE: my-tuple my-mixin
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ 1 ] [
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ IN: compiler.tests
|
|||
MIXIN: my-mixin
|
||||
INSTANCE: fixnum my-mixin
|
||||
: my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
@ -21,7 +21,7 @@ IN: compiler.tests
|
|||
USE: math
|
||||
IN: compiler.tests.redefine7
|
||||
INSTANCE: float my-mixin
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ 2.0 ] [
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ IN: compiler.tests
|
|||
! We add the bogus quotation here to hinder inlining
|
||||
! since otherwise we cannot trigger this bug.
|
||||
M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
@ -24,7 +24,7 @@ IN: compiler.tests
|
|||
USE: math
|
||||
IN: compiler.tests.redefine8
|
||||
INSTANCE: float my-mixin
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ 2.0 ] [
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ IN: compiler.tests
|
|||
! We add the bogus quotation here to hinder inlining
|
||||
! since otherwise we cannot trigger this bug.
|
||||
M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
@ -25,7 +25,7 @@ IN: compiler.tests
|
|||
IN: compiler.tests.redefine9
|
||||
TUPLE: my-tuple ;
|
||||
INSTANCE: my-tuple my-mixin
|
||||
"> eval
|
||||
"> (( -- )) eval
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
|
|||
|
|
@ -237,6 +237,6 @@ M: f single-combination-test-2 single-combination-test-4 ;
|
|||
10 [
|
||||
[ "compiler.tests.foo" forget-vocab ] with-compilation-unit
|
||||
[ 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
|
||||
] times
|
||||
|
|
|
|||
|
|
@ -197,7 +197,7 @@ M: fixnum annotate-entry-test-1 drop ;
|
|||
[ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2)
|
||||
] 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 ] [
|
||||
[ { bignum } declare annotate-entry-test-2 ]
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ sequences accessors tools.test kernel math ;
|
|||
|
||||
[ 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? ] find nip child>> first in-d>> length ;
|
||||
|
|
@ -34,18 +34,18 @@ sequences accessors tools.test kernel math ;
|
|||
[ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test
|
||||
|
||||
DEFER: bbb
|
||||
: aaa ( x -- ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive
|
||||
: bbb ( x -- ) [ drop 0 ] dip aaa ; inline recursive
|
||||
: aaa ( obj x -- obj ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive
|
||||
: bbb ( obj x -- obj ) [ drop 0 ] dip aaa ; inline recursive
|
||||
|
||||
[ ] [ [ bbb ] test-normalization ] unit-test
|
||||
|
||||
: ccc ( -- ) ccc drop 1 ; inline recursive
|
||||
: ccc ( obj -- 1 ) ccc drop 1 ; inline recursive
|
||||
|
||||
[ ] [ [ ccc ] test-normalization ] unit-test
|
||||
|
||||
DEFER: eee
|
||||
: ddd ( -- ) eee ; inline recursive
|
||||
: eee ( -- ) swap ddd ; inline recursive
|
||||
: ddd ( a b -- a b ) eee ; inline recursive
|
||||
: eee ( a b -- a b ) swap ddd ; inline recursive
|
||||
|
||||
[ ] [ [ eee ] test-normalization ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -680,7 +680,7 @@ TUPLE: littledan-2 { from read-only } { to read-only } ;
|
|||
: (littledan-3-test) ( x -- )
|
||||
length 1+ f <array> (littledan-3-test) ; inline recursive
|
||||
|
||||
: littledan-3-test ( x -- )
|
||||
: littledan-3-test ( -- )
|
||||
0 f <array> (littledan-3-test) ; inline
|
||||
|
||||
[ ] [ [ littledan-3-test ] final-classes drop ] unit-test
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ compiler.tree.combinators ;
|
|||
\ (each-integer) label-is-loop?
|
||||
] unit-test
|
||||
|
||||
: loop-test-2 ( a -- )
|
||||
: loop-test-2 ( a b -- a' )
|
||||
dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline recursive
|
||||
|
||||
[ t ] [
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ M: hello bing hello-test ;
|
|||
[ 3 ] [ 1 0 <hello> 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{ } ] [ bee protocol-consult ] unit-test
|
||||
|
||||
|
|
@ -63,22 +63,22 @@ CONSULT: beta hey value>> 1- ;
|
|||
[ 0 ] [ 1 <hey> three ] unit-test
|
||||
[ { hey } ] [ alpha 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 \ 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 } ] [ beta protocol-users ] unit-test
|
||||
[ 2 ] [ 1 <hey> one ] unit-test
|
||||
[ 0 ] [ 1 <hey> two ] unit-test
|
||||
[ 0 ] [ 1 <hey> three ] 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
|
||||
[ -1 ] [ 1 <hey> two ] unit-test
|
||||
[ -1 ] [ 1 <hey> three ] 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
|
||||
|
||||
TUPLE: slot-protocol-test-1 a b ;
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@ sequences eval accessors ;
|
|||
3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
|
||||
] 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
|
||||
|
||||
[ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ definitions assocs sequences kernel namespaces parser arrays
|
|||
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
|
||||
|
||||
[ $subsection ] [
|
||||
|
|
@ -23,7 +23,7 @@ io.streams.string continuations debugger compiler.units eval ;
|
|||
] 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
|
||||
|
||||
[ ] [
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ IN: help.definitions.tests
|
|||
"hello" "help.definitions.tests" lookup "help" word-prop
|
||||
] 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
|
||||
|
||||
|
|
|
|||
|
|
@ -4,12 +4,12 @@ IN: help.syntax.tests
|
|||
|
||||
[
|
||||
[ "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
|
||||
] unit-test
|
||||
|
||||
[ { "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
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ SYMBOL: foo
|
|||
} "\n" join
|
||||
[
|
||||
"testfile" source-file file set
|
||||
eval
|
||||
(( -- )) eval
|
||||
] with-scope
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ SYNTAX: hello "Hi" print ;
|
|||
"\\ + 1 2 3 4" parse-interactive
|
||||
"cont" get continue-with
|
||||
] ignore-errors
|
||||
"USE: debugger :1" eval
|
||||
"USE: debugger :1" (( -- quot )) eval
|
||||
] callcc1
|
||||
] unit-test
|
||||
] 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
|
||||
] unit-test
|
||||
] with-file-vocabs
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
[ ] [ new-definition eval ] unit-test
|
||||
[ ] [ new-definition (( -- )) eval ] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ \ 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 _ + ] ]"
|
||||
eval call
|
||||
(( -- )) eval call
|
||||
] [ error>> >r/r>-in-fry-error? ] must-fail-with
|
||||
|
||||
:: (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
|
||||
|
||||
! 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 | a" eval ] [ error>> unexpected-eof? ] must-fail-with
|
||||
[ "USE: locals [|" 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 [|" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with
|
||||
|
||||
[ 25 ] [ 5 [| a | { [ a sq ] } cond ] 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
|
||||
|
||||
[ "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
|
||||
|
||||
|
|
|
|||
|
|
@ -13,11 +13,11 @@ unit-test
|
|||
[ t ] [ \ see-test macro? ] unit-test
|
||||
|
||||
[ 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 =
|
||||
] 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
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ MEMO: fib ( m -- n )
|
|||
|
||||
[ 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 ;
|
||||
|
||||
|
|
@ -17,7 +17,7 @@ MEMO: see-test ( a -- b ) reverse ;
|
|||
[ [ \ see-test see ] with-string-writer ]
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -444,12 +444,12 @@ foo=<foreign any-char> 'd'
|
|||
"ad" parser4
|
||||
] 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
|
||||
|
||||
[
|
||||
"USING: peg.ebnf ; <EBNF foo='a' foo='b' EBNF>" eval drop
|
||||
"USING: peg.ebnf ; <EBNF foo='a' foo='b' EBNF>" (( -- )) eval drop
|
||||
] must-fail
|
||||
|
||||
{ t } [
|
||||
|
|
@ -521,12 +521,12 @@ Tok = Spaces (Number | Special )
|
|||
"\\" [EBNF foo="\\" EBNF]
|
||||
] unit-test
|
||||
|
||||
[ "USE: peg.ebnf [EBNF EBNF]" eval ] must-fail
|
||||
[ "USE: peg.ebnf [EBNF EBNF]" (( -- )) eval ] must-fail
|
||||
|
||||
[ <" USE: peg.ebnf [EBNF
|
||||
lol = a
|
||||
lol = b
|
||||
EBNF] "> eval
|
||||
EBNF] "> (( -- )) eval
|
||||
] [
|
||||
error>> [ redefined-rule? ] [ name>> "lol" = ] bi and
|
||||
] must-fail-with
|
||||
|
|
|
|||
|
|
@ -90,7 +90,7 @@ unit-test
|
|||
[ \ blah see ] with-string-writer "\n" ?tail drop 6 tail*
|
||||
] unit-test
|
||||
|
||||
: check-see ( expect name -- )
|
||||
: check-see ( expect name -- ? )
|
||||
[
|
||||
use [ clone ] change
|
||||
|
||||
|
|
@ -105,6 +105,7 @@ unit-test
|
|||
GENERIC: method-layout ( a -- b )
|
||||
|
||||
M: complex method-layout
|
||||
drop
|
||||
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
|
||||
;
|
||||
|
||||
|
|
@ -116,8 +117,9 @@ M: object method-layout ;
|
|||
|
||||
[
|
||||
{
|
||||
"USING: math prettyprint.tests ;"
|
||||
"USING: kernel math prettyprint.tests ;"
|
||||
"M: complex method-layout"
|
||||
" drop"
|
||||
" \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\""
|
||||
" ;"
|
||||
""
|
||||
|
|
@ -180,15 +182,15 @@ DEFER: parse-error-file
|
|||
"string-layout-test" string-layout check-see
|
||||
] unit-test
|
||||
|
||||
: narrow-test ( -- str )
|
||||
: narrow-test ( -- array )
|
||||
{
|
||||
"USING: arrays combinators continuations kernel sequences ;"
|
||||
"IN: prettyprint.tests"
|
||||
": narrow-layout ( obj -- )"
|
||||
": narrow-layout ( obj1 obj2 -- obj3 )"
|
||||
" {"
|
||||
" { [ dup continuation? ] [ append ] }"
|
||||
" { [ dup not ] [ drop reverse ] }"
|
||||
" { [ dup pair? ] [ delete ] }"
|
||||
" { [ dup pair? ] [ [ delete ] keep ] }"
|
||||
" } cond ;"
|
||||
} ;
|
||||
|
||||
|
|
@ -196,7 +198,7 @@ DEFER: parse-error-file
|
|||
"narrow-layout" narrow-test check-see
|
||||
] unit-test
|
||||
|
||||
: another-narrow-test ( -- str )
|
||||
: another-narrow-test ( -- array )
|
||||
{
|
||||
"IN: prettyprint.tests"
|
||||
": another-narrow-layout ( -- obj )"
|
||||
|
|
@ -252,18 +254,14 @@ M: class-see-layout class-see-layout ;
|
|||
! Regression
|
||||
[ t ] [
|
||||
"IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
|
||||
dup eval
|
||||
dup (( -- )) eval
|
||||
"generic-decl-test" "prettyprint.tests" lookup
|
||||
[ see ] with-string-writer =
|
||||
] unit-test
|
||||
|
||||
[ [ + ] ] [
|
||||
[ \ + (step-into-execute) ] (remove-breakpoints)
|
||||
] unit-test
|
||||
[ [ + ] ] [ [ \ + (step-into-execute) ] (remove-breakpoints) ] unit-test
|
||||
|
||||
[ [ (step-into-execute) ] ] [
|
||||
[ (step-into-execute) ] (remove-breakpoints)
|
||||
] unit-test
|
||||
[ [ (step-into-execute) ] ] [ [ (step-into-execute) ] (remove-breakpoints) ] unit-test
|
||||
|
||||
[ [ 2 2 + . ] ] [
|
||||
[ 2 2 \ + (step-into-execute) . ] (remove-breakpoints)
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ IN: regexp.parser.tests
|
|||
: regexp-parses ( string -- )
|
||||
[ [ ] ] dip '[ _ parse-regexp drop ] unit-test ;
|
||||
|
||||
: regexp-fails ( string -- )
|
||||
: regexp-fails ( string -- regexp )
|
||||
'[ _ parse-regexp ] must-fail ;
|
||||
|
||||
{
|
||||
|
|
|
|||
|
|
@ -262,11 +262,11 @@ IN: regexp-tests
|
|||
! Comment inside a regular expression
|
||||
[ 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
|
||||
[ "abc" ] [ "abc" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
|
||||
|
|
|
|||
|
|
@ -524,7 +524,7 @@ ERROR: custom-error ;
|
|||
|
||||
{ 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
|
||||
|
||||
|
|
@ -536,7 +536,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ;
|
|||
|
||||
\ 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
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ M: integer some-generic 1+ ;
|
|||
|
||||
[ 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
|
||||
|
||||
|
|
@ -33,7 +33,7 @@ M: object another-generic ;
|
|||
|
||||
\ 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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue