1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 PPAbstractParserTest subclass:#PPCCompilerTest |
|
6 instanceVariableNames:'parser result context node compiler id node2 id2 id1 node1 node3 |
|
7 arguments configuration' |
|
8 classVariableNames:'' |
|
9 poolDictionaries:'' |
|
10 category:'PetitCompiler-Tests-Core' |
|
11 ! |
|
12 |
|
13 |
|
14 !PPCCompilerTest methodsFor:'as yet unclassified'! |
|
15 |
|
16 assert: p parse: whatever |
|
17 ^ result := super assert: p parse: whatever. |
|
18 ! |
|
19 |
|
20 context |
|
21 ^ context := PPCProfilingContext new |
|
22 ! |
|
23 |
|
24 setUp |
|
25 arguments := PPCArguments default |
|
26 profile: true; |
|
27 yourself. |
|
28 |
|
29 configuration := PPCUniversalConfiguration new |
|
30 arguments: arguments; |
|
31 yourself. |
|
32 ! |
|
33 |
|
34 tearDown |
|
35 | parserClass | |
|
36 |
|
37 parserClass := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]). |
|
38 parserClass notNil ifTrue:[ |
|
39 parserClass removeFromSystem |
|
40 ]. |
|
41 ! ! |
|
42 |
|
43 !PPCCompilerTest methodsFor:'tests - guard'! |
|
44 |
|
45 testChoiceGuard |
|
46 parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken plus) |
|
47 compileWithConfiguration: configuration. |
|
48 |
|
49 self assert: parser parse: 'foo'. |
|
50 self assert: result inputValue = 'foo'. |
|
51 self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'token' ]). |
|
52 |
|
53 self assert: parser parse: 'bar'. |
|
54 self assert: result inputValue = 'bar'. |
|
55 |
|
56 self assert: parser parse: ' foo'. |
|
57 self assert: result inputValue = 'foo'. |
|
58 |
|
59 self assert: parser parse: ' d'. |
|
60 self assert: result first inputValue = 'd'. |
|
61 |
|
62 self assert: parser fail: ''. |
|
63 self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'predicate' ]). |
|
64 self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]). |
|
65 |
|
66 self assert: parser fail: 'zorg'. |
|
67 self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]). |
|
68 ! |
|
69 |
|
70 testEmptyChoiceGuard |
|
71 parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken star) |
|
72 compileWithConfiguration: configuration. |
|
73 |
|
74 self assert: parser parse: 'foo'. |
|
75 self assert: result inputValue = 'foo'. |
|
76 |
|
77 self assert: parser parse: 'bar'. |
|
78 self assert: result inputValue = 'bar'. |
|
79 |
|
80 self assert: parser parse: ' foo'. |
|
81 self assert: result inputValue = 'foo'. |
|
82 |
|
83 self assert: parser parse: ' d'. |
|
84 self assert: result first inputValue = 'd'. |
|
85 |
|
86 self assert: parser parse: ''. |
|
87 |
|
88 self assert: parser parse: 'zorg' end: 0. |
|
89 ! |
|
90 |
|
91 testGuardSmalltlakToken |
|
92 parser := (#letter asParser, #word asParser star) smalltalkToken compileWithConfiguration: configuration. |
|
93 |
|
94 self assert: parser parse: 'bar'. |
|
95 self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'seq' ]). |
|
96 |
|
97 self assert: parser fail: '123'. |
|
98 self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'seq' ]). |
|
99 ! |
|
100 |
|
101 testSequenceGuard |
|
102 parser := ((#any asParser, #any asParser) wrapped, (#any asParser, #any asParser)) compileWithConfiguration: configuration. |
|
103 |
|
104 self assert: parser parse: 'fooo' to: #(#($f $o) #($o $o)). |
|
105 self assert: parser parse: 'fo oo' to: #(#($f $o) #($ $o)) end: 4. |
|
106 self assert: parser fail: 'fo'. |
|
107 |
|
108 ! |
|
109 |
|
110 testTrimmerGuard |
|
111 parser := $a asParser trim, $b asParser compileWithConfiguration: configuration. |
|
112 |
|
113 self assert: parser parse: 'ab'. |
|
114 self assert: parser parse: ' ab'. |
|
115 ! ! |
|
116 |
|
117 !PPCCompilerTest class methodsFor:'documentation'! |
|
118 |
|
119 version_HG |
|
120 |
|
121 ^ '$Changeset: <not expanded> $' |
|
122 ! ! |
|
123 |
|