318 |
318 |
319 invalidateAllTestCases |
319 invalidateAllTestCases |
320 allTestCases := nil |
320 allTestCases := nil |
321 ! |
321 ! |
322 |
322 |
|
323 selectedTestMethods |
|
324 |
|
325 | selectedClass | |
|
326 selectedClass := self theSingleTestCase. |
|
327 |
|
328 ^ (self selectedMethodsHolder value ? #()) select: |
|
329 [:mthd | | cls | |
|
330 (cls := selectedClass) isNil ifTrue:[cls := mthd mclass]. |
|
331 (self isTestCaseLike:selectedClass) |
|
332 and:[ selectedClass isTestSelector:mthd selector ] ] |
|
333 |
|
334 "Created: / 15-03-2010 / 13:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
335 "Modified: / 22-07-2011 / 15:46:44 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
336 "Modified: / 02-08-2011 / 17:46:38 / cg" |
|
337 ! |
|
338 |
|
339 selectedTestMethodsFromProtocols:protocols |
|
340 |
|
341 |methods generator selectedClass| |
|
342 |
|
343 methods := Set new. |
|
344 generator := self methodGeneratorHolder value. |
|
345 selectedClass := self theSingleTestCase. |
|
346 |
|
347 generator notNil ifTrue:[ |
|
348 generator do: [:cls :cat :sel :mthd | |
|
349 (mthd notNil |
|
350 and:[ (self isTestCaseLike:(selectedClass ? cls)) |
|
351 and:[ (selectedClass ? cls) isTestSelector:sel ] ]) |
|
352 ifTrue:[ methods add:mthd ] |
|
353 ] |
|
354 ] ifFalse:[ |
|
355 allTestCases do: [:cls | |
|
356 cls methodsDo: [:mthd | |
|
357 ((protocols includes:mthd category) and:[ cls isTestSelector:mthd selector ]) |
|
358 ifTrue:[ |
|
359 methods add:mthd |
|
360 ] |
|
361 ] |
|
362 ] |
|
363 ]. |
|
364 ^ methods |
|
365 |
|
366 "Created: / 15-03-2010 / 19:50:15 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
367 "Modified: / 22-07-2011 / 15:53:43 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
368 "Modified (format): / 04-06-2012 / 19:05:32 / cg" |
|
369 ! |
|
370 |
323 selectedTestMethodsFromProtocols:protocols inClass:aTestClass |
371 selectedTestMethodsFromProtocols:protocols inClass:aTestClass |
324 |
372 |
325 |methods generator| |
373 |methods generator| |
326 |
374 |
327 methods := Set new. |
375 methods := Set new. |
419 self runningHolder value:false. |
467 self runningHolder value:false. |
420 ]. |
468 ]. |
421 |
469 |
422 "Created: / 15-03-2010 / 15:43:39 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
470 "Created: / 15-03-2010 / 15:43:39 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
423 "Modified: / 07-07-2011 / 11:33:48 / Jan Vrany <jan.vrant@fit.cvut,cz>" |
471 "Modified: / 07-07-2011 / 11:33:48 / Jan Vrany <jan.vrant@fit.cvut,cz>" |
424 "Modified: / 22-08-2011 / 09:59:10 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
425 "Modified: / 04-06-2012 / 19:46:38 / cg" |
472 "Modified: / 04-06-2012 / 19:46:38 / cg" |
|
473 "Modified: / 03-12-2012 / 14:02:28 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
426 ! |
474 ! |
427 |
475 |
428 run |
476 run |
429 |suite| |
477 |suite| |
430 |
478 |
439 "Modified: / 22-08-2011 / 09:58:33 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
487 "Modified: / 22-08-2011 / 09:58:33 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
440 "Modified: / 09-10-2011 / 10:56:39 / cg" |
488 "Modified: / 09-10-2011 / 10:56:39 / cg" |
441 ! |
489 ! |
442 |
490 |
443 run:suite |
491 run:suite |
|
492 ^self run: suite debug: false |
|
493 |
|
494 "Created: / 11-03-2010 / 10:22:59 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
495 "Modified: / 09-06-2012 / 20:23:58 / cg" |
|
496 "Modified: / 03-12-2012 / 13:59:26 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
497 ! |
|
498 |
|
499 run:suite debug: debug |
444 |suiteAndResult numTests| |
500 |suiteAndResult numTests| |
445 |
501 |
446 numTests := suite tests size. |
502 numTests := suite tests size. |
447 numTests == 0 ifTrue:[ |
503 numTests == 0 ifTrue:[ |
448 ^ self |
504 ^ self |
449 ]. |
505 ]. |
450 |
506 |
451 self stop. |
507 self stop. |
452 |
508 |
453 testProcess := [ |
509 testProcess := [ |
454 |result incr run anyFail anyError| |
510 |result incr run| |
455 |
511 |
456 anyFail := anyError := false. |
512 result := debug ifFalse:[TestResult new] ifTrue:[TestResultForRunWithDebug]. |
457 [ |
513 [ |
458 |
|
459 self runningHolder value:true. |
514 self runningHolder value:true. |
460 self progressIndicatorShownHolder value:(numTests > 1). |
515 self progressIndicatorShownHolder value:(numTests > 1). |
461 self progressHolder value:0. |
516 self progressHolder value:0. |
462 incr := 100 / numTests. |
517 incr := 100 / numTests. |
463 run := 0. |
518 run := 0. |
464 result := suite |
519 result := suite |
465 runBeforeEachDo:[:test :result | |
520 run: result |
|
521 beforeEachDo:[:test :result | |
466 infoHolder notNil ifTrue:[ |
522 infoHolder notNil ifTrue:[ |
467 infoHolder value:('Running "%1-%2"...' |
523 infoHolder value:('Running "%1-%2"...' |
468 bindWith:test name |
524 bindWith:test name |
469 with:test getTestName allBold) |
525 with:test getTestName allBold) |
470 ] |
526 ] |
472 afterEachDo:[:test :result | |
528 afterEachDo:[:test :result | |
473 run := run + 1. |
529 run := run + 1. |
474 self progressHolder value:(incr * run) truncated "rounded". |
530 self progressHolder value:(incr * run) truncated "rounded". |
475 infoHolder notNil ifTrue:[ |
531 infoHolder notNil ifTrue:[ |
476 infoHolder value:('Done.') |
532 infoHolder value:('Done.') |
477 ]. |
533 ] |
478 result hasPassed ifFalse:[ |
534 ] |
479 progressIndicator foregroundColor:(Color red) |
535 debug: debug. |
480 ]. |
|
481 ]. |
|
482 suiteAndResult := SuiteAndResult suite:suite result:result. |
536 suiteAndResult := SuiteAndResult suite:suite result:result. |
483 ] ensure:[ |
537 ] ensure:[ |
484 progressIndicator initStyle. |
|
485 self progressIndicatorShownHolder value:false. |
538 self progressIndicatorShownHolder value:false. |
486 self resultHolder setValue:nil; value:suiteAndResult; changed. |
539 self resultHolder setValue:nil; value:suiteAndResult; changed. |
487 self runningHolder value:false. |
540 self runningHolder value:false. |
488 ] |
541 ] |
489 ] newProcess. |
542 ] newProcess. |
490 |
543 |
491 testProcess priority:(Processor userBackgroundPriority). |
544 testProcess priority:(Processor userBackgroundPriority). |
492 testProcess resume. |
545 testProcess resume. |
493 |
546 |
494 "Created: / 11-03-2010 / 10:22:59 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
547 "Created: / 03-12-2012 / 13:59:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
495 "Modified: / 06-09-2010 / 21:48:10 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
496 "Modified: / 09-06-2012 / 20:23:58 / cg" |
|
497 ! |
548 ! |
498 |
549 |
499 runAll |
550 runAll |
500 |
551 |
501 self run: (self suiteForRunAll). |
552 self run: (self suiteForRunAll). |
522 suite := self suiteForRun. |
573 suite := self suiteForRun. |
523 ] ifFalse:[ |
574 ] ifFalse:[ |
524 suite := suiteAndResult suiteForRun. |
575 suite := suiteAndResult suiteForRun. |
525 ]. |
576 ]. |
526 |
577 |
527 suite run: TestResultForRunWithDebug new |
578 self run: suite debug: true |
528 |
579 |
529 |
580 |
530 |
581 |
531 "/ suiteAndResult suite tests size ~= 1 ifTrue:[^self breakPoint: #jv]. |
582 "/ suiteAndResult suite tests size ~= 1 ifTrue:[^self breakPoint: #jv]. |
532 "/ [suiteAndResult suite tests anyOne debug] fork |
583 "/ [suiteAndResult suite tests anyOne debug] fork |
533 |
584 |
534 "Created: / 05-07-2011 / 18:45:43 / cg" |
585 "Created: / 05-07-2011 / 18:45:43 / cg" |
535 "Modified: / 22-08-2011 / 09:59:46 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
536 "Modified: / 09-10-2011 / 10:55:46 / cg" |
586 "Modified: / 09-10-2011 / 10:55:46 / cg" |
|
587 "Modified: / 03-12-2012 / 13:59:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
537 ! |
588 ! |
538 |
589 |
539 stop |
590 stop |
540 |p| |
591 |p| |
541 |
592 |
894 "Modified: / 15-03-2010 / 20:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
945 "Modified: / 15-03-2010 / 20:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
895 "Modified: / 04-06-2012 / 19:03:15 / cg" |
946 "Modified: / 04-06-2012 / 19:03:15 / cg" |
896 ! |
947 ! |
897 |
948 |
898 updateTestCases |
949 updateTestCases |
899 allTestCases := Set new. |
950 allTestCases := ((self selectedClassesHolder value ? #()) |
900 (self selectedClassesHolder value ? #()) do:[:eachSelected | |
951 select:[:cls | self isTestCaseLike:cls ]). |
901 (self isTestCaseLike:eachSelected) ifTrue:[ |
|
902 allTestCases add:eachSelected. |
|
903 "/ eachSelected allSuperclassesDo:[:eachClass | |
|
904 "/ (eachClass isTestCaseLike) ifTrue:[ |
|
905 "/ allTestCases add:eachClass |
|
906 "/ ] |
|
907 "/ ] |
|
908 ] |
|
909 ]. |
|
910 allTestCases := allTestCases asArray |
952 allTestCases := allTestCases asArray |
911 |
953 |
912 "Created: / 11-03-2010 / 10:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
954 "Created: / 11-03-2010 / 10:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
913 "Modified: / 24-01-2012 / 22:09:14 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
955 "Modified: / 24-01-2012 / 22:09:14 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
914 "Modified: / 04-06-2012 / 19:02:52 / cg" |
956 "Modified: / 04-06-2012 / 19:02:52 / cg" |
915 ! |
957 ! |
916 |
958 |
|
959 updateTestSuiteAndResult |
|
960 |
|
961 | suite suiteAndResult | |
|
962 self runningHolder value ifTrue:[^self]. |
|
963 allTestCases isEmptyOrNil ifTrue:[^self]. |
|
964 suiteAndResult := SuiteAndResult |
|
965 suite: (suite := self suiteForRun) |
|
966 result: (self resultForSuite: suite). |
|
967 self resultHolder value: suiteAndResult. |
|
968 |
|
969 "Created: / 15-03-2010 / 19:41:27 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
970 "Modified: / 15-03-2010 / 20:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
971 "Modified: / 04-06-2012 / 19:03:15 / cg" |
|
972 ! |
|
973 |
917 updateVisibility |
974 updateVisibility |
918 |
975 |
919 self hasTestCaseSelected |
976 self hasTestCaseSelected |
920 ifTrue:[self show] |
977 ifTrue:[self show] |
921 ifFalse:[self hide]. |
978 ifFalse:[self hide] |
922 |
|
923 (testProcess isNil or:[ testProcess isDead]) ifTrue:[ |
|
924 "/ fix my ideo of being running, in case the testProcess died without |
|
925 "/ me being informed (hardTerminate) |
|
926 self runningHolder value:false. |
|
927 self progressIndicatorShownHolder value:false. |
|
928 ] |
|
929 |
979 |
930 "Created: / 11-03-2010 / 09:02:40 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
980 "Created: / 11-03-2010 / 09:02:40 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
931 ! ! |
981 ! ! |
932 |
982 |
933 !TestRunnerEmbedded methodsFor:'hooks'! |
983 !TestRunnerEmbedded methodsFor:'hooks'! |
1045 "if methods are selected, a suite for those methods is built and returned. |
1095 "if methods are selected, a suite for those methods is built and returned. |
1046 If protocoly are selected, a suite for all methods in those protocols |
1096 If protocoly are selected, a suite for all methods in those protocols |
1047 is built and returned. |
1097 is built and returned. |
1048 Otherwise, a suite for all methods in the class is built and returned" |
1098 Otherwise, a suite for all methods in the class is built and returned" |
1049 |
1099 |
1050 | methods protocols suite selectedClass | |
1100 | methods testMethods protocols suite selectedClass | |
1051 |
1101 |
1052 selectedClass := self theSingleTestCase. |
1102 selectedClass := self theSingleTestCase. |
1053 |
1103 |
1054 (methods := selectedMethodsHolder value) notEmptyOrNil ifTrue:[ |
1104 (methods := selectedMethodsHolder value) notEmptyOrNil ifTrue:[ |
1055 suite := TestSuite named: (self suiteNameFromMethods: methods). |
1105 testMethods := self selectedTestMethods. |
1056 (self selectedTestMethodsInClass:selectedClass) do:[:mthd| |
1106 suite := TestSuite named: (self suiteNameFromMethods: testMethods). |
|
1107 testMethods do:[:mthd| |
1057 | class selector | |
1108 | class selector | |
1058 class := selectedClass ifNil:[mthd mclass]. |
1109 class := selectedClass ifNil:[mthd mclass]. |
1059 suite addTest: (class asTestCase selector: mthd selector) |
1110 suite addTest: (class asTestCase selector: mthd selector) |
1060 ]. |
1111 ]. |
1061 ^suite |
1112 ^suite |
1263 ! ! |
1314 ! ! |
1264 |
1315 |
1265 !TestRunnerEmbedded class methodsFor:'documentation'! |
1316 !TestRunnerEmbedded class methodsFor:'documentation'! |
1266 |
1317 |
1267 version |
1318 version |
1268 ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.36 2013-08-21 00:25:21 cg Exp $' |
1319 ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.37 2014-02-05 18:59:24 cg Exp $' |
1269 ! |
1320 ! |
1270 |
1321 |
1271 version_CVS |
1322 version_CVS |
1272 ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.36 2013-08-21 00:25:21 cg Exp $' |
1323 ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.37 2014-02-05 18:59:24 cg Exp $' |
1273 ! |
1324 ! |
1274 |
1325 |
1275 version_SVN |
1326 version_SVN |
1276 ^ '$Id: Tools__TestRunnerEmbedded.st,v 1.36 2013-08-21 00:25:21 cg Exp $' |
1327 ^ '$Id: Tools__TestRunnerEmbedded.st,v 1.37 2014-02-05 18:59:24 cg Exp $' |
1277 ! ! |
1328 ! ! |
1278 |
1329 |