1 USING: arrays math parser tools.test kernel generic words
2 io.streams.string namespaces classes effects source-files assocs
3 sequences strings io.files io.pathnames definitions
4 continuations sorting classes.tuple compiler.units debugger
5 vocabs vocabs.loader accessors eval combinators lexer
6 vocabs.parser words.symbol multiline source-files.errors
7 tools.crossref grouping ;
11 [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval( -- a b c ) ]
15 [ "t t f f" eval( -- ? ? ? ? ) ]
19 [ "\"hello world\"" eval( -- string ) ]
23 [ "\"\\n\\r\\t\\\\\"" eval( -- string ) ]
28 "IN: parser.tests : hello ( -- str ) \"hello world\" ;"
29 eval( -- ) "USE: parser.tests hello" eval( -- string )
33 [ "! This is a comment, people." eval( -- ) ]
39 [ "\"\\u000020\"" eval( -- string ) ]
43 [ "\"\\u000027\"" eval( -- string ) ]
46 ! Test EOL comments in multiline strings.
47 [ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
49 [ word ] [ \ f class ] unit-test
51 ! Test stack effect parsing
53 : effect-parsing-test ( a b -- c ) + ;
56 "effect-parsing-test" "parser.tests" lookup
57 \ effect-parsing-test eq?
60 [ T{ effect f { "a" "b" } { "c" } f } ]
61 [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
63 : baz ( a b -- * ) 2array throw ;
66 [ \ baz "declared-effect" word-prop terminated?>> ]
69 [ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
72 "effect-parsing-test" "parser.tests" lookup
73 \ effect-parsing-test eq?
76 [ T{ effect f { "a" "b" } { "d" } f } ]
77 [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
79 [ "IN: parser.tests : missing-- ( a b ) ;" eval( -- ) ] must-fail
82 [ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test
84 ! These should throw errors
85 [ "HEX: zzz" eval( -- obj ) ] must-fail
86 [ "OCT: 999" eval( -- obj ) ] must-fail
87 [ "BIN: --0" eval( -- obj ) ] must-fail
91 "IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval( -- )
93 [ ] [ "USE: parser.tests foo" eval( -- ) ] unit-test
95 "IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval( -- )
98 "USE: parser.tests \\ foo" eval( -- word )
99 "foo" "parser.tests" lookup eq?
102 ! parse-tokens should do the right thing on EOF
103 [ "USING: kernel" eval( -- ) ]
104 [ error>> T{ unexpected { want "token" } } = ] must-fail-with
109 "IN: parser.tests : smudge-me ( -- ) ;" <string-reader> "foo"
112 "foo" source-file definitions>> first assoc-size
115 [ t ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
118 "IN: parser.tests : smudge-me-more ( -- ) ;" <string-reader> "foo"
122 [ t ] [ "smudge-me-more" "parser.tests" lookup >boolean ] unit-test
123 [ f ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
126 "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
129 "foo" source-file definitions>> first assoc-size
133 "IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
136 "bar" source-file definitions>> first assoc-size
140 "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" <string-reader> "foo"
143 "foo" source-file definitions>> first assoc-size
147 array "smudge-me" "parser.tests" lookup order member-eq?
151 integer "smudge-me" "parser.tests" lookup order member-eq?
155 string "smudge-me" "parser.tests" lookup order member-eq?
159 "IN: parser.tests USE: math 2 2 +" <string-reader> "a"
164 "a" <pathname> \ + usage member?
168 "IN: parser.tests USE: math 2 2 -" <string-reader> "a"
173 "a" <pathname> \ + usage member?
177 "a" source-files get delete-at
179 "IN: parser.tests DEFER: x : y ( -- ) x ; : x ( -- ) y ;"
180 <string-reader> "a" parse-stream drop
184 "a" source-files get delete-at
187 "IN: parser.tests : x ( -- ) ; : y ( -- * ) 3 throw ; this is an error"
188 <string-reader> "a" parse-stream
189 ] [ source-file-error? ] must-fail-with
192 "y" "parser.tests" lookup >boolean
196 "IN: parser.tests : x ( -- ) ;"
197 <string-reader> "a" parse-stream drop
199 "y" "parser.tests" lookup
202 ! Test new forward definition logic
204 "IN: axx : axx ( -- ) ;"
205 <string-reader> "axx" parse-stream drop
209 "USE: axx IN: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;"
210 <string-reader> "bxx" parse-stream drop
213 ! So we move the bxx word to axx...
215 "IN: axx : axx ( -- ) ; : bxx ( -- ) ;"
216 <string-reader> "axx" parse-stream drop
219 [ t ] [ "bxx" "axx" lookup >boolean ] unit-test
221 ! And reload the file that uses it...
223 "USE: axx IN: bxx ( -- ) : cxx ( -- ) axx bxx ;"
224 <string-reader> "bxx" parse-stream drop
227 ! And hope not to get a forward-error!
229 ! Turning a generic into a non-generic could cause all
232 "IN: ayy USE: kernel GENERIC: ayy ( a -- b ) M: object ayy ;"
233 <string-reader> "ayy" parse-stream drop
237 "IN: ayy USE: kernel : ayy ( -- ) ;"
238 <string-reader> "ayy" parse-stream drop
242 "IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b )"
243 <string-reader> "azz" parse-stream drop
247 "USE: azz M: my-class a-generic ;"
248 <string-reader> "azz-2" parse-stream drop
252 "IN: azz GENERIC: a-generic ( a -- b )"
253 <string-reader> "azz" parse-stream drop
257 "USE: azz USE: math M: integer a-generic ;"
258 <string-reader> "azz-2" parse-stream drop
262 "IN: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- error ) <bogus-error> ;"
263 <string-reader> "bogus-error" parse-stream drop
267 "IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- error ) <bogus-error> ;"
268 <string-reader> "bogus-error" parse-stream drop
271 ! Problems with class predicates -vs- ordinary words
273 "IN: parser.tests TUPLE: killer ;"
274 <string-reader> "removing-the-predicate" parse-stream drop
278 "IN: parser.tests GENERIC: killer? ( a -- b )"
279 <string-reader> "removing-the-predicate" parse-stream drop
283 "killer?" "parser.tests" lookup >boolean
287 "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b )"
288 <string-reader> "removing-the-predicate" parse-stream
289 ] [ error>> error>> error>> redefine-error? ] must-fail-with
292 "IN: parser.tests TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
293 <string-reader> "redefining-a-class-1" parse-stream
294 ] [ error>> error>> error>> redefine-error? ] must-fail-with
297 "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test"
298 <string-reader> "redefining-a-class-2" parse-stream drop
302 "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ( -- ) ;"
303 <string-reader> "redefining-a-class-3" parse-stream drop
304 ] [ error>> error>> error>> redefine-error? ] must-fail-with
307 "IN: parser.tests TUPLE: class-fwd-test ;"
308 <string-reader> "redefining-a-class-3" parse-stream drop
312 "IN: parser.tests \\ class-fwd-test"
313 <string-reader> "redefining-a-class-3" parse-stream drop
314 ] [ error>> error>> error>> no-word-error? ] must-fail-with
317 "IN: parser.tests TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
318 <string-reader> "redefining-a-class-3" parse-stream drop
322 "IN: parser.tests \\ class-fwd-test"
323 <string-reader> "redefining-a-class-3" parse-stream drop
324 ] [ error>> error>> error>> no-word-error? ] must-fail-with
327 "IN: parser.tests : foo ( -- ) ; TUPLE: foo ;"
328 <string-reader> "redefining-a-class-4" parse-stream drop
329 ] [ error>> error>> error>> redefine-error? ] must-fail-with
332 "IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval( -- )
336 "IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval( -- )
340 "IN: parser.tests USE: kernel PREDICATE: foo < object ( x -- y ) ;" eval( -- )
344 "foo" "parser.tests" lookup word eq?
349 "redefining-a-class-5" forget-source
350 "redefining-a-class-6" forget-source
351 "redefining-a-class-7" forget-source
352 ] with-compilation-unit
357 "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )"
358 <string-reader> "redefining-a-class-5" parse-stream drop
362 "IN: parser.tests M: f foo ;"
363 <string-reader> "redefining-a-class-6" parse-stream drop
366 [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
369 "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )"
370 <string-reader> "redefining-a-class-5" parse-stream drop
373 [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
376 "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )"
377 <string-reader> "redefining-a-class-7" parse-stream drop
380 [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
383 "IN: parser.tests TUPLE: foo ;"
384 <string-reader> "redefining-a-class-7" parse-stream drop
387 [ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
390 [ "vocab:parser/test/assert-depth.factor" run-file ] must-fail
394 "IN: parser.tests DEFER: d-f-s d-f-s SYMBOL: d-f-s d-f-s"
395 <string-reader> "d-f-s-test" parse-stream drop
399 "IN: parser.tests DEFER: d-f-s d-f-s FORGET: 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 SYMBOL: d-f-s d-f-s"
405 <string-reader> "d-f-s-test" parse-stream drop
410 [ "this-better-not-exist" forget-vocab ] with-compilation-unit
414 "USE: this-better-not-exist" eval( -- )
417 [ ": foo ;" eval( -- ) ] [ error>> error>> no-current-vocab? ] must-fail-with
419 [ 92 ] [ "CHAR: \\" eval( -- n ) ] unit-test
420 [ 92 ] [ "CHAR: \\\\" eval( -- n ) ] unit-test
425 "USING: math arrays kernel ;"
426 "GENERIC: change-combination ( obj a -- b )"
427 "M: integer change-combination 2drop 1 ;"
428 "M: array change-combination 2drop 2 ;"
429 } "\n" join <string-reader> "change-combination-test" parse-stream drop
435 "USING: math arrays kernel ;"
436 "GENERIC# change-combination 1 ( obj a -- b )"
437 "M: integer change-combination 2drop 1 ;"
438 "M: array change-combination 2drop 2 ;"
439 } "\n" join <string-reader> "change-combination-test" parse-stream drop
443 "change-combination" "parser.tests" lookup
444 "methods" word-prop assoc-size
449 "IN: parser.tests DEFER: twice-fails FORGET: twice-fails MIXIN: twice-fails"
450 <string-reader> "twice-fails-test" parse-stream drop
455 "IN: parser.tests : staging-problem-test-1 ( -- a ) 1 ; : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
456 <string-reader> "staging-problem-test" parse-stream
459 [ t ] [ "staging-problem-test-1" "parser.tests" lookup >boolean ] unit-test
461 [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
464 "IN: parser.tests << : staging-problem-test-1 ( -- a ) 1 ; >> : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
465 <string-reader> "staging-problem-test" parse-stream
468 [ t ] [ "staging-problem-test-1" "parser.tests" lookup >boolean ] unit-test
470 [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
472 [ "DEFER: blahy" eval( -- ) ] [ error>> error>> no-current-vocab? ] must-fail-with
475 "IN: parser.tests SYNTAX: blahy ; FORGET: blahy" eval( -- )
477 error>> staging-violation?
480 ! Bogus error message
483 [ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" eval( -- ) ]
484 [ error>> error>> def>> \ blahy eq? ] must-fail-with
486 [ "CHAR: \\u9999999999999" eval( -- n ) ] must-fail
490 [ a ] [ a ] unit-test
491 [ b ] [ b ] unit-test
492 [ c ] [ c ] unit-test
496 [ ] [ "IN: parser.tests GENERIC: blah ( -- )" eval( -- ) ] unit-test
497 [ ] [ "IN: parser.tests SYMBOLS: blah ;" eval( -- ) ] unit-test
499 [ f ] [ \ blah generic? ] unit-test
500 [ t ] [ \ blah symbol? ] unit-test
504 [ "IN: parser.tests SINGLETONS: blah1 blah1 blah1 ;" eval( -- ) ]
505 [ error>> error>> def>> \ blah1 eq? ]
508 IN: qualified.tests.foo
511 IN: qualified.tests.bar
514 IN: qualified.tests.baz
517 QUALIFIED: qualified.tests.foo
518 QUALIFIED: qualified.tests.bar
519 [ 1 2 3 ] [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test
521 QUALIFIED-WITH: qualified.tests.bar p
522 [ 2 ] [ p:x ] unit-test
524 RENAME: x qualified.tests.baz => y
525 [ 3 ] [ y ] unit-test
527 FROM: qualified.tests.baz => x ;
528 [ 3 ] [ x ] unit-test
529 [ 3 ] [ y ] unit-test
531 EXCLUDE: qualified.tests.bar => x ;
532 [ 3 ] [ x ] unit-test
533 [ 4 ] [ y ] unit-test
537 ! Replace : def with something in << >>
539 "IN: parser.tests : was-once-a-word-bug ( -- ) ;"
540 <string-reader> "was-once-a-word-test" parse-stream
543 [ t ] [ "was-once-a-word-bug" "parser.tests" lookup >boolean ] unit-test
546 "IN: parser.tests USE: words << \"was-once-a-word-bug\" \"parser.tests\" create [ ] (( -- )) define-declared >>"
547 <string-reader> "was-once-a-word-test" parse-stream
550 [ t ] [ "was-once-a-word-bug" "parser.tests" lookup >boolean ] unit-test */
552 ! Replace : def with DEFER:
554 "IN: parser.tests : is-not-deferred ( -- ) ;"
555 <string-reader> "is-not-deferred" parse-stream
558 [ t ] [ "is-not-deferred" "parser.tests" lookup >boolean ] unit-test
559 [ f ] [ "is-not-deferred" "parser.tests" lookup deferred? ] unit-test
562 "IN: parser.tests DEFER: is-not-deferred"
563 <string-reader> "is-not-deferred" parse-stream
566 [ t ] [ "is-not-deferred" "parser.tests" lookup >boolean ] unit-test
567 [ t ] [ "is-not-deferred" "parser.tests" lookup deferred? ] unit-test
569 ! Forward-reference resolution case iterated using list in the wrong direction
571 "IN: parser.tests.forward-ref-1 DEFER: x DEFER: y"
572 <string-reader> "forward-ref-1" parse-stream
576 "IN: parser.tests.forward-ref-2 DEFER: x DEFER: y"
577 <string-reader> "forward-ref-2" parse-stream
581 "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 ;"
582 <string-reader> "forward-ref-3" parse-stream
586 "z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
590 "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 ;"
591 <string-reader> "forward-ref-3" parse-stream
595 "z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
599 "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 ;"
600 <string-reader> "forward-ref-3" parse-stream
604 "z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
608 "USE: kernel dup" <string-reader> "unuse-test" parse-stream
612 "dup" <string-reader> "unuse-test" parse-stream
613 ] [ error>> error>> error>> no-word-error? ] must-fail-with
616 "USE: kernel UNUSE: kernel dup" <string-reader> "unuse-test" parse-stream
617 ] [ error>> error>> error>> no-word-error? ] must-fail-with
619 [ ] [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test
622 [ "vocabs.loader.test.l" use-vocab ] must-fail
623 [ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> key? ] unit-test
624 [ ] [ "vocabs.loader.test.l" unuse-vocab ] unit-test
625 [ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> key? ] unit-test
628 ! Test cases for #183
629 [ "SINGLETON: 33" <string-reader> "class identifier test" parse-stream ]
630 [ error>> lexer-error? ] must-fail-with
632 [ ": 44 ( -- ) ;" <string-reader> "word identifier test" parse-stream ]
633 [ error>> lexer-error? ] must-fail-with
635 [ "GENERIC: 33 ( -- )" <string-reader> "generic identifier test" parse-stream ]
636 [ error>> lexer-error? ] must-fail-with