1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }" |
1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }" |
2 |
2 |
3 "{ NameSpace: Smalltalk }" |
3 "{ NameSpace: Smalltalk }" |
4 |
4 |
5 TestCase subclass:#PEGFsaScannerIntegrationTest |
5 TestCase subclass:#PEGFsaScannerIntegrationTest |
6 instanceVariableNames:'fsa fsaGenerator parser scanner result compiled' |
6 instanceVariableNames:'fsa fsaGenerator parser scanner result compiled parser1 parser2' |
7 classVariableNames:'' |
7 classVariableNames:'' |
8 poolDictionaries:'' |
8 poolDictionaries:'' |
9 category:'PetitCompiler-Tests-Scanner' |
9 category:'PetitCompiler-Tests-Scanner' |
10 ! |
10 ! |
11 |
11 |
12 !PEGFsaScannerIntegrationTest methodsFor:'as yet unclassified'! |
12 !PEGFsaScannerIntegrationTest methodsFor:'as yet unclassified'! |
13 |
13 |
14 compile |
|
15 | ppcTree | |
|
16 compiled ifTrue: [ ^ self ]. |
|
17 ppcTree := parser asCompilerTree. |
|
18 fsa := ppcTree asFsa. |
|
19 fsa name: #nextToken. |
|
20 fsa finalStates do: [ :s | s isFailure ifFalse: [s retval: #token ]]. |
|
21 |
|
22 scanner := ((PPCScannerCodeGenerator new) |
|
23 generate: fsa). |
|
24 |
|
25 compiled := true |
|
26 ! |
|
27 |
|
28 failScan: stream |
|
29 self compile. |
|
30 |
|
31 scanner initialize. |
|
32 scanner stream: stream asPetitStream. |
|
33 result := scanner nextToken. |
|
34 |
|
35 self assert: result isEmpty |
|
36 ! |
|
37 |
|
38 scan: stream token: token |
|
39 self scan: stream token: token position: stream size. |
|
40 ! |
|
41 |
|
42 scan: stream token: token position: position |
|
43 self compile. |
|
44 |
|
45 scanner initialize. |
|
46 scanner stream: stream asPetitStream. |
|
47 result := scanner nextToken. |
|
48 |
|
49 self assert: result isCollection description: 'no collection returned as a result!!'. |
|
50 self assert: (result isEmpty not) description: 'no token found'. |
|
51 self assert: (result at: token) = position. |
|
52 ! |
|
53 |
|
54 setUp |
|
55 compiled := false. |
|
56 fsaGenerator := PEGFsaGenerator new. |
|
57 ! |
|
58 |
|
59 testA |
|
60 parser := 'a' asParser. |
|
61 |
|
62 self compile. |
|
63 |
|
64 self assert: fsa isDeterministic. |
|
65 self assert: fsa isWithoutEpsilons. |
|
66 |
|
67 self failScan: ''. |
|
68 self failScan: 'b'. |
|
69 |
|
70 self scan: 'a' token: #token position: 1. |
|
71 self scan: 'aaa' token: #token position: 1. |
|
72 ! |
|
73 |
|
74 testAAA_Aplusnot |
14 testAAA_Aplusnot |
75 parser := 'aaa' asParser not, $a asParser plus. |
15 parser := 'aaa' asParser not, $a asParser plus. |
76 self compile. |
16 self compile. |
77 |
17 |
78 self assert: fsa isDeterministic. |
18 self assert: fsa isDeterministic. |
372 |
392 |
373 self scan: '12' token: #token position: 2. |
393 self scan: '12' token: #token position: 2. |
374 self scan: '2312' token: #token position: 4. |
394 self scan: '2312' token: #token position: 4. |
375 ! |
395 ! |
376 |
396 |
|
397 testRecursive |
|
398 parser := PPDelegateParser new. |
|
399 |
|
400 parser setParser: ($a asParser, parser) / $b asParser. |
|
401 |
|
402 self compile. |
|
403 |
|
404 self assert: fsa isDeterministic. |
|
405 self assert: fsa isWithoutEpsilons. |
|
406 |
|
407 self failScan: 'c'. |
|
408 |
|
409 self scan: 'b' token: #token. |
|
410 self scan: 'ab' token: #token. |
|
411 self scan: 'aaaaab' token: #token. |
|
412 ! |
|
413 |
377 testSmalltalkIdentifier |
414 testSmalltalkIdentifier |
378 parser := #letter asParser, #word asParser star, $: asParser not. |
415 parser := #letter asParser, #word asParser star, $: asParser not. |
379 self compile. |
416 self compile. |
380 |
|
381 self assert: fsa isDeterministic. |
417 self assert: fsa isDeterministic. |
382 self assert: fsa isWithoutEpsilons. |
418 self assert: fsa isWithoutEpsilons. |
383 |
419 |
384 self scan: 'a' token: #token. |
420 self scan: 'a' token: #token. |
385 self scan: 'hithere' token: #token. |
421 self scan: 'hithere' token: #token. |
388 self failScan: ''. |
424 self failScan: ''. |
389 self failScan: 'aaa:'. |
425 self failScan: 'aaa:'. |
390 self failScan: '123'. |
426 self failScan: '123'. |
391 ! ! |
427 ! ! |
392 |
428 |
|
429 !PEGFsaScannerIntegrationTest methodsFor:'multivalues'! |
|
430 |
|
431 testA |
|
432 parser1 := 'a' asParser. |
|
433 parser2 := 'a' asParser. |
|
434 |
|
435 self compileMerge. |
|
436 |
|
437 self assert: fsa isDeterministic. |
|
438 self assert: fsa isWithoutEpsilons. |
|
439 self assert: fsa hasDistinctRetvals not. |
|
440 |
|
441 self failScan: ''. |
|
442 self failScan: 'b'. |
|
443 |
|
444 self scan: 'a' token: #token1 position: 1. |
|
445 self scan: 'a' token: #token2 position: 1. |
|
446 self scan: 'aaa' token: #token1 position: 1. |
|
447 self scan: 'aaa' token: #token2 position: 1. |
|
448 ! |
|
449 |
|
450 testAplus_BOrAplus_Bnot |
|
451 parser1 := $a asParser plus, $b asParser. |
|
452 parser2 := $a asParser plus, $b asParser not. |
|
453 |
|
454 self compileMerge. |
|
455 |
|
456 self assert: fsa isDeterministic. |
|
457 self assert: fsa isWithoutEpsilons. |
|
458 |
|
459 self failScan: 'aaa' token: #token1. |
|
460 self scan: 'aaa' token: #token2 position: 3. |
|
461 |
|
462 self scan: 'aaab' token: #token1 position: 4. |
|
463 self failScan: 'aaab' token: #token2. |
|
464 ! |
|
465 |
|
466 testAuorAplus |
|
467 parser1 := 'a' asParser. |
|
468 parser2 := 'a' asParser plus. |
|
469 |
|
470 self compileMerge. |
|
471 |
|
472 self assert: fsa isDeterministic. |
|
473 self assert: fsa isWithoutEpsilons. |
|
474 self assert: fsa hasDistinctRetvals not. |
|
475 |
|
476 self failScan: 'b' token: #token1. |
|
477 self failScan: 'b' token: #token2. |
|
478 |
|
479 self failScan: '' token: #token1. |
|
480 self failScan: '' token: #token2. |
|
481 |
|
482 self scan: 'a' token: #token1 position: 1. |
|
483 self scan: 'a' token: #token2 position: 1. |
|
484 |
|
485 self scan: 'aaa' token: #token1 position: 1. |
|
486 self scan: 'aaa' token: #token2 position: 3. |
|
487 ! |
|
488 |
|
489 testKeywordOrUnary |
|
490 parser1 := #letter asParser plus, $: asParser. |
|
491 parser2 := #letter asParser plus, $: asParser not. |
|
492 |
|
493 self compileMerge. |
|
494 |
|
495 self assert: fsa isDeterministic. |
|
496 self assert: fsa isWithoutEpsilons. |
|
497 |
|
498 self failScan: 'false' token: #token1. |
|
499 self scan: 'false' token: #token2 position: 5. |
|
500 |
|
501 self scan: 'false:' token: #token1 position: 6. |
|
502 self failScan: 'false:' token: #token2. |
|
503 ! |
|
504 |
|
505 testTrueOrId |
|
506 parser1 := 'true' asParser. |
|
507 parser2 := #letter asParser plus. |
|
508 |
|
509 self compileMerge. |
|
510 |
|
511 self assert: fsa isDeterministic. |
|
512 self assert: fsa isWithoutEpsilons. |
|
513 self assert: fsa hasDistinctRetvals not. |
|
514 |
|
515 self failScan: 'false' token: #token1. |
|
516 self scan: 'false' token: #token2 position: 5. |
|
517 |
|
518 self scan: 'true' token: #token1 position: 4. |
|
519 self scan: 'true' token: #token2 position: 4. |
|
520 |
|
521 self scan: 'truecrypt' token: #token1 position: 4. |
|
522 self scan: 'truecrypt' token: #token2 position: 9. |
|
523 |
|
524 ! ! |
|
525 |
|
526 !PEGFsaScannerIntegrationTest methodsFor:'smalltalk'! |
|
527 |
|
528 testStIdentifier |
|
529 parser := (PPPredicateObjectParser |
|
530 on: [ :each | each isLetter or: [ each = $_ ] ] |
|
531 message: 'letter expected') , |
|
532 (PPPredicateObjectParser |
|
533 on: [ :each | each isAlphaNumeric or: [ each = $_ ] ] |
|
534 message: 'letter or digit expected') star. |
|
535 |
|
536 self compile. |
|
537 |
|
538 self assert: fsa isDeterministic. |
|
539 self assert: fsa isWithoutEpsilons. |
|
540 |
|
541 self failScan: ''. |
|
542 self failScan: '23ab'. |
|
543 |
|
544 self scan: 'fooBar' token: #token. |
|
545 self scan: 'foo_bar' token: #token. |
|
546 ! |
|
547 |
|
548 testStKeyword |
|
549 | identifier | |
|
550 identifier := (PPPredicateObjectParser |
|
551 on: [ :each | each isLetter or: [ each = $_ ] ] |
|
552 message: 'letter expected') , |
|
553 (PPPredicateObjectParser |
|
554 on: [ :each | each isAlphaNumeric or: [ each = $_ ] ] |
|
555 message: 'letter or digit expected') star. |
|
556 parser := identifier, $: asParser. |
|
557 |
|
558 self compile. |
|
559 |
|
560 self assert: fsa isDeterministic. |
|
561 self assert: fsa isWithoutEpsilons. |
|
562 |
|
563 self failScan: 'fooBar'. |
|
564 |
|
565 |
|
566 self scan: 'fooBar:' token: #token. |
|
567 self scan: 'foo_bar:' token: #token. |
|
568 ! |
|
569 |
|
570 testStString |
|
571 parser := $' asParser , ('''''' asParser / $' asParser negate) star , $' asParser. |
|
572 |
|
573 self compile. |
|
574 |
|
575 self assert: fsa isDeterministic. |
|
576 self assert: fsa isWithoutEpsilons. |
|
577 |
|
578 self failScan: ''. |
|
579 self failScan: 'b'. |
|
580 |
|
581 self scan: '''hi there''' token: #token. |
|
582 ! ! |
|
583 |
|
584 !PEGFsaScannerIntegrationTest methodsFor:'support'! |
|
585 |
|
586 compile |
|
587 | ppcTree | |
|
588 compiled ifTrue: [ ^ self ]. |
|
589 |
|
590 ppcTree := parser asCompilerTree. |
|
591 fsa := ppcTree asFsa. |
|
592 fsa retval: #token. |
|
593 fsa determinize. |
|
594 |
|
595 self generate |
|
596 ! |
|
597 |
|
598 compileMerge |
|
599 | ppcTree1 ppcTree2 fsa1 fsa2 | |
|
600 compiled ifTrue: [ ^ self ]. |
|
601 |
|
602 ppcTree1 := parser1 asCompilerTree. |
|
603 ppcTree2 := parser2 asCompilerTree. |
|
604 |
|
605 fsa1 := ppcTree1 asFsa. |
|
606 fsa1 retval: #token1. |
|
607 fsa2 := ppcTree2 asFsa. |
|
608 fsa2 retval: #token2. |
|
609 |
|
610 fsa := self mergeFsa: fsa1 and: fsa2. |
|
611 |
|
612 self generate. |
|
613 ! |
|
614 |
|
615 failScan: stream |
|
616 self compile. |
|
617 |
|
618 scanner initialize. |
|
619 scanner stream: stream asPetitStream. |
|
620 scanner nextToken. |
|
621 |
|
622 result := scanner polyResult. |
|
623 |
|
624 |
|
625 self assert: result isEmpty |
|
626 ! |
|
627 |
|
628 failScan: stream token: token |
|
629 self compile. |
|
630 |
|
631 scanner initialize. |
|
632 scanner stream: stream asPetitStream. |
|
633 scanner nextToken. |
|
634 |
|
635 result := scanner polyResult. |
|
636 |
|
637 |
|
638 self assert: ((result includesKey: token) not) |
|
639 ! |
|
640 |
|
641 generate |
|
642 fsa name: #nextToken. |
|
643 |
|
644 scanner := ((PPCScannerCodeGenerator new) |
|
645 generateAndCompile: fsa). |
|
646 |
|
647 compiled := true |
|
648 ! |
|
649 |
|
650 mergeFsa: fsa1 and: fsa2 |
|
651 | startState | |
|
652 fsa := PEGFsa new. |
|
653 startState := PEGFsaState new. |
|
654 |
|
655 fsa addState: startState. |
|
656 fsa startState: startState. |
|
657 |
|
658 fsa adopt: fsa1. |
|
659 fsa addTransitionFrom: startState to: fsa1 startState. |
|
660 |
|
661 fsa adopt: fsa2. |
|
662 fsa addTransitionFrom: startState to: fsa2 startState. |
|
663 |
|
664 fsa determinizeStandard. |
|
665 ^ fsa |
|
666 ! |
|
667 |
|
668 scan: stream token: token |
|
669 self scan: stream token: token position: stream size. |
|
670 ! |
|
671 |
|
672 scan: stream token: token position: position |
|
673 self compile. |
|
674 |
|
675 scanner stream: stream asPetitStream. |
|
676 scanner nextToken. |
|
677 |
|
678 result := scanner polyResult. |
|
679 |
|
680 self assert: result isCollection description: 'no collection returned as a result!!'. |
|
681 self assert: (result isEmpty not) description: 'no token found'. |
|
682 self assert: (result at: token) = position. |
|
683 ! |
|
684 |
|
685 setUp |
|
686 compiled := false. |
|
687 fsaGenerator := PEGFsaGenerator new. |
|
688 ! ! |
|
689 |