tools.crossref grouping sets ;
IN: parser.tests
-[ 1 [ 2 [ 3 ] 4 ] 5 ]
+{ 1 [ 2 [ 3 ] 4 ] 5 }
[ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval( -- a b c ) ]
unit-test
-[ t t f f ]
+{ t t f f }
[ "t t f f" eval( -- ? ? ? ? ) ]
unit-test
-[ "hello world" ]
+{ "hello world" }
[ "\"hello world\"" eval( -- string ) ]
unit-test
-[ "\n\r\t\\" ]
+{ "\n\r\t\\" }
[ "\"\\n\\r\\t\\\\\"" eval( -- string ) ]
unit-test
-[ "hello world" ]
+{ "hello world" }
[
"""#!/usr/bin/env factor
"hello world" """ eval( -- string )
] unit-test
-[ "hello world" ]
+{ "hello world" }
[
"IN: parser.tests : hello ( -- str ) \"hello world\" ;"
eval( -- ) "USE: parser.tests hello" eval( -- string )
[ "IN: parser.tests : 123 ( -- n ) 123 ;" eval( -- ) ]
[ error>> invalid-word-name? ] must-fail-with
-[ ]
+{ }
[ "! This is a comment, people." eval( -- ) ]
unit-test
! Test escapes
-[ " " ]
+{ " " }
[ "\"\\u000020\"" eval( -- string ) ]
unit-test
-[ "'" ]
+{ "'" }
[ "\"\\u000027\"" eval( -- string ) ]
unit-test
! Test EOL comments in multiline strings.
-[ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
+{ "Hello" } [ "#! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
-[ word ] [ \ f class-of ] unit-test
+{ word } [ \ f class-of ] unit-test
! Test stack effect parsing
: effect-parsing-test ( a b -- c ) + ;
-[ t ] [
+{ t } [
"effect-parsing-test" "parser.tests" lookup-word
\ effect-parsing-test eq?
] unit-test
-[ T{ effect f { "a" "b" } { "c" } f } ]
+{ T{ effect f { "a" "b" } { "c" } f } }
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test
: baz ( a b -- * ) 2array throw ;
-[ t ]
+{ t }
[ \ baz "declared-effect" word-prop terminated?>> ]
unit-test
-[ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
+{ } [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
-[ t ] [
+{ t } [
"effect-parsing-test" "parser.tests" lookup-word
\ effect-parsing-test eq?
] unit-test
-[ T{ effect f { "a" "b" } { "d" } f } ]
+{ T{ effect f { "a" "b" } { "d" } f } }
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test
[ "IN: parser.tests : missing-- ( a b ) ;" eval( -- ) ] must-fail
! Funny bug
-[ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test
+{ 2 } [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test
DEFER: foo
"IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval( -- )
-[ ] [ "USE: parser.tests foo" eval( -- ) ] unit-test
+{ } [ "USE: parser.tests foo" eval( -- ) ] unit-test
"IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval( -- )
-[ t ] [
+{ t } [
"USE: parser.tests \\ foo" eval( -- word )
"foo" "parser.tests" lookup-word eq?
] unit-test
! Test smudging
-[ 1 ] [
+{ 1 } [
"IN: parser.tests : smudge-me ( -- ) ;" <string-reader> "foo"
parse-stream drop
"foo" source-file definitions>> first cardinality
] unit-test
-[ t ] [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
-[ ] [
+{ } [
"IN: parser.tests : smudge-me-more ( -- ) ;" <string-reader> "foo"
parse-stream drop
] unit-test
-[ t ] [ "smudge-me-more" "parser.tests" lookup-word >boolean ] unit-test
-[ f ] [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "smudge-me-more" "parser.tests" lookup-word >boolean ] unit-test
+{ f } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
-[ 3 ] [
+{ 3 } [
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
parse-stream drop
"foo" source-file definitions>> first cardinality
] unit-test
-[ 1 ] [
+{ 1 } [
"IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
parse-stream drop
"bar" source-file definitions>> first cardinality
] unit-test
-[ 2 ] [
+{ 2 } [
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" <string-reader> "foo"
parse-stream drop
"foo" source-file definitions>> first cardinality
] unit-test
-[ t ] [
+{ t } [
array "smudge-me" "parser.tests" lookup-word order member-eq?
] unit-test
-[ t ] [
+{ t } [
integer "smudge-me" "parser.tests" lookup-word order member-eq?
] unit-test
-[ f ] [
+{ f } [
string "smudge-me" "parser.tests" lookup-word order member-eq?
] unit-test
-[ ] [
+{ } [
"IN: parser.tests USE: math 2 2 +" <string-reader> "a"
parse-stream drop
] unit-test
-[ t ] [
+{ t } [
"a" <pathname> \ + usage member?
] unit-test
-[ ] [
+{ } [
"IN: parser.tests USE: math 2 2 -" <string-reader> "a"
parse-stream drop
] unit-test
-[ f ] [
+{ f } [
"a" <pathname> \ + usage member?
] unit-test
-[ ] [
+{ } [
"a" source-files get delete-at
2 [
"IN: parser.tests DEFER: x : y ( -- ) x ; : x ( -- ) y ;"
<string-reader> "a" parse-stream
] [ source-file-error? ] must-fail-with
-[ t ] [
+{ t } [
"y" "parser.tests" lookup-word >boolean
] unit-test
-[ f ] [
+{ f } [
"IN: parser.tests : x ( -- ) ;"
<string-reader> "a" parse-stream drop
"y" "parser.tests" lookup-word
] unit-test
! Test new forward definition logic
-[ ] [
+{ } [
"IN: axx : axx ( -- ) ;"
<string-reader> "axx" parse-stream drop
] unit-test
-[ ] [
+{ } [
"USE: axx IN: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;"
<string-reader> "bxx" parse-stream drop
] unit-test
! So we move the bxx word to axx...
-[ ] [
+{ } [
"IN: axx : axx ( -- ) ; : bxx ( -- ) ;"
<string-reader> "axx" parse-stream drop
] unit-test
-[ t ] [ "bxx" "axx" lookup-word >boolean ] unit-test
+{ t } [ "bxx" "axx" lookup-word >boolean ] unit-test
! And reload the file that uses it...
-[ ] [
+{ } [
"USE: axx IN: bxx ( -- ) : cxx ( -- ) axx bxx ;"
<string-reader> "bxx" parse-stream drop
] unit-test
! Turning a generic into a non-generic could cause all
! kinds of funnyness
-[ ] [
+{ } [
"IN: ayy USE: kernel GENERIC: ayy ( a -- b ) M: object ayy ;"
<string-reader> "ayy" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: ayy USE: kernel : ayy ( -- ) ;"
<string-reader> "ayy" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b )"
<string-reader> "azz" parse-stream drop
] unit-test
-[ ] [
+{ } [
"USE: azz M: my-class a-generic ;"
<string-reader> "azz-2" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: azz GENERIC: a-generic ( a -- b )"
<string-reader> "azz" parse-stream drop
] unit-test
-[ ] [
+{ } [
"USE: azz USE: math M: integer a-generic ;"
<string-reader> "azz-2" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- error ) <bogus-error> ;"
<string-reader> "bogus-error" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- error ) <bogus-error> ;"
<string-reader> "bogus-error" parse-stream drop
] unit-test
! Problems with class predicates -vs- ordinary words
-[ ] [
+{ } [
"IN: parser.tests TUPLE: killer ;"
<string-reader> "removing-the-predicate" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: parser.tests GENERIC: killer? ( a -- b )"
<string-reader> "removing-the-predicate" parse-stream drop
] unit-test
-[ t ] [
+{ t } [
"killer?" "parser.tests" lookup-word >boolean
] unit-test
<string-reader> "redefining-a-class-1" parse-stream
] [ error>> error>> error>> redefine-error? ] must-fail-with
-[ ] [
+{ } [
"IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test"
<string-reader> "redefining-a-class-2" parse-stream drop
] unit-test
<string-reader> "redefining-a-class-3" parse-stream drop
] [ error>> error>> error>> redefine-error? ] must-fail-with
-[ ] [
+{ } [
"IN: parser.tests TUPLE: class-fwd-test ;"
<string-reader> "redefining-a-class-3" parse-stream drop
] unit-test
<string-reader> "redefining-a-class-3" parse-stream drop
] [ error>> error>> error>> no-word-error? ] must-fail-with
-[ ] [
+{ } [
"IN: parser.tests TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
<string-reader> "redefining-a-class-3" parse-stream drop
] unit-test
<string-reader> "redefining-a-class-4" parse-stream drop
] [ error>> error>> error>> redefine-error? ] must-fail-with
-[ ] [
+{ } [
"IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval( -- )
] unit-test
"IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval( -- )
] must-fail
-[ ] [
+{ } [
"IN: parser.tests USE: kernel PREDICATE: foo < object ;" eval( -- )
] unit-test
-[ t ] [
+{ t } [
"foo" "parser.tests" lookup-word last-word eq?
] unit-test
-[ ] [
+{ } [
[
"redefining-a-class-5" forget-source
"redefining-a-class-6" forget-source
] unit-test
] times
-[ ] [
+{ } [
[ "this-better-not-exist" forget-vocab ] with-compilation-unit
] unit-test
[ ": foo ;" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with
-[ 92 ] [ "CHAR: \\" eval( -- n ) ] unit-test
-[ 92 ] [ "CHAR: \\\\" eval( -- n ) ] unit-test
+{ 92 } [ "CHAR: \\" eval( -- n ) ] unit-test
+{ 92 } [ "CHAR: \\\\" eval( -- n ) ] unit-test
-[ ] [
+{ } [
{
"IN: parser.tests"
"USING: math arrays kernel ;"
} "\n" join <string-reader> "change-combination-test" parse-stream drop
] unit-test
-[ ] [
+{ } [
{
"IN: parser.tests"
"USING: math arrays kernel ;"
} "\n" join <string-reader> "change-combination-test" parse-stream drop
] unit-test
-[ 2 ] [
+{ 2 } [
"change-combination" "parser.tests" lookup-word
"methods" word-prop assoc-size
] unit-test
-[ ] [
+{ } [
2 [
"IN: parser.tests DEFER: twice-fails FORGET: twice-fails MIXIN: twice-fails"
<string-reader> "twice-fails-test" parse-stream drop
] times
] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests : staging-problem-test-1 ( -- a ) 1 ; : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
<string-reader> "staging-problem-test" parse-stream
] unit-test
-[ t ] [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
-[ t ] [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests << : staging-problem-test-1 ( -- a ) 1 ; >> : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
<string-reader> "staging-problem-test" parse-stream
] unit-test
-[ t ] [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
-[ t ] [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
[ "DEFER: blahy" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with
SYMBOLS: a b c ;
-[ a ] [ a ] unit-test
-[ b ] [ b ] unit-test
-[ c ] [ c ] unit-test
+{ a } [ a ] unit-test
+{ b } [ b ] unit-test
+{ c } [ c ] unit-test
DEFER: blah
-[ ] [ "IN: parser.tests GENERIC: blah ( -- )" eval( -- ) ] unit-test
-[ ] [ "IN: parser.tests SYMBOLS: blah ;" eval( -- ) ] unit-test
+{ } [ "IN: parser.tests GENERIC: blah ( -- )" eval( -- ) ] unit-test
+{ } [ "IN: parser.tests SYMBOLS: blah ;" eval( -- ) ] unit-test
-[ f ] [ \ blah generic? ] unit-test
-[ t ] [ \ blah symbol? ] unit-test
+{ f } [ \ blah generic? ] unit-test
+{ t } [ \ blah symbol? ] unit-test
DEFER: blah1
QUALIFIED: qualified.tests.foo
QUALIFIED: qualified.tests.bar
-[ 1 2 3 ] [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test
+{ 1 2 3 } [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test
QUALIFIED-WITH: qualified.tests.bar p
-[ 2 ] [ p:x ] unit-test
+{ 2 } [ p:x ] unit-test
RENAME: x qualified.tests.baz => y
-[ 3 ] [ y ] unit-test
+{ 3 } [ y ] unit-test
FROM: qualified.tests.baz => x ;
-[ 3 ] [ x ] unit-test
-[ 3 ] [ y ] unit-test
+{ 3 } [ x ] unit-test
+{ 3 } [ y ] unit-test
EXCLUDE: qualified.tests.bar => x ;
-[ 3 ] [ x ] unit-test
-[ 4 ] [ y ] unit-test
+{ 3 } [ x ] unit-test
+{ 4 } [ y ] unit-test
! Two similar bugs
! Replace : def with something in << >>
-/* [ [ ] ] [
+/* { [ ] } [
"IN: parser.tests : was-once-a-word-bug ( -- ) ;"
<string-reader> "was-once-a-word-test" parse-stream
] unit-test
-[ t ] [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests USE: words << \"was-once-a-word-bug\" \"parser.tests\" create-word [ ] ( -- ) define-declared >>"
<string-reader> "was-once-a-word-test" parse-stream
] unit-test
-[ t ] [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test */
+{ t } [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test */
! Replace : def with DEFER:
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests : is-not-deferred ( -- ) ;"
<string-reader> "is-not-deferred" parse-stream
] unit-test
-[ t ] [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
-[ f ] [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
+{ t } [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
+{ f } [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests DEFER: is-not-deferred"
<string-reader> "is-not-deferred" parse-stream
] unit-test
-[ t ] [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
-[ t ] [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
+{ t } [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
! Forward-reference resolution case iterated using list in the wrong direction
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests.forward-ref-1 DEFER: x DEFER: y"
<string-reader> "forward-ref-1" parse-stream
] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests.forward-ref-2 DEFER: x DEFER: y"
<string-reader> "forward-ref-2" parse-stream
] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests.forward-ref-3 FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; : z ( -- ) x y ;"
<string-reader> "forward-ref-3" parse-stream
] unit-test
-[ t ] [
+{ t } [
"z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
] unit-test
-[ [ ] ] [
+{ [ ] } [
"FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; IN: parser.tests.forward-ref-3 : x ( -- ) ; : z ( -- ) x y ;"
<string-reader> "forward-ref-3" parse-stream
] unit-test
-[ f ] [
+{ f } [
"z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests.forward-ref-3 FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; : z ( -- ) x y ;"
<string-reader> "forward-ref-3" parse-stream
] unit-test
-[ t ] [
+{ t } [
"z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
] unit-test
-[ [ dup ] ] [
+{ [ dup ] } [
"USE: kernel dup" <string-reader> "unuse-test" parse-stream
] unit-test
"USE: kernel UNUSE: kernel dup" <string-reader> "unuse-test" parse-stream
] [ error>> error>> error>> no-word-error? ] must-fail-with
-[ ] [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test
+{ } [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test
[
[ "vocabs.loader.test.l" use-vocab ] must-fail
projects / factor.git / blobdiff