1 "{ Package: 'stx:goodies/petitparser/compiler/tests' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 PPAbstractParserTest subclass:#PPCVerificationTest |
|
6 instanceVariableNames:'parser result context resource' |
|
7 classVariableNames:'' |
|
8 poolDictionaries:'' |
|
9 category:'PetitCompiler-Tests-Core' |
|
10 ! |
|
11 |
|
12 |
|
13 !PPCVerificationTest class methodsFor:'as yet unclassified'! |
|
14 |
|
15 resources |
|
16 ^ (OrderedCollection with: PPCompiledJavaResource with: PPCompiledSmalltalkGrammarResource) |
|
17 addAll: super resources; |
|
18 yourself |
|
19 ! ! |
|
20 |
|
21 !PPCVerificationTest methodsFor:'tests - verification Java'! |
|
22 |
|
23 compiledJavaSyntax |
|
24 ^ (Smalltalk at: #PPCompiledJavaSyntax) new |
|
25 ! |
|
26 |
|
27 compiledSmalltalkGrammar |
|
28 ^ (Smalltalk at: #PPCompiledSmalltalkGrammar) new |
|
29 ! |
|
30 |
|
31 context |
|
32 ^ context := PPCProfilingContext new |
|
33 ! |
|
34 |
|
35 javaSyntax |
|
36 ^ PPJavaSyntax new |
|
37 ! |
|
38 |
|
39 setUp |
|
40 super setUp. |
|
41 ! |
|
42 |
|
43 smalltalkGrammar |
|
44 ^ PPSmalltalkGrammar new |
|
45 ! |
|
46 |
|
47 testJava |
|
48 | compiledParser normalParser | |
|
49 normalParser := self javaSyntax. |
|
50 compiledParser := self compiledJavaSyntax. |
|
51 |
|
52 PPCBenchmarkResources new javaSourcesBig do: [ :source | |
|
53 result := normalParser parse: source. |
|
54 result isPetitFailure not ifTrue: [ |
|
55 self assert: (compiledParser parse: source withContext: self context) |
|
56 equals: result |
|
57 ] |
|
58 ]. |
|
59 ! |
|
60 |
|
61 testJavaTimer |
|
62 | compiledParser normalParser source | |
|
63 normalParser := self javaSyntax. |
|
64 |
|
65 source := (FileStream fileNamed: '../java-src/java/util/Timer.java') asString. |
|
66 result := normalParser parse: source. |
|
67 |
|
68 result isPetitFailure not ifTrue: [ |
|
69 compiledParser := self compiledJavaSyntax. |
|
70 self assert: (compiledParser parse: source withContext: self context) |
|
71 equals: result |
|
72 ] |
|
73 |
|
74 "Modified: / 05-05-2015 / 16:20:21 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
75 ! ! |
|
76 |
|
77 !PPCVerificationTest methodsFor:'tests - verification Smalltalk'! |
|
78 |
|
79 testSmalltalk |
|
80 | compiledParser normalParser expected actual | |
|
81 normalParser := self smalltalkGrammar. |
|
82 compiledParser := self compiledSmalltalkGrammar. |
|
83 |
|
84 PPCBenchmarkResources new smalltalkSourcesBig do: [ :source | |
|
85 expected := normalParser parse: source. |
|
86 expected isPetitFailure ifFalse: [ |
|
87 actual := (compiledParser parse: source withContext: self context). |
|
88 self assert: expected equals: actual. |
|
89 ] |
|
90 ]. |
|
91 ! |
|
92 |
|
93 testSmalltalkClass |
|
94 | compiledParser normalParser source | |
|
95 |
|
96 normalParser := self smalltalkGrammar. |
|
97 compiledParser := self compiledSmalltalkGrammar. |
|
98 Class methodDictionary do: [ :m | |
|
99 source := m sourceCode. |
|
100 ((Smalltalk respondsTo: #isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ |
|
101 m hasPrimitiveCode ifTrue:[ |
|
102 source := nil. |
|
103 ] |
|
104 ]. |
|
105 source notNil ifTrue:[ |
|
106 self assert: (normalParser parse: source) |
|
107 equals: (compiledParser parse: source withContext: self context). |
|
108 ] |
|
109 ]. |
|
110 |
|
111 "Modified: / 05-05-2015 / 16:21:31 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
112 ! |
|
113 |
|
114 testSmalltalkObject |
|
115 | compiledParser normalParser source | |
|
116 |
|
117 normalParser := self smalltalkGrammar. |
|
118 compiledParser := self compiledSmalltalkGrammar. |
|
119 Object methodDictionary do: [ :m | |
|
120 source := m sourceCode. |
|
121 ((Smalltalk respondsTo: #isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ |
|
122 m hasPrimitiveCode ifTrue:[ |
|
123 source := nil. |
|
124 ] |
|
125 ]. |
|
126 source notNil ifTrue:[ |
|
127 self assert: (normalParser parse: source) |
|
128 equals: (compiledParser parse: source withContext: self context). |
|
129 ] |
|
130 ]. |
|
131 |
|
132 "Modified (format): / 05-05-2015 / 16:22:49 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
133 ! ! |
|
134 |
|
135 !PPCVerificationTest class methodsFor:'documentation'! |
|
136 |
|
137 version_HG |
|
138 |
|
139 ^ '$Changeset: <not expanded> $' |
|
140 ! ! |
|
141 |
|