1 USING: accessors arrays assocs classes compiler.units effects
2 eval generic grouping io.pathnames io.streams.string kernel
3 lexer math multiline namespaces parser sequences sets
4 source-files source-files.errors strings tools.crossref
5 tools.test vocabs vocabs.parser words words.symbol splitting ;
9 [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval( -- a b c ) ]
13 [ "t t f f" eval( -- ? ? ? ? ) ]
17 [ "\"hello world\"" eval( -- string ) ]
21 [ "\"\\n\\r\\t\\\\\"" eval( -- string ) ]
26 "#!/usr/bin/env factor
27 \"hello world\"" eval( -- string )
32 "IN: parser.tests : hello ( -- str ) \"hello world\" ;"
33 eval( -- ) "USE: parser.tests hello" eval( -- string )
36 [ "IN: parser.tests : \" ( -- n ) 123 ;" eval( -- ) ]
37 [ error>> invalid-word-name? ] must-fail-with
38 [ "IN: parser.tests : \"asdf ( -- n ) 123 ;" eval( -- ) ]
39 [ error>> invalid-word-name? ] must-fail-with
40 [ "IN: parser.tests : 123 ( -- n ) 123 ;" eval( -- ) ]
41 [ error>> invalid-word-name? ] must-fail-with
44 [ "! This is a comment, people." eval( -- ) ]
50 [ "\"\\u000020\"" eval( -- string ) ]
54 [ "\"\\u000027\"" eval( -- string ) ]
57 ! Test EOL comments in multiline strings.
58 { "Hello" } [ "! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
60 { word } [ \ f class-of ] unit-test
62 ! Test stack effect parsing
64 : effect-parsing-test ( a b -- c ) + ;
67 "effect-parsing-test" "parser.tests" lookup-word
68 \ effect-parsing-test eq?
71 { T{ effect f { "a" "b" } { "c" } f } }
72 [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
74 : baz ( a b -- * ) 2array throw ;
77 [ \ baz "declared-effect" word-prop terminated?>> ]
80 { } [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
83 "effect-parsing-test" "parser.tests" lookup-word
84 \ effect-parsing-test eq?
87 { T{ effect f { "a" "b" } { "d" } f } }
88 [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
90 [ "IN: parser.tests : missing-- ( a b ) ;" eval( -- ) ] must-fail
93 { 2 } [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test
97 "IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval( -- )
99 { } [ "USE: parser.tests foo" eval( -- ) ] unit-test
101 "IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval( -- )
104 "USE: parser.tests \\ foo" eval( -- word )
105 "foo" "parser.tests" lookup-word eq?
108 ! parse-tokens should do the right thing on EOF
109 [ "USING: kernel" eval( -- ) ]
110 [ error>> T{ unexpected { want "token" } } = ] must-fail-with
115 "IN: parser.tests : smudge-me ( -- ) ;" <string-reader> "foo"
118 "foo" path>source-file definitions>> first cardinality
121 { t } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
124 "IN: parser.tests : smudge-me-more ( -- ) ;" <string-reader> "foo"
128 { t } [ "smudge-me-more" "parser.tests" lookup-word >boolean ] unit-test
129 { f } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
132 "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
135 "foo" path>source-file definitions>> first cardinality
139 "IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
142 "bar" path>source-file definitions>> first cardinality
146 "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" <string-reader> "foo"
149 "foo" path>source-file definitions>> first cardinality
153 array "smudge-me" "parser.tests" lookup-word order member-eq?
157 integer "smudge-me" "parser.tests" lookup-word order member-eq?
161 string "smudge-me" "parser.tests" lookup-word order member-eq?
165 "IN: parser.tests USE: math 2 2 +" <string-reader> "a"
170 "a" <pathname> \ + usage member?
174 "IN: parser.tests USE: math 2 2 -" <string-reader> "a"
179 "a" <pathname> \ + usage member?
183 "a" source-files get delete-at
185 "IN: parser.tests DEFER: x : y ( -- ) x ; : x ( -- ) y ;"
186 <string-reader> "a" parse-stream drop
190 "a" source-files get delete-at
193 "IN: parser.tests : x ( -- ) ; : y ( -- * ) 3 throw ; this is an error"
194 <string-reader> "a" parse-stream
195 ] [ source-file-error? ] must-fail-with
198 "y" "parser.tests" lookup-word >boolean
202 "IN: parser.tests : x ( -- ) ;"
203 <string-reader> "a" parse-stream drop
204 "y" "parser.tests" lookup-word
207 ! Test new forward definition logic
209 "IN: axx : axx ( -- ) ;"
210 <string-reader> "axx" parse-stream drop
214 "USE: axx IN: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;"
215 <string-reader> "bxx" parse-stream drop
218 ! So we move the bxx word to axx...
220 "IN: axx : axx ( -- ) ; : bxx ( -- ) ;"
221 <string-reader> "axx" parse-stream drop
224 { t } [ "bxx" "axx" lookup-word >boolean ] unit-test
226 ! And reload the file that uses it...
228 "USE: axx IN: bxx ( -- ) : cxx ( -- ) axx bxx ;"
229 <string-reader> "bxx" parse-stream drop
232 ! And hope not to get a forward-error!
234 ! Turning a generic into a non-generic could cause all
237 "IN: ayy USE: kernel GENERIC: ayy ( a -- b ) M: object ayy ;"
238 <string-reader> "ayy" parse-stream drop
242 "IN: ayy USE: kernel : ayy ( -- ) ;"
243 <string-reader> "ayy" parse-stream drop
247 "IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b )"
248 <string-reader> "azz" parse-stream drop
252 "USE: azz M: my-class a-generic ;"
253 <string-reader> "azz-2" parse-stream drop
257 "IN: azz GENERIC: a-generic ( a -- b )"
258 <string-reader> "azz" parse-stream drop
262 "USE: azz USE: math M: integer a-generic ;"
263 <string-reader> "azz-2" parse-stream drop
267 "IN: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- error ) <bogus-error> ;"
268 <string-reader> "bogus-error" parse-stream drop
272 "IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- error ) <bogus-error> ;"
273 <string-reader> "bogus-error" parse-stream drop
276 ! Problems with class predicates -vs- ordinary words
278 "IN: parser.tests TUPLE: killer ;"
279 <string-reader> "removing-the-predicate" parse-stream drop
283 "IN: parser.tests GENERIC: killer? ( a -- b )"
284 <string-reader> "removing-the-predicate" parse-stream drop
288 "killer?" "parser.tests" lookup-word >boolean
292 "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b )"
293 <string-reader> "removing-the-predicate" parse-stream
294 ] [ error>> error>> error>> redefine-error? ] must-fail-with
297 "IN: parser.tests TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
298 <string-reader> "redefining-a-class-1" parse-stream
299 ] [ error>> error>> error>> redefine-error? ] must-fail-with
302 "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test"
303 <string-reader> "redefining-a-class-2" parse-stream drop
307 "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ( -- ) ;"
308 <string-reader> "redefining-a-class-3" parse-stream drop
309 ] [ error>> error>> error>> redefine-error? ] must-fail-with
312 "IN: parser.tests TUPLE: class-fwd-test ;"
313 <string-reader> "redefining-a-class-3" parse-stream drop
317 "IN: parser.tests \\ class-fwd-test"
318 <string-reader> "redefining-a-class-3" parse-stream drop
319 ] [ error>> error>> error>> no-word-error? ] must-fail-with
322 "IN: parser.tests TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
323 <string-reader> "redefining-a-class-3" parse-stream drop
327 "IN: parser.tests \\ class-fwd-test"
328 <string-reader> "redefining-a-class-3" parse-stream drop
329 ] [ error>> error>> error>> no-word-error? ] must-fail-with
332 "IN: parser.tests : foo ( -- ) ; TUPLE: foo ;"
333 <string-reader> "redefining-a-class-4" parse-stream drop
334 ] [ error>> error>> error>> redefine-error? ] must-fail-with
337 "IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval( -- )
341 "IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval( -- )
345 "IN: parser.tests USE: kernel PREDICATE: foo < object ;" eval( -- )
349 "foo" "parser.tests" lookup-word last-word eq?
354 "redefining-a-class-5" forget-source
355 "redefining-a-class-6" forget-source
356 "redefining-a-class-7" forget-source
357 ] with-compilation-unit
362 "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )"
363 <string-reader> "redefining-a-class-5" parse-stream drop
367 "IN: parser.tests M: f foo ;"
368 <string-reader> "redefining-a-class-6" parse-stream drop
371 [ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test
374 "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )"
375 <string-reader> "redefining-a-class-5" parse-stream drop
378 [ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test
381 "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )"
382 <string-reader> "redefining-a-class-7" parse-stream drop
385 [ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test
388 "IN: parser.tests TUPLE: foo ;"
389 <string-reader> "redefining-a-class-7" parse-stream drop
392 [ t ] [ "foo" "parser.tests" lookup-word symbol? ] unit-test
395 [ "vocab:parser/test/assert-depth.factor" run-file ] must-fail
399 "IN: parser.tests DEFER: d-f-s d-f-s SYMBOL: d-f-s d-f-s"
400 <string-reader> "d-f-s-test" parse-stream drop
404 "IN: parser.tests DEFER: d-f-s d-f-s FORGET: d-f-s SYMBOL: d-f-s d-f-s"
405 <string-reader> "d-f-s-test" parse-stream drop
409 "IN: parser.tests DEFER: d-f-s d-f-s SYMBOL: d-f-s d-f-s"
410 <string-reader> "d-f-s-test" parse-stream drop
415 [ "this-better-not-exist" forget-vocab ] with-compilation-unit
419 "USE: this-better-not-exist" eval( -- )
422 [ ": foo ;" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with
424 { 92 } [ "CHAR: \\" eval( -- n ) ] unit-test
425 { 92 } [ "CHAR: \\\\" eval( -- n ) ] unit-test
430 "USING: math arrays kernel ;"
431 "GENERIC: change-combination ( obj a -- b )"
432 "M: integer change-combination 2drop 1 ;"
433 "M: array change-combination 2drop 2 ;"
434 } join-lines <string-reader> "change-combination-test" parse-stream drop
440 "USING: math arrays kernel ;"
441 "GENERIC#: change-combination 1 ( obj a -- b )"
442 "M: integer change-combination 2drop 1 ;"
443 "M: array change-combination 2drop 2 ;"
444 } join-lines <string-reader> "change-combination-test" parse-stream drop
448 "change-combination" "parser.tests" lookup-word
449 "methods" word-prop assoc-size
454 "IN: parser.tests DEFER: twice-fails FORGET: twice-fails MIXIN: twice-fails"
455 <string-reader> "twice-fails-test" parse-stream drop
460 "IN: parser.tests : staging-problem-test-1 ( -- a ) 1 ; : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
461 <string-reader> "staging-problem-test" parse-stream
464 { t } [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
466 { t } [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
469 "IN: parser.tests << : staging-problem-test-1 ( -- a ) 1 ; >> : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
470 <string-reader> "staging-problem-test" parse-stream
473 { t } [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
475 { t } [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
477 [ "DEFER: blahy" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with
480 "IN: parser.tests SYNTAX: blahy ; FORGET: blahy" eval( -- )
482 error>> staging-violation?
485 ! Bogus error message
488 [ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" eval( -- ) ]
489 [ error>> error>> def>> \ blahy eq? ] must-fail-with
491 [ "CHAR: \\u9999999999999" eval( -- n ) ] must-fail
495 { a } [ a ] unit-test
496 { b } [ b ] unit-test
497 { c } [ c ] unit-test
501 { } [ "IN: parser.tests GENERIC: blah ( x -- x )" eval( -- ) ] unit-test
502 { } [ "IN: parser.tests SYMBOLS: blah ;" eval( -- ) ] unit-test
504 { f } [ \ blah generic? ] unit-test
505 { t } [ \ blah symbol? ] unit-test
509 [ "IN: parser.tests SINGLETONS: blah1 blah1 blah1 ;" eval( -- ) ]
510 [ error>> error>> def>> \ blah1 eq? ]
513 IN: qualified.tests.foo
516 IN: qualified.tests.bar
519 IN: qualified.tests.baz
522 QUALIFIED: qualified.tests.foo
523 QUALIFIED: qualified.tests.bar
524 { 1 2 3 } [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test
526 QUALIFIED-WITH: qualified.tests.bar p
527 { 2 } [ p:x ] unit-test
529 RENAME: x qualified.tests.baz => y
530 { 3 } [ y ] unit-test
532 FROM: qualified.tests.baz => x ;
533 { 3 } [ x ] unit-test
534 { 3 } [ y ] unit-test
536 EXCLUDE: qualified.tests.bar => x ;
537 { 3 } [ x ] unit-test
538 { 4 } [ y ] unit-test
542 ! Replace : def with something in << >>
544 "IN: parser.tests : was-once-a-word-bug ( -- ) ;"
545 <string-reader> "was-once-a-word-test" parse-stream
548 { t } [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test
551 "IN: parser.tests USE: words << \"was-once-a-word-bug\" \"parser.tests\" create-word [ ] ( -- ) define-declared >>"
552 <string-reader> "was-once-a-word-test" parse-stream
555 { t } [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test */
557 ! Replace : def with DEFER:
559 "IN: parser.tests : is-not-deferred ( -- ) ;"
560 <string-reader> "is-not-deferred" parse-stream
563 { t } [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
564 { f } [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
567 "IN: parser.tests DEFER: is-not-deferred"
568 <string-reader> "is-not-deferred" parse-stream
571 { t } [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
572 { t } [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
574 ! Forward-reference resolution case iterated using list in the wrong direction
576 "IN: parser.tests.forward-ref-1 DEFER: x DEFER: y"
577 <string-reader> "forward-ref-1" parse-stream
581 "IN: parser.tests.forward-ref-2 DEFER: x DEFER: y"
582 <string-reader> "forward-ref-2" parse-stream
586 "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 ;"
587 <string-reader> "forward-ref-3" parse-stream
591 "z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
595 "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 ;"
596 <string-reader> "forward-ref-3" parse-stream
600 "z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
604 "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 ;"
605 <string-reader> "forward-ref-3" parse-stream
609 "z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
613 "USE: kernel dup" <string-reader> "unuse-test" parse-stream
617 "dup" <string-reader> "unuse-test" parse-stream
618 ] [ error>> error>> error>> no-word-error? ] must-fail-with
621 "USE: kernel UNUSE: kernel dup" <string-reader> "unuse-test" parse-stream
622 ] [ error>> error>> error>> no-word-error? ] must-fail-with
624 { } [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test
627 [ "vocabs.loader.test.l" use-vocab ] must-fail
628 [ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> in? ] unit-test
629 [ ] [ "vocabs.loader.test.l" unuse-vocab ] unit-test
630 [ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> in? ] unit-test
633 ! Test cases for #183
634 [ "SINGLETON: 33" <string-reader> "class identifier test" parse-stream ]
635 [ error>> lexer-error? ] must-fail-with
637 [ ": 44 ( -- ) ;" <string-reader> "word identifier test" parse-stream ]
638 [ error>> lexer-error? ] must-fail-with
640 [ "GENERIC: 33 ( -- )" <string-reader> "generic identifier test" parse-stream ]
641 [ error>> lexer-error? ] must-fail-with
645 { private? } use-first-word?
652 { "10 20 30 ;" } <lexer> [ parse-array-def ] with-lexer