|
1 "{ Package: 'stx:goodies/sunit' }" |
|
2 |
|
3 ApplicationModel subclass:#TestTester |
|
4 instanceVariableNames:'currentSource testCaseClassListApp testCaseMethodListApp |
|
5 testeeClassListApp testeeMethodListApp selectedTesteeClasses |
|
6 selectedTesteeMethods selectedTestCaseClasses |
|
7 selectedTestCaseMethods testeeMethodListHolder |
|
8 testCaseSourceHolder mutatedMethodSourceHolder |
|
9 originalMethodSourceHolder testCaseClassGeneratorHolder |
|
10 selectedTesteeMethod selectedTestCaseClass infoLabelHolder |
|
11 diffTextView numberOfTriedMutations' |
|
12 classVariableNames:'' |
|
13 poolDictionaries:'' |
|
14 category:'SUnit-UI' |
|
15 ! |
|
16 |
|
17 Object subclass:#Mutator |
|
18 instanceVariableNames:'blockToCall treeTop' |
|
19 classVariableNames:'' |
|
20 poolDictionaries:'' |
|
21 privateIn:TestTester |
|
22 ! |
|
23 |
|
24 |
|
25 !TestTester class methodsFor:'interface specs'! |
|
26 |
|
27 windowSpec |
|
28 "This resource specification was automatically generated |
|
29 by the UIPainter of ST/X." |
|
30 |
|
31 "Do not manually edit this!! If it is corrupted, |
|
32 the UIPainter may not be able to read the specification." |
|
33 |
|
34 " |
|
35 UIPainter new openOnClass:TestTester andSelector:#windowSpec |
|
36 TestTester new openInterface:#windowSpec |
|
37 TestTester open |
|
38 " |
|
39 |
|
40 <resource: #canvas> |
|
41 |
|
42 ^ |
|
43 #(FullSpec |
|
44 name: windowSpec |
|
45 window: |
|
46 (WindowSpec |
|
47 label: 'TestTester' |
|
48 name: 'TestTester' |
|
49 min: (Point 10 10) |
|
50 max: (Point 1024 768) |
|
51 bounds: (Rectangle 0 0 554 504) |
|
52 menu: mainMenu |
|
53 ) |
|
54 component: |
|
55 (SpecCollection |
|
56 collection: ( |
|
57 (MenuPanelSpec |
|
58 name: 'ToolBar1' |
|
59 layout: (LayoutFrame 0 0.0 0 0 0 1.0 36 0) |
|
60 menu: toolbarMenu |
|
61 textDefault: true |
|
62 ) |
|
63 (ViewSpec |
|
64 name: 'Box4' |
|
65 layout: (LayoutFrame 0 0 36 0 0 1 -26 1) |
|
66 component: |
|
67 (SpecCollection |
|
68 collection: ( |
|
69 (ViewSpec |
|
70 name: 'TestedMethodSelectionBox' |
|
71 layout: (LayoutFrame 0 0 0 0 0 0.4 0 0.5) |
|
72 component: |
|
73 (SpecCollection |
|
74 collection: ( |
|
75 (LabelSpec |
|
76 label: 'Tested Method' |
|
77 name: 'Label4' |
|
78 layout: (LayoutFrame 0 0.0 0 0 0 1.0 22 0) |
|
79 translateLabel: true |
|
80 ) |
|
81 (SubCanvasSpec |
|
82 name: 'TestedMethodClassList' |
|
83 layout: (LayoutFrame 0 0 22 0 0 0.5 0 1) |
|
84 hasHorizontalScrollBar: false |
|
85 hasVerticalScrollBar: false |
|
86 majorKey: #'Tools::ClassList' |
|
87 subAspectHolders: |
|
88 (Array |
|
89 |
|
90 (SubChannelInfoSpec |
|
91 subAspect: selectedClasses |
|
92 aspect: selectedTesteeClasses |
|
93 ) |
|
94 ) |
|
95 createNewApplication: true |
|
96 createNewBuilder: true |
|
97 postBuildCallback: postBuildTestedClassList: |
|
98 ) |
|
99 (SubCanvasSpec |
|
100 name: 'TestedMethodMethodList' |
|
101 layout: (LayoutFrame 0 0.5 22 0 0 1 0 1) |
|
102 hasHorizontalScrollBar: false |
|
103 hasVerticalScrollBar: false |
|
104 majorKey: #'Tools::MethodList' |
|
105 subAspectHolders: |
|
106 (Array |
|
107 |
|
108 (SubChannelInfoSpec |
|
109 subAspect: inGeneratorHolder |
|
110 aspect: testeeMethodListHolder |
|
111 ) |
|
112 (SubChannelInfoSpec |
|
113 subAspect: selectedMethods |
|
114 aspect: selectedTesteeMethods |
|
115 ) |
|
116 ) |
|
117 createNewApplication: true |
|
118 createNewBuilder: true |
|
119 postBuildCallback: postBuildTestedMethodList: |
|
120 ) |
|
121 ) |
|
122 |
|
123 ) |
|
124 ) |
|
125 (LabelSpec |
|
126 label: 'Original' |
|
127 name: 'Label5' |
|
128 layout: (LayoutFrame 0 0.4 0 0 0 0.7 22 0) |
|
129 translateLabel: true |
|
130 ) |
|
131 (TextEditorSpec |
|
132 name: 'OriginalMethodEditor' |
|
133 layout: (LayoutFrame 0 0.4 22 0 0 0.7 0 0.5) |
|
134 model: originalMethodSourceHolder |
|
135 hasHorizontalScrollBar: true |
|
136 hasVerticalScrollBar: true |
|
137 hasKeyboardFocusInitially: false |
|
138 ) |
|
139 (LabelSpec |
|
140 label: 'Mutation' |
|
141 name: 'Label6' |
|
142 layout: (LayoutFrame 0 0.7 0 0 0 1 22 0) |
|
143 translateLabel: true |
|
144 ) |
|
145 (TextEditorSpec |
|
146 name: 'MutatedMethodEditor' |
|
147 layout: (LayoutFrame 0 0.7 22 0 0 1 0 0.5) |
|
148 model: mutatedMethodSourceHolder |
|
149 hasHorizontalScrollBar: true |
|
150 hasVerticalScrollBar: true |
|
151 hasKeyboardFocusInitially: false |
|
152 ) |
|
153 (ViewSpec |
|
154 name: 'TestSuiteSelectionBox' |
|
155 layout: (LayoutFrame 0 0 0 0.5 0 0.4 0 1) |
|
156 component: |
|
157 (SpecCollection |
|
158 collection: ( |
|
159 (LabelSpec |
|
160 label: 'TestCase' |
|
161 name: 'Label3' |
|
162 layout: (LayoutFrame 0 0.0 0 0 0 1.0 22 0) |
|
163 translateLabel: true |
|
164 ) |
|
165 (SubCanvasSpec |
|
166 name: 'TestCaseClassList' |
|
167 layout: (LayoutFrame 0 0 22 0 0 1 0 1) |
|
168 hasHorizontalScrollBar: false |
|
169 hasVerticalScrollBar: false |
|
170 majorKey: #'Tools::ClassList' |
|
171 subAspectHolders: |
|
172 (Array |
|
173 |
|
174 (SubChannelInfoSpec |
|
175 subAspect: inGeneratorHolder |
|
176 aspect: testCaseClassGeneratorHolder |
|
177 ) |
|
178 (SubChannelInfoSpec |
|
179 subAspect: selectedClasses |
|
180 aspect: selectedTestCaseClasses |
|
181 ) |
|
182 ) |
|
183 createNewApplication: true |
|
184 createNewBuilder: true |
|
185 postBuildCallback: postBuildTestCaseClassList: |
|
186 ) |
|
187 ) |
|
188 |
|
189 ) |
|
190 ) |
|
191 (LabelSpec |
|
192 name: 'Label7' |
|
193 layout: (LayoutFrame 0 0.5 0 0.5 0 1 22 0.5) |
|
194 translateLabel: true |
|
195 ) |
|
196 (TextEditorSpec |
|
197 name: 'TextCaseEditor1' |
|
198 layout: (LayoutFrame 0 0.4 22 0.5 0 1 0 1) |
|
199 model: testCaseSourceHolder |
|
200 hasHorizontalScrollBar: true |
|
201 hasVerticalScrollBar: true |
|
202 hasKeyboardFocusInitially: false |
|
203 ) |
|
204 (ArbitraryComponentSpec |
|
205 name: 'ArbitraryComponent1' |
|
206 layout: (LayoutFrame 0 0.4 0 0 0 1 0 0.5) |
|
207 hasHorizontalScrollBar: true |
|
208 hasVerticalScrollBar: true |
|
209 miniScrollerHorizontal: true |
|
210 component: DiffTextView |
|
211 postBuildCallback: postBuildDiffTextView: |
|
212 ) |
|
213 ) |
|
214 |
|
215 ) |
|
216 ) |
|
217 (ViewSpec |
|
218 name: 'Box2' |
|
219 layout: (LayoutFrame 0 0 -26 1 0 1 0 1) |
|
220 level: 1 |
|
221 component: |
|
222 (SpecCollection |
|
223 collection: ( |
|
224 (LabelSpec |
|
225 label: 'InfoLabel' |
|
226 name: 'Label2' |
|
227 layout: (LayoutFrame 0 0 -26 1 -1 1 0 1) |
|
228 level: -1 |
|
229 translateLabel: true |
|
230 labelChannel: infoLabelHolder |
|
231 adjust: left |
|
232 ) |
|
233 ) |
|
234 |
|
235 ) |
|
236 ) |
|
237 ) |
|
238 |
|
239 ) |
|
240 ) |
|
241 ! ! |
|
242 |
|
243 !TestTester class methodsFor:'menu specs'! |
|
244 |
|
245 mainMenu |
|
246 "This resource specification was automatically generated |
|
247 by the MenuEditor of ST/X." |
|
248 |
|
249 "Do not manually edit this!! If it is corrupted, |
|
250 the MenuEditor may not be able to read the specification." |
|
251 |
|
252 " |
|
253 MenuEditor new openOnClass:TestTester andSelector:#mainMenu |
|
254 (Menu new fromLiteralArrayEncoding:(TestTester mainMenu)) startUp |
|
255 " |
|
256 |
|
257 <resource: #menu> |
|
258 |
|
259 ^ |
|
260 #(Menu |
|
261 ( |
|
262 (MenuItem |
|
263 label: 'File' |
|
264 translateLabel: true |
|
265 submenu: |
|
266 (Menu |
|
267 ( |
|
268 (MenuItem |
|
269 label: 'Exit' |
|
270 itemValue: closeRequest |
|
271 translateLabel: true |
|
272 ) |
|
273 ) |
|
274 nil |
|
275 nil |
|
276 ) |
|
277 ) |
|
278 (MenuItem |
|
279 label: 'Help' |
|
280 translateLabel: true |
|
281 startGroup: right |
|
282 submenu: |
|
283 (Menu |
|
284 ( |
|
285 (MenuItem |
|
286 label: 'Documentation' |
|
287 itemValue: openDocumentation |
|
288 translateLabel: true |
|
289 ) |
|
290 (MenuItem |
|
291 label: '-' |
|
292 ) |
|
293 (MenuItem |
|
294 label: 'About this Application...' |
|
295 itemValue: openAboutThisApplication |
|
296 translateLabel: true |
|
297 ) |
|
298 ) |
|
299 nil |
|
300 nil |
|
301 ) |
|
302 ) |
|
303 ) |
|
304 nil |
|
305 nil |
|
306 ) |
|
307 ! |
|
308 |
|
309 toolbarMenu |
|
310 "This resource specification was automatically generated |
|
311 by the MenuEditor of ST/X." |
|
312 |
|
313 "Do not manually edit this!! If it is corrupted, |
|
314 the MenuEditor may not be able to read the specification." |
|
315 |
|
316 " |
|
317 MenuEditor new openOnClass:TestTester andSelector:#toolbarMenu |
|
318 (Menu new fromLiteralArrayEncoding:(TestTester toolbarMenu)) startUp |
|
319 " |
|
320 |
|
321 <resource: #menu> |
|
322 |
|
323 ^ |
|
324 #(Menu |
|
325 ( |
|
326 (MenuItem |
|
327 label: 'RunCheck' |
|
328 itemValue: menuRunCheck |
|
329 translateLabel: true |
|
330 isButton: true |
|
331 labelImage: (ResourceRetriever ToolbarIconLibrary make22x22Icon) |
|
332 ) |
|
333 ) |
|
334 nil |
|
335 nil |
|
336 ) |
|
337 ! ! |
|
338 |
|
339 !TestTester methodsFor:'aspects'! |
|
340 |
|
341 infoLabelHolder |
|
342 infoLabelHolder isNil ifTrue:[ |
|
343 infoLabelHolder := ValueHolder new. |
|
344 ]. |
|
345 ^ infoLabelHolder |
|
346 |
|
347 "Created: / 25-04-2010 / 21:01:00 / cg" |
|
348 ! |
|
349 |
|
350 mutatedMethodSourceHolder |
|
351 mutatedMethodSourceHolder isNil ifTrue:[ |
|
352 mutatedMethodSourceHolder := ValueHolder new. |
|
353 ]. |
|
354 ^ mutatedMethodSourceHolder |
|
355 |
|
356 "Created: / 25-04-2010 / 15:53:44 / cg" |
|
357 ! |
|
358 |
|
359 originalMethodSourceHolder |
|
360 originalMethodSourceHolder isNil ifTrue:[ |
|
361 originalMethodSourceHolder := ValueHolder new. |
|
362 ]. |
|
363 ^ originalMethodSourceHolder |
|
364 |
|
365 "Created: / 25-04-2010 / 15:53:58 / cg" |
|
366 ! |
|
367 |
|
368 selectedTestCaseClasses |
|
369 selectedTestCaseClasses isNil ifTrue:[ |
|
370 selectedTestCaseClasses := ValueHolder new. |
|
371 selectedTestCaseClasses onChangeSend:#selectedTestCaseClassesChanged to:self. |
|
372 ]. |
|
373 ^ selectedTestCaseClasses |
|
374 |
|
375 "Created: / 25-04-2010 / 16:23:56 / cg" |
|
376 ! |
|
377 |
|
378 selectedTesteeClasses |
|
379 selectedTesteeClasses isNil ifTrue:[ |
|
380 selectedTesteeClasses := ValueHolder new. |
|
381 selectedTesteeClasses onChangeSend:#selectedTesteeClassesChanged to:self. |
|
382 ]. |
|
383 ^ selectedTesteeClasses |
|
384 |
|
385 "Created: / 25-04-2010 / 14:00:14 / cg" |
|
386 ! |
|
387 |
|
388 selectedTesteeMethods |
|
389 selectedTesteeMethods isNil ifTrue:[ |
|
390 selectedTesteeMethods := ValueHolder new. |
|
391 selectedTesteeMethods onChangeSend:#selectedTesteeMethodsChanged to:self. |
|
392 ]. |
|
393 ^ selectedTesteeMethods |
|
394 |
|
395 "Created: / 25-04-2010 / 15:50:10 / cg" |
|
396 ! |
|
397 |
|
398 testCaseClassGeneratorHolder |
|
399 testCaseClassGeneratorHolder isNil ifTrue:[ |
|
400 testCaseClassGeneratorHolder := ValueHolder new. |
|
401 ]. |
|
402 ^ testCaseClassGeneratorHolder |
|
403 |
|
404 "Created: / 25-04-2010 / 16:01:28 / cg" |
|
405 ! |
|
406 |
|
407 testCaseSourceHolder |
|
408 testCaseSourceHolder isNil ifTrue:[ |
|
409 testCaseSourceHolder := ValueHolder new. |
|
410 ]. |
|
411 ^ testCaseSourceHolder |
|
412 |
|
413 "Created: / 25-04-2010 / 15:53:07 / cg" |
|
414 ! |
|
415 |
|
416 testeeMethodListHolder |
|
417 testeeMethodListHolder isNil ifTrue:[ |
|
418 testeeMethodListHolder := ValueHolder new. |
|
419 ]. |
|
420 ^ testeeMethodListHolder |
|
421 |
|
422 "Created: / 25-04-2010 / 14:05:25 / cg" |
|
423 ! ! |
|
424 |
|
425 !TestTester methodsFor:'helpers'! |
|
426 |
|
427 mutationsOf:aTree do:aBlock |
|
428 (Mutator new) mutationsOf:aTree do:aBlock |
|
429 "/ aTree acceptVisitor:(Mutator forBlock:aBlock). |
|
430 |
|
431 " |
|
432 self new |
|
433 testMethod:(Integer >> #factorial) |
|
434 usingTest:RegressionTests::IntegerTest |
|
435 selector:#testFactorial |
|
436 " |
|
437 |
|
438 "Created: / 24-04-2010 / 16:22:51 / cg" |
|
439 "Modified: / 24-04-2010 / 18:12:48 / cg" |
|
440 ! |
|
441 |
|
442 runSuiteExpectingFailure:aTestSuite |
|
443 |result| |
|
444 |
|
445 result := aTestSuite run. |
|
446 "/ result errorCount > 0 ifTrue:[self halt]. |
|
447 |
|
448 self |
|
449 assert:result runCount > 0; |
|
450 "/ assert:(result passedCount = 0) message:'test should not have passed'; |
|
451 assert:((result failureCount + result errorCount) > 0) |
|
452 message:'some test should have failed'. |
|
453 |
|
454 "Created: / 24-04-2010 / 16:17:47 / cg" |
|
455 "Modified: / 25-04-2010 / 21:23:16 / cg" |
|
456 ! |
|
457 |
|
458 runSuiteExpectingSuccess:aTestSuite |
|
459 |result| |
|
460 |
|
461 result := aTestSuite run. |
|
462 result errorCount > 0 ifTrue:[self halt]. |
|
463 |
|
464 self |
|
465 assert:result runCount > 0; |
|
466 assert:(result passedCount > 0) message:'all tests should have passed'; |
|
467 assert:(result failureCount = 0) message:'no test should have failed'; |
|
468 assert:(result errorCount = 0) message:'no test should have errors'. |
|
469 |
|
470 "Modified: / 25-04-2010 / 21:18:30 / cg" |
|
471 ! |
|
472 |
|
473 withCode:newSource installedAs:selector inClass:aClass do:aBlock |
|
474 |oldMethod newMethod| |
|
475 |
|
476 oldMethod := aClass compiledMethodAt:selector. |
|
477 newMethod := Compiler compile:newSource forClass:aClass install:false. |
|
478 |
|
479 [ |
|
480 "/ install new method |
|
481 aClass basicAddSelector:selector withMethod:newMethod. |
|
482 aBlock value:newMethod |
|
483 ] ensure:[ |
|
484 "/ restore original method |
|
485 aClass basicAddSelector:selector withMethod:oldMethod. |
|
486 ]. |
|
487 |
|
488 "Created: / 24-04-2010 / 16:26:00 / cg" |
|
489 ! ! |
|
490 |
|
491 !TestTester methodsFor:'initialization'! |
|
492 |
|
493 postBuildDiffTextView:aView |
|
494 diffTextView := aView |
|
495 |
|
496 "Created: / 26-04-2010 / 10:36:42 / cg" |
|
497 ! |
|
498 |
|
499 postBuildTestCaseClassList:aSubCanvas |
|
500 |classGenerator| |
|
501 |
|
502 classGenerator := |
|
503 Iterator |
|
504 on:[:whatToDo | |
|
505 TestCase allSubclasses |
|
506 select:[:cls | cls isAbstract not] |
|
507 thenDo:[:cls | |
|
508 whatToDo |
|
509 value:cls |
|
510 ]. |
|
511 ]. |
|
512 |
|
513 self testCaseClassGeneratorHolder value:classGenerator |
|
514 |
|
515 "Modified: / 25-04-2010 / 16:04:44 / cg" |
|
516 ! |
|
517 |
|
518 postBuildTestCaseMethodList:aSubCanvas |
|
519 testCaseMethodListApp := aSubCanvas |
|
520 |
|
521 "Created: / 25-04-2010 / 13:51:42 / cg" |
|
522 ! |
|
523 |
|
524 postBuildTestedClassList:aSubCanvas |
|
525 testeeClassListApp := aSubCanvas |
|
526 |
|
527 "Modified: / 25-04-2010 / 13:50:41 / cg" |
|
528 ! |
|
529 |
|
530 postBuildTestedMethodList:aSubCanvas |
|
531 testeeMethodListApp := aSubCanvas |
|
532 |
|
533 "Created: / 25-04-2010 / 13:50:58 / cg" |
|
534 ! |
|
535 |
|
536 postBuildWith:aBuilder |
|
537 "/ testCaseClassListApp inGeneratorHolder:[ Smalltalk allClasses ] |
|
538 |
|
539 "Created: / 25-04-2010 / 13:47:59 / cg" |
|
540 ! ! |
|
541 |
|
542 !TestTester methodsFor:'menu actions'! |
|
543 |
|
544 menuRunCheck |
|
545 AssertionFailedError handle:[:ex | |
|
546 self mutatedMethodSourceHolder value:ex parameter. |
|
547 self infoLabelHolder value:ex errorString. |
|
548 ] do:[ |
|
549 self withWaitCursorDo:[ |
|
550 self infoLabelHolder value:'Running Suite...'. |
|
551 self |
|
552 testMethod:(selectedTesteeMethod) |
|
553 usingTest:selectedTestCaseClass. |
|
554 self infoLabelHolder value:nil. |
|
555 ]. |
|
556 self mutatedMethodSourceHolder value:nil. |
|
557 ]. |
|
558 self updateDiffTextView. |
|
559 |
|
560 "Modified: / 26-04-2010 / 10:39:28 / cg" |
|
561 ! |
|
562 |
|
563 openAboutThisApplication |
|
564 "This method was generated by the Browser/CodeGeneratorTool. |
|
565 It will be invoked when the menu-item 'help-about' is selected." |
|
566 |
|
567 "/ could open a customized aboutBox here ... |
|
568 super openAboutThisApplication |
|
569 ! |
|
570 |
|
571 openDocumentation |
|
572 "This method was generated by the Browser/CodeGeneratorTool. |
|
573 It will be invoked when the menu-item 'help-documentation' is selected." |
|
574 |
|
575 "/ change below as required ... |
|
576 |
|
577 "/ to open an HTML viewer on some document (under 'doc/online/<language>/' ): |
|
578 self openDocumentationFile:'TOP.html'. |
|
579 |
|
580 "/ add application-specific help files under the 'doc/online/<language>/help/appName' |
|
581 "/ directory, and open a viewer with: |
|
582 "/ self openDocumentationFile:'help/<MyApplication>/TOP.html'. |
|
583 ! ! |
|
584 |
|
585 !TestTester methodsFor:'misc'! |
|
586 |
|
587 showAllClassesInNameSpaceOrganisation |
|
588 ^ true |
|
589 |
|
590 "Created: / 25-04-2010 / 13:56:24 / cg" |
|
591 ! ! |
|
592 |
|
593 !TestTester methodsFor:'testing methods'! |
|
594 |
|
595 testMethod:aMethod using:selector fromTest:aTestCaseClass |
|
596 "motivation: |
|
597 assuming that aTestCase is a good test for aMethod, |
|
598 any change in aMethod should be rewarded by a failing testRun." |
|
599 |
|
600 ^ self |
|
601 testMethod:aMethod |
|
602 usingTest:aTestCaseClass |
|
603 selectors:(aTestCaseClass testSelectors) |
|
604 |
|
605 "Modified: / 24-04-2010 / 14:03:57 / cg" |
|
606 ! |
|
607 |
|
608 testMethod:aMethod usingSuite:aTestSuite |
|
609 |tree newSource methodClass methodSelector| |
|
610 |
|
611 numberOfTriedMutations := 0. |
|
612 |
|
613 methodClass := aMethod mclass. |
|
614 methodSelector := aMethod selector. |
|
615 |
|
616 AssertionFailedError handle:[:ex | |
|
617 AssertionFailedError |
|
618 raiseWith:aMethod source |
|
619 errorString:'Test failed for original'. |
|
620 self mutatedMethodSourceHolder value:nil |
|
621 ] do:[ |
|
622 self runSuiteExpectingSuccess:aTestSuite. |
|
623 ]. |
|
624 tree := RBParser parseMethod:(aMethod source) onError:[:str :pos | nil ]. |
|
625 tree isNil ifTrue:[ |
|
626 self error:'cannot parse method'. |
|
627 ]. |
|
628 |
|
629 "/ just to make sure: check if compiled method behaves the same |
|
630 newSource := tree formattedCode. |
|
631 self withCode:newSource installedAs:methodSelector inClass:methodClass do:[:newMethod | |
|
632 self runSuiteExpectingSuccess:aTestSuite. |
|
633 ]. |
|
634 |
|
635 "/ start to fiddle with the code; the tests MUST detect each !! |
|
636 self mutationsOf:tree do:[:modifiedTree | |
|
637 newSource := modifiedTree formattedCode. |
|
638 self withCode:newSource installedAs:methodSelector inClass:methodClass do:[:newMethod | |
|
639 AssertionFailedError handle:[:ex | |
|
640 AssertionFailedError |
|
641 raiseWith:newSource |
|
642 errorString:ex errorString |
|
643 "/ 'TestCase incomplete - some test should fail'. |
|
644 ] do:[ |
|
645 numberOfTriedMutations := numberOfTriedMutations + 1. |
|
646 self runSuiteExpectingFailure:aTestSuite. |
|
647 ] |
|
648 ]. |
|
649 ]. |
|
650 |
|
651 " |
|
652 self new |
|
653 testMethod:(Integer >> #factorial) |
|
654 usingTest:RegressionTests::IntegerTest |
|
655 selector:#testFactorial |
|
656 " |
|
657 |
|
658 "Created: / 24-04-2010 / 14:06:07 / cg" |
|
659 "Modified: / 26-04-2010 / 10:40:22 / cg" |
|
660 ! |
|
661 |
|
662 testMethod:aMethod usingTest:aTestCaseClass |
|
663 "motivation: |
|
664 assuming that aTestCase is a good test for aMethod, |
|
665 any change in aMethod should be rewarded by a failing testRun." |
|
666 |
|
667 ^ self |
|
668 testMethod:aMethod |
|
669 usingTest:aTestCaseClass |
|
670 selectors:(aTestCaseClass testSelectors) |
|
671 |
|
672 " |
|
673 self new |
|
674 testMethod:(Integer >> #factorial) |
|
675 usingTest:RegressionTests::IntegerTest |
|
676 " |
|
677 |
|
678 "Created: / 25-04-2010 / 16:29:22 / cg" |
|
679 ! |
|
680 |
|
681 testMethod:aMethod usingTest:aTestCaseClass selector:selector |
|
682 "motivation: |
|
683 assuming that aTestCase is a good test for aMethod, |
|
684 any change in aMethod should be rewarded by a failing testRun." |
|
685 |
|
686 ^ self |
|
687 testMethod:aMethod |
|
688 usingTest:aTestCaseClass |
|
689 selectors:(Array with:selector) |
|
690 |
|
691 " |
|
692 self new |
|
693 testMethod:(Integer >> #factorial) |
|
694 usingTest:RegressionTests::IntegerTest |
|
695 selector:#testFactorial |
|
696 " |
|
697 |
|
698 "Created: / 24-04-2010 / 13:59:18 / cg" |
|
699 ! |
|
700 |
|
701 testMethod:aMethod usingTest:aTestCaseClass selectors:collectionOfSelectors |
|
702 "motivation: |
|
703 assuming that aTestCase is a good test for aMethod, |
|
704 any change in aMethod should be rewarded by a failing testRun." |
|
705 |
|
706 |suite| |
|
707 |
|
708 suite := TestSuite new. |
|
709 collectionOfSelectors do:[:selector | |
|
710 suite |
|
711 addTest: (aTestCaseClass selector: selector). |
|
712 ]. |
|
713 ^ self testMethod:aMethod usingSuite:suite |
|
714 |
|
715 " |
|
716 self new |
|
717 testMethod:(Integer >> #factorial) |
|
718 usingTest:RegressionTests::IntegerTest |
|
719 selector:#testFactorial |
|
720 " |
|
721 |
|
722 "Created: / 24-04-2010 / 14:03:09 / cg" |
|
723 ! ! |
|
724 |
|
725 !TestTester methodsFor:'user actions'! |
|
726 |
|
727 selectedTestCaseClassesChanged |
|
728 selectedTestCaseClass := selectedTestCaseClasses value firstIfEmpty:nil. |
|
729 |
|
730 "Created: / 25-04-2010 / 16:25:18 / cg" |
|
731 ! |
|
732 |
|
733 selectedTesteeClassesChanged |
|
734 |methodGenerator| |
|
735 |
|
736 methodGenerator := |
|
737 Iterator |
|
738 on:[:whatToDo | |
|
739 |methodClass| |
|
740 |
|
741 methodClass := self selectedTesteeClasses value first. |
|
742 methodClass methodDictionary |
|
743 keysAndValuesDo:[:methodSelector :method | |
|
744 whatToDo |
|
745 value:methodClass |
|
746 value:method category |
|
747 value:methodSelector |
|
748 value:method. |
|
749 ]. |
|
750 ]. |
|
751 |
|
752 self testeeMethodListHolder value:methodGenerator |
|
753 |
|
754 "Modified: / 25-04-2010 / 15:48:04 / cg" |
|
755 ! |
|
756 |
|
757 selectedTesteeMethodsChanged |
|
758 |methods method source| |
|
759 |
|
760 methods := self selectedTesteeMethods value. |
|
761 methods notEmpty ifTrue:[ |
|
762 method := methods first. |
|
763 source := method source. |
|
764 ]. |
|
765 self originalMethodSourceHolder value:source. |
|
766 |
|
767 self updateDiffTextView. |
|
768 selectedTesteeMethod := method. |
|
769 |
|
770 "Created: / 25-04-2010 / 15:51:03 / cg" |
|
771 "Modified: / 26-04-2010 / 10:38:46 / cg" |
|
772 ! |
|
773 |
|
774 updateDiffTextView |
|
775 diffTextView |
|
776 text1:(self originalMethodSourceHolder value ? '') |
|
777 text2:(self mutatedMethodSourceHolder value ? ''). |
|
778 |
|
779 "Created: / 26-04-2010 / 10:38:39 / cg" |
|
780 ! ! |
|
781 |
|
782 !TestTester::Mutator class methodsFor:'instance creation'! |
|
783 |
|
784 forBlock:aBlock |
|
785 ^ self new blockToCall:aBlock |
|
786 |
|
787 "Created: / 24-04-2010 / 16:55:24 / cg" |
|
788 ! ! |
|
789 |
|
790 !TestTester::Mutator methodsFor:'accessing'! |
|
791 |
|
792 blockToCall:something |
|
793 blockToCall := something. |
|
794 ! ! |
|
795 |
|
796 !TestTester::Mutator methodsFor:'mutating'! |
|
797 |
|
798 mutationsOf:aTree do:aBlock |
|
799 blockToCall := aBlock. |
|
800 treeTop := aTree. |
|
801 aTree acceptVisitor:self. |
|
802 |
|
803 "Created: / 24-04-2010 / 17:12:19 / cg" |
|
804 "Modified: / 24-04-2010 / 19:02:24 / cg" |
|
805 ! ! |
|
806 |
|
807 !TestTester::Mutator methodsFor:'visiting'! |
|
808 |
|
809 acceptBlockNode:aBlockNode |
|
810 self acceptMethodOrBlockNode:aBlockNode |
|
811 |
|
812 "Modified: / 24-04-2010 / 19:06:49 / cg" |
|
813 ! |
|
814 |
|
815 acceptLiteralNode:aLiteralNode |
|
816 |oldValue| |
|
817 |
|
818 oldValue := aLiteralNode value. |
|
819 oldValue isInteger ifTrue:[ |
|
820 [ |
|
821 aLiteralNode token value:oldValue + 1. |
|
822 blockToCall value:treeTop. |
|
823 aLiteralNode token value:oldValue - 1. |
|
824 blockToCall value:treeTop. |
|
825 ((oldValue ~= 1) and:[oldValue ~= -1]) ifTrue:[ |
|
826 aLiteralNode token value:0. |
|
827 blockToCall value:treeTop. |
|
828 ]. |
|
829 ] ensure:[ |
|
830 aLiteralNode token value:oldValue. |
|
831 ]. |
|
832 ^ self. |
|
833 ]. |
|
834 oldValue isFloat ifTrue:[ |
|
835 self halt. |
|
836 ^ self. |
|
837 ]. |
|
838 oldValue isSymbol ifTrue:[ |
|
839 ^ self. |
|
840 ]. |
|
841 oldValue isString ifTrue:[ |
|
842 ^ self. |
|
843 ]. |
|
844 oldValue isArray ifTrue:[ |
|
845 ^ self. |
|
846 ]. |
|
847 oldValue isByteArray ifTrue:[ |
|
848 self halt. |
|
849 ^ self. |
|
850 ]. |
|
851 self halt. |
|
852 |
|
853 "Created: / 25-04-2010 / 21:32:12 / cg" |
|
854 ! |
|
855 |
|
856 acceptMessageNode:aMessageNode |
|
857 |selector arguments| |
|
858 |
|
859 selector := aMessageNode selector. |
|
860 |
|
861 ( #( ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes:selector) ifTrue:[ |
|
862 self tryWithNegatedCondition:aMessageNode. |
|
863 ]. |
|
864 |
|
865 arguments := aMessageNode arguments. |
|
866 1 to:arguments size do:[:idx | |
|
867 |oldArg| |
|
868 |
|
869 oldArg := arguments at:idx. |
|
870 [ |
|
871 (self class new) mutationsOf:oldArg do:[:newArg | |
|
872 arguments at:idx put:newArg. |
|
873 blockToCall value:treeTop. |
|
874 ]. |
|
875 ] ensure:[ |
|
876 arguments at:idx put:oldArg |
|
877 ]. |
|
878 ]. |
|
879 |
|
880 "Modified: / 24-04-2010 / 19:07:22 / cg" |
|
881 ! |
|
882 |
|
883 acceptMethodNode:aMethodNode |
|
884 self acceptMethodOrBlockNode:aMethodNode |
|
885 |
|
886 "Modified: / 24-04-2010 / 19:06:44 / cg" |
|
887 ! |
|
888 |
|
889 acceptMethodOrBlockNode:aMethodOrBlockNode |
|
890 |oldBody| |
|
891 |
|
892 oldBody := aMethodOrBlockNode body. |
|
893 oldBody notNil ifTrue:[ |
|
894 [ |
|
895 (self class new) mutationsOf:oldBody do:[:newBody | |
|
896 aMethodOrBlockNode body:newBody. |
|
897 blockToCall value:treeTop. |
|
898 ]. |
|
899 ] ensure:[ |
|
900 aMethodOrBlockNode body:oldBody |
|
901 ]. |
|
902 ]. |
|
903 |
|
904 "Created: / 24-04-2010 / 19:06:33 / cg" |
|
905 ! |
|
906 |
|
907 acceptReturnNode:aReturnNode |
|
908 |oldExpr| |
|
909 |
|
910 oldExpr := aReturnNode value. |
|
911 [ |
|
912 (self class new) mutationsOf:oldExpr do:[:newExpr | |
|
913 aReturnNode value:newExpr. |
|
914 blockToCall value:treeTop. |
|
915 ]. |
|
916 ] ensure:[ |
|
917 aReturnNode value:oldExpr |
|
918 ]. |
|
919 |
|
920 "Modified: / 25-04-2010 / 21:30:13 / cg" |
|
921 ! |
|
922 |
|
923 acceptSequenceNode:aSequenceNode |
|
924 |statements| |
|
925 |
|
926 statements := aSequenceNode statements. |
|
927 |
|
928 1 to:statements size do:[:idx | |
|
929 |oldStat| |
|
930 |
|
931 oldStat := statements at:idx. |
|
932 [ |
|
933 (self class new) mutationsOf:oldStat do:[:newStat | |
|
934 statements at:idx put:newStat. |
|
935 blockToCall value:treeTop. |
|
936 ]. |
|
937 ] ensure:[ |
|
938 statements at:idx put:oldStat |
|
939 ]. |
|
940 ]. |
|
941 "/ |oldBody| |
|
942 "/ |
|
943 "/ oldBody := aMethodNode body. |
|
944 "/ oldBody notNil ifTrue:[ |
|
945 "/ [ |
|
946 "/ (self class new) mutationsOf:oldBody do:[:newBody | |
|
947 "/self halt. |
|
948 "/ ]. |
|
949 "/ ] ensure:[ |
|
950 "/ aMethodNode body:oldBody |
|
951 "/ ]. |
|
952 "/ ]. |
|
953 "/ |
|
954 "/ "Created: / 24-04-2010 / 16:56:12 / cg" |
|
955 "/ |
|
956 |
|
957 "Created: / 24-04-2010 / 18:23:35 / cg" |
|
958 ! |
|
959 |
|
960 acceptVariableNode:aVariableNode |
|
961 |
|
962 "Created: / 25-04-2010 / 21:35:26 / cg" |
|
963 ! |
|
964 |
|
965 tryWithNegatedCondition:aMessageNode |
|
966 |sel repl| |
|
967 |
|
968 sel := aMessageNode selector. |
|
969 repl := (Dictionary new |
|
970 at: #ifTrue: put: #ifFalse: ; |
|
971 at: #ifFalse: put: #ifTrue: ; |
|
972 at: #ifTrue:ifFalse: put: #ifFalse:ifTrue: ; |
|
973 at: #ifFalse:ifTrue: put: #ifTrue:ifFalse: ; |
|
974 yourself) |
|
975 at:sel. |
|
976 |
|
977 [ |
|
978 aMessageNode selector:repl. |
|
979 blockToCall value:treeTop. |
|
980 ] ensure:[ |
|
981 aMessageNode selector:sel. |
|
982 ]. |
|
983 |
|
984 "Modified: / 24-04-2010 / 19:03:44 / cg" |
|
985 ! ! |
|
986 |
|
987 !TestTester class methodsFor:'documentation'! |
|
988 |
|
989 version_CVS |
|
990 ^ '$Header: /cvs/stx/stx/goodies/sunit/TestTester.st,v 1.1 2010-04-26 08:45:43 cg Exp $' |
|
991 ! ! |