lexer: each-token and map-tokens did not handle EOF properly
Slava Pestov
parent
63c7513e2d
commit
a566d8cc6b
|
|
@ -86,8 +86,7 @@ M: lexer skip-word ( lexer -- )
|
||||||
|
|
||||||
: scan ( -- str/f ) lexer get parse-token ;
|
: scan ( -- str/f ) lexer get parse-token ;
|
||||||
|
|
||||||
PREDICATE: unexpected-eof < unexpected
|
PREDICATE: unexpected-eof < unexpected got>> not ;
|
||||||
got>> not ;
|
|
||||||
|
|
||||||
: unexpected-eof ( word -- * ) f unexpected ;
|
: unexpected-eof ( word -- * ) f unexpected ;
|
||||||
|
|
||||||
|
|
@ -97,14 +96,15 @@ PREDICATE: unexpected-eof < unexpected
|
||||||
[ unexpected-eof ]
|
[ unexpected-eof ]
|
||||||
if* ;
|
if* ;
|
||||||
|
|
||||||
: (each-token) ( end quot -- pred quot )
|
|
||||||
[ [ [ scan dup ] ] dip [ = not ] curry [ [ f ] if* ] curry compose ] dip ; inline
|
|
||||||
|
|
||||||
: each-token ( ... end quot: ( ... token -- ... ) -- ... )
|
: each-token ( ... end quot: ( ... token -- ... ) -- ... )
|
||||||
(each-token) while drop ; inline
|
[ scan ] 2dip {
|
||||||
|
{ [ 2over = ] [ 3drop ] }
|
||||||
|
{ [ pick not ] [ drop unexpected-eof ] }
|
||||||
|
[ [ nip call ] [ each-token ] 2bi ]
|
||||||
|
} cond ; inline recursive
|
||||||
|
|
||||||
: map-tokens ( ... end quot: ( ... token -- ... elt ) -- ... seq )
|
: map-tokens ( ... end quot: ( ... token -- ... elt ) -- ... seq )
|
||||||
(each-token) produce nip ; inline
|
collector [ each-token ] dip ; inline
|
||||||
|
|
||||||
: parse-tokens ( end -- seq )
|
: parse-tokens ( end -- seq )
|
||||||
[ ] map-tokens ;
|
[ ] map-tokens ;
|
||||||
|
|
@ -112,6 +112,7 @@ PREDICATE: unexpected-eof < unexpected
|
||||||
TUPLE: lexer-error line column line-text parsing-words error ;
|
TUPLE: lexer-error line column line-text parsing-words error ;
|
||||||
|
|
||||||
M: lexer-error error-file error>> error-file ;
|
M: lexer-error error-file error>> error-file ;
|
||||||
|
|
||||||
M: lexer-error error-line [ error>> error-line ] [ line>> ] bi or ;
|
M: lexer-error error-line [ error>> error-line ] [ line>> ] bi or ;
|
||||||
|
|
||||||
: <lexer-error> ( msg -- error )
|
: <lexer-error> ( msg -- error )
|
||||||
|
|
|
||||||
|
|
@ -7,332 +7,334 @@ vocabs.parser words.symbol multiline source-files.errors
|
||||||
tools.crossref grouping ;
|
tools.crossref grouping ;
|
||||||
IN: parser.tests
|
IN: parser.tests
|
||||||
|
|
||||||
|
[ 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" eval( -- ? ? ? ? ) ]
|
||||||
|
unit-test
|
||||||
|
|
||||||
|
[ "hello world" ]
|
||||||
|
[ "\"hello world\"" eval( -- string ) ]
|
||||||
|
unit-test
|
||||||
|
|
||||||
|
[ "\n\r\t\\" ]
|
||||||
|
[ "\"\\n\\r\\t\\\\\"" eval( -- string ) ]
|
||||||
|
unit-test
|
||||||
|
|
||||||
|
[ "hello world" ]
|
||||||
[
|
[
|
||||||
[ 1 [ 2 [ 3 ] 4 ] 5 ]
|
"IN: parser.tests : hello ( -- str ) \"hello world\" ;"
|
||||||
[ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval( -- a b c ) ]
|
eval( -- ) "USE: parser.tests hello" eval( -- string )
|
||||||
unit-test
|
] unit-test
|
||||||
|
|
||||||
[ t t f f ]
|
[ ]
|
||||||
[ "t t f f" eval( -- ? ? ? ? ) ]
|
[ "! This is a comment, people." eval( -- ) ]
|
||||||
unit-test
|
unit-test
|
||||||
|
|
||||||
[ "hello world" ]
|
! Test escapes
|
||||||
[ "\"hello world\"" eval( -- string ) ]
|
|
||||||
unit-test
|
|
||||||
|
|
||||||
[ "\n\r\t\\" ]
|
[ " " ]
|
||||||
[ "\"\\n\\r\\t\\\\\"" eval( -- string ) ]
|
[ "\"\\u000020\"" eval( -- string ) ]
|
||||||
unit-test
|
unit-test
|
||||||
|
|
||||||
[ "hello world" ]
|
[ "'" ]
|
||||||
[
|
[ "\"\\u000027\"" eval( -- string ) ]
|
||||||
"IN: parser.tests : hello ( -- str ) \"hello world\" ;"
|
unit-test
|
||||||
eval( -- ) "USE: parser.tests hello" eval( -- string )
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ]
|
! Test EOL comments in multiline strings.
|
||||||
[ "! This is a comment, people." eval( -- ) ]
|
[ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
|
||||||
unit-test
|
|
||||||
|
|
||||||
! Test escapes
|
[ word ] [ \ f class ] unit-test
|
||||||
|
|
||||||
[ " " ]
|
! Test stack effect parsing
|
||||||
[ "\"\\u000020\"" eval( -- string ) ]
|
|
||||||
unit-test
|
|
||||||
|
|
||||||
[ "'" ]
|
: effect-parsing-test ( a b -- c ) + ;
|
||||||
[ "\"\\u000027\"" eval( -- string ) ]
|
|
||||||
unit-test
|
|
||||||
|
|
||||||
! Test EOL comments in multiline strings.
|
[ t ] [
|
||||||
[ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
|
"effect-parsing-test" "parser.tests" lookup
|
||||||
|
\ effect-parsing-test eq?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[ word ] [ \ f class ] unit-test
|
[ T{ effect f { "a" "b" } { "c" } f } ]
|
||||||
|
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test
|
||||||
|
|
||||||
! Test stack effect parsing
|
: baz ( a b -- * ) 2array throw ;
|
||||||
|
|
||||||
: effect-parsing-test ( a b -- c ) + ;
|
[ t ]
|
||||||
|
[ \ baz "declared-effect" word-prop terminated?>> ]
|
||||||
|
unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
|
||||||
"effect-parsing-test" "parser.tests" lookup
|
|
||||||
\ effect-parsing-test eq?
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ T{ effect f { "a" "b" } { "c" } f } ]
|
[ t ] [
|
||||||
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test
|
"effect-parsing-test" "parser.tests" lookup
|
||||||
|
\ effect-parsing-test eq?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
: baz ( a b -- * ) 2array throw ;
|
[ T{ effect f { "a" "b" } { "d" } f } ]
|
||||||
|
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test
|
||||||
|
|
||||||
[ t ]
|
[ "IN: parser.tests : missing-- ( a b ) ;" eval( -- ) ] must-fail
|
||||||
[ \ baz "declared-effect" word-prop terminated?>> ]
|
|
||||||
unit-test
|
|
||||||
|
|
||||||
[ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
|
! Funny bug
|
||||||
|
[ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test
|
||||||
|
|
||||||
[ t ] [
|
! These should throw errors
|
||||||
"effect-parsing-test" "parser.tests" lookup
|
[ "HEX: zzz" eval( -- obj ) ] must-fail
|
||||||
\ effect-parsing-test eq?
|
[ "OCT: 999" eval( -- obj ) ] must-fail
|
||||||
] unit-test
|
[ "BIN: --0" eval( -- obj ) ] must-fail
|
||||||
|
|
||||||
[ T{ effect f { "a" "b" } { "d" } f } ]
|
DEFER: foo
|
||||||
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test
|
|
||||||
|
|
||||||
! Funny bug
|
"IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval( -- )
|
||||||
[ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test
|
|
||||||
|
|
||||||
[ "IN: parser.tests : missing-- ( a b ) ;" eval( -- ) ] must-fail
|
[ ] [ "USE: parser.tests foo" eval( -- ) ] unit-test
|
||||||
|
|
||||||
! These should throw errors
|
"IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval( -- )
|
||||||
[ "HEX: zzz" eval( -- obj ) ] must-fail
|
|
||||||
[ "OCT: 999" eval( -- obj ) ] must-fail
|
|
||||||
[ "BIN: --0" eval( -- obj ) ] must-fail
|
|
||||||
|
|
||||||
DEFER: foo
|
[ t ] [
|
||||||
|
"USE: parser.tests \\ foo" eval( -- word )
|
||||||
|
"foo" "parser.tests" lookup eq?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
"IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval( -- )
|
! parse-tokens should do the right thing on EOF
|
||||||
|
[ "USING: kernel" eval( -- ) ]
|
||||||
|
[ error>> T{ unexpected { want ";" } } = ] must-fail-with
|
||||||
|
|
||||||
[ ] [ "USE: parser.tests foo" eval( -- ) ] unit-test
|
! Test smudging
|
||||||
|
|
||||||
"IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval( -- )
|
[ 1 ] [
|
||||||
|
"IN: parser.tests : smudge-me ( -- ) ;" <string-reader> "foo"
|
||||||
|
parse-stream drop
|
||||||
|
|
||||||
[ t ] [
|
"foo" source-file definitions>> first assoc-size
|
||||||
"USE: parser.tests \\ foo" eval( -- word )
|
] unit-test
|
||||||
"foo" "parser.tests" lookup eq?
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
! Test smudging
|
[ t ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
|
||||||
|
|
||||||
[ 1 ] [
|
[ ] [
|
||||||
"IN: parser.tests : smudge-me ( -- ) ;" <string-reader> "foo"
|
"IN: parser.tests : smudge-me-more ( -- ) ;" <string-reader> "foo"
|
||||||
parse-stream drop
|
parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
"foo" source-file definitions>> first assoc-size
|
[ t ] [ "smudge-me-more" "parser.tests" lookup >boolean ] unit-test
|
||||||
] unit-test
|
[ f ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
|
||||||
|
|
||||||
[ t ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
|
[ 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 assoc-size
|
||||||
"IN: parser.tests : smudge-me-more ( -- ) ;" <string-reader> "foo"
|
] unit-test
|
||||||
parse-stream drop
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ t ] [ "smudge-me-more" "parser.tests" lookup >boolean ] unit-test
|
[ 1 ] [
|
||||||
[ f ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
|
"IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
|
||||||
|
parse-stream drop
|
||||||
|
|
||||||
[ 3 ] [
|
"bar" source-file definitions>> first assoc-size
|
||||||
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
|
] unit-test
|
||||||
parse-stream drop
|
|
||||||
|
|
||||||
"foo" source-file definitions>> first assoc-size
|
[ 2 ] [
|
||||||
] unit-test
|
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" <string-reader> "foo"
|
||||||
|
parse-stream drop
|
||||||
|
|
||||||
[ 1 ] [
|
"foo" source-file definitions>> first assoc-size
|
||||||
"IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
|
] unit-test
|
||||||
parse-stream drop
|
|
||||||
|
|
||||||
"bar" source-file definitions>> first assoc-size
|
[ t ] [
|
||||||
] unit-test
|
array "smudge-me" "parser.tests" lookup order member-eq?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[ 2 ] [
|
[ t ] [
|
||||||
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" <string-reader> "foo"
|
integer "smudge-me" "parser.tests" lookup order member-eq?
|
||||||
parse-stream drop
|
] unit-test
|
||||||
|
|
||||||
"foo" source-file definitions>> first assoc-size
|
[ f ] [
|
||||||
] unit-test
|
string "smudge-me" "parser.tests" lookup order member-eq?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ ] [
|
||||||
array "smudge-me" "parser.tests" lookup order member-eq?
|
"IN: parser.tests USE: math 2 2 +" <string-reader> "a"
|
||||||
] unit-test
|
parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
integer "smudge-me" "parser.tests" lookup order member-eq?
|
"a" <pathname> \ + usage member?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [
|
[ ] [
|
||||||
string "smudge-me" "parser.tests" lookup order member-eq?
|
"IN: parser.tests USE: math 2 2 -" <string-reader> "a"
|
||||||
] unit-test
|
parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ f ] [
|
||||||
"IN: parser.tests USE: math 2 2 +" <string-reader> "a"
|
"a" <pathname> \ + usage member?
|
||||||
parse-stream drop
|
] unit-test
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ t ] [
|
|
||||||
"a" <pathname> \ + usage member?
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ] [
|
|
||||||
"IN: parser.tests USE: math 2 2 -" <string-reader> "a"
|
|
||||||
parse-stream drop
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ 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 drop
|
|
||||||
] times
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
|
[ ] [
|
||||||
"a" source-files get delete-at
|
"a" source-files get delete-at
|
||||||
|
2 [
|
||||||
[
|
"IN: parser.tests DEFER: x : y ( -- ) x ; : x ( -- ) y ;"
|
||||||
"IN: parser.tests : x ( -- ) ; : y ( -- * ) 3 throw ; this is an error"
|
|
||||||
<string-reader> "a" parse-stream
|
|
||||||
] [ source-file-error? ] must-fail-with
|
|
||||||
|
|
||||||
[ t ] [
|
|
||||||
"y" "parser.tests" lookup >boolean
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ f ] [
|
|
||||||
"IN: parser.tests : x ( -- ) ;"
|
|
||||||
<string-reader> "a" parse-stream drop
|
<string-reader> "a" parse-stream drop
|
||||||
|
] times
|
||||||
|
] unit-test
|
||||||
|
|
||||||
"y" "parser.tests" lookup
|
"a" source-files get delete-at
|
||||||
] unit-test
|
|
||||||
|
|
||||||
! Test new forward definition logic
|
[
|
||||||
[ ] [
|
"IN: parser.tests : x ( -- ) ; : y ( -- * ) 3 throw ; this is an error"
|
||||||
"IN: axx : axx ( -- ) ;"
|
<string-reader> "a" parse-stream
|
||||||
<string-reader> "axx" parse-stream drop
|
] [ source-file-error? ] must-fail-with
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ] [
|
[ t ] [
|
||||||
"USE: axx IN: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;"
|
"y" "parser.tests" lookup >boolean
|
||||||
<string-reader> "bxx" parse-stream drop
|
] unit-test
|
||||||
] unit-test
|
|
||||||
|
|
||||||
! So we move the bxx word to axx...
|
[ f ] [
|
||||||
[ ] [
|
"IN: parser.tests : x ( -- ) ;"
|
||||||
"IN: axx : axx ( -- ) ; : bxx ( -- ) ;"
|
<string-reader> "a" parse-stream drop
|
||||||
<string-reader> "axx" parse-stream drop
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ t ] [ "bxx" "axx" lookup >boolean ] unit-test
|
"y" "parser.tests" lookup
|
||||||
|
] unit-test
|
||||||
|
|
||||||
! And reload the file that uses it...
|
! Test new forward definition logic
|
||||||
[ ] [
|
[ ] [
|
||||||
"USE: axx IN: bxx ( -- ) : cxx ( -- ) axx bxx ;"
|
"IN: axx : axx ( -- ) ;"
|
||||||
<string-reader> "bxx" parse-stream drop
|
<string-reader> "axx" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! And hope not to get a forward-error!
|
[ ] [
|
||||||
|
"USE: axx IN: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;"
|
||||||
|
<string-reader> "bxx" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
! Turning a generic into a non-generic could cause all
|
! So we move the bxx word to axx...
|
||||||
! kinds of funnyness
|
[ ] [
|
||||||
[ ] [
|
"IN: axx : axx ( -- ) ; : bxx ( -- ) ;"
|
||||||
"IN: ayy USE: kernel GENERIC: ayy ( a -- b ) M: object ayy ;"
|
<string-reader> "axx" parse-stream drop
|
||||||
<string-reader> "ayy" parse-stream drop
|
] unit-test
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ] [
|
[ t ] [ "bxx" "axx" lookup >boolean ] unit-test
|
||||||
"IN: ayy USE: kernel : ayy ( -- ) ;"
|
|
||||||
<string-reader> "ayy" parse-stream drop
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ] [
|
! And reload the file that uses it...
|
||||||
"IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b )"
|
[ ] [
|
||||||
<string-reader> "azz" parse-stream drop
|
"USE: axx IN: bxx ( -- ) : cxx ( -- ) axx bxx ;"
|
||||||
] unit-test
|
<string-reader> "bxx" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
! And hope not to get a forward-error!
|
||||||
"USE: azz M: my-class a-generic ;"
|
|
||||||
<string-reader> "azz-2" parse-stream drop
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ] [
|
! Turning a generic into a non-generic could cause all
|
||||||
"IN: azz GENERIC: a-generic ( a -- b )"
|
! kinds of funnyness
|
||||||
<string-reader> "azz" parse-stream drop
|
[ ] [
|
||||||
] unit-test
|
"IN: ayy USE: kernel GENERIC: ayy ( a -- b ) M: object ayy ;"
|
||||||
|
<string-reader> "ayy" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"USE: azz USE: math M: integer a-generic ;"
|
"IN: ayy USE: kernel : ayy ( -- ) ;"
|
||||||
<string-reader> "azz-2" parse-stream drop
|
<string-reader> "ayy" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"IN: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- error ) <bogus-error> ;"
|
"IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b )"
|
||||||
<string-reader> "bogus-error" parse-stream drop
|
<string-reader> "azz" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- error ) <bogus-error> ;"
|
"USE: azz M: my-class a-generic ;"
|
||||||
<string-reader> "bogus-error" parse-stream drop
|
<string-reader> "azz-2" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! Problems with class predicates -vs- ordinary words
|
[ ] [
|
||||||
[ ] [
|
"IN: azz GENERIC: a-generic ( a -- b )"
|
||||||
"IN: parser.tests TUPLE: killer ;"
|
<string-reader> "azz" parse-stream drop
|
||||||
<string-reader> "removing-the-predicate" parse-stream drop
|
] unit-test
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"IN: parser.tests GENERIC: killer? ( a -- b )"
|
"USE: azz USE: math M: integer a-generic ;"
|
||||||
<string-reader> "removing-the-predicate" parse-stream drop
|
<string-reader> "azz-2" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ ] [
|
||||||
"killer?" "parser.tests" lookup >boolean
|
"IN: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- error ) <bogus-error> ;"
|
||||||
] unit-test
|
<string-reader> "bogus-error" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[
|
[ ] [
|
||||||
"IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b )"
|
"IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- error ) <bogus-error> ;"
|
||||||
<string-reader> "removing-the-predicate" parse-stream
|
<string-reader> "bogus-error" parse-stream drop
|
||||||
] [ error>> error>> error>> redefine-error? ] must-fail-with
|
] unit-test
|
||||||
|
|
||||||
[
|
! Problems with class predicates -vs- ordinary words
|
||||||
"IN: parser.tests TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
|
[ ] [
|
||||||
<string-reader> "redefining-a-class-1" parse-stream
|
"IN: parser.tests TUPLE: killer ;"
|
||||||
] [ error>> error>> error>> redefine-error? ] must-fail-with
|
<string-reader> "removing-the-predicate" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test"
|
"IN: parser.tests GENERIC: killer? ( a -- b )"
|
||||||
<string-reader> "redefining-a-class-2" parse-stream drop
|
<string-reader> "removing-the-predicate" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[
|
[ t ] [
|
||||||
"IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ( -- ) ;"
|
"killer?" "parser.tests" lookup >boolean
|
||||||
<string-reader> "redefining-a-class-3" parse-stream drop
|
] unit-test
|
||||||
] [ error>> error>> error>> redefine-error? ] must-fail-with
|
|
||||||
|
|
||||||
[ ] [
|
[
|
||||||
"IN: parser.tests TUPLE: class-fwd-test ;"
|
"IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b )"
|
||||||
<string-reader> "redefining-a-class-3" parse-stream drop
|
<string-reader> "removing-the-predicate" parse-stream
|
||||||
] unit-test
|
] [ error>> error>> error>> redefine-error? ] must-fail-with
|
||||||
|
|
||||||
[
|
[
|
||||||
"IN: parser.tests \\ class-fwd-test"
|
"IN: parser.tests TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
|
||||||
<string-reader> "redefining-a-class-3" parse-stream drop
|
<string-reader> "redefining-a-class-1" parse-stream
|
||||||
] [ error>> error>> error>> no-word-error? ] must-fail-with
|
] [ error>> error>> error>> redefine-error? ] must-fail-with
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"IN: parser.tests TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
|
"IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test"
|
||||||
<string-reader> "redefining-a-class-3" parse-stream drop
|
<string-reader> "redefining-a-class-2" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[
|
[
|
||||||
"IN: parser.tests \\ class-fwd-test"
|
"IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ( -- ) ;"
|
||||||
<string-reader> "redefining-a-class-3" parse-stream drop
|
<string-reader> "redefining-a-class-3" parse-stream drop
|
||||||
] [ error>> error>> error>> no-word-error? ] must-fail-with
|
] [ error>> error>> error>> redefine-error? ] must-fail-with
|
||||||
|
|
||||||
[
|
[ ] [
|
||||||
"IN: parser.tests : foo ( -- ) ; TUPLE: foo ;"
|
"IN: parser.tests TUPLE: class-fwd-test ;"
|
||||||
<string-reader> "redefining-a-class-4" parse-stream drop
|
<string-reader> "redefining-a-class-3" parse-stream drop
|
||||||
] [ error>> error>> error>> redefine-error? ] must-fail-with
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[
|
||||||
"IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval( -- )
|
"IN: parser.tests \\ class-fwd-test"
|
||||||
] unit-test
|
<string-reader> "redefining-a-class-3" parse-stream drop
|
||||||
|
] [ error>> error>> error>> no-word-error? ] must-fail-with
|
||||||
|
|
||||||
[
|
[ ] [
|
||||||
"IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval( -- )
|
"IN: parser.tests TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
|
||||||
] must-fail
|
<string-reader> "redefining-a-class-3" parse-stream drop
|
||||||
] with-file-vocabs
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
"IN: parser.tests \\ class-fwd-test"
|
||||||
|
<string-reader> "redefining-a-class-3" parse-stream drop
|
||||||
|
] [ error>> error>> error>> no-word-error? ] must-fail-with
|
||||||
|
|
||||||
|
[
|
||||||
|
"IN: parser.tests : foo ( -- ) ; TUPLE: foo ;"
|
||||||
|
<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 ( x -- y ) ;" eval( -- )
|
"IN: parser.tests USE: kernel PREDICATE: foo < object ( x -- y ) ;" eval( -- )
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2004, 2009 Slava Pestov.
|
! Copyright (C) 2004, 2010 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien arrays byte-arrays byte-vectors definitions generic
|
USING: accessors alien arrays byte-arrays byte-vectors definitions generic
|
||||||
hashtables kernel math namespaces parser lexer sequences strings
|
hashtables kernel math namespaces parser lexer sequences strings
|
||||||
|
|
@ -125,7 +125,7 @@ IN: bootstrap.syntax
|
||||||
] define-core-syntax
|
] define-core-syntax
|
||||||
|
|
||||||
"SYMBOLS:" [
|
"SYMBOLS:" [
|
||||||
";" [ create-in dup reset-generic define-symbol ] each-token
|
";" [ create-in [ reset-generic ] [ define-symbol ] bi ] each-token
|
||||||
] define-core-syntax
|
] define-core-syntax
|
||||||
|
|
||||||
"SINGLETONS:" [
|
"SINGLETONS:" [
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue