Tools__TestRunnerEmbedded.st
branchjv
changeset 12125 0c49a3b13e43
parent 12123 4bde08cebd48
child 12128 a7ff7d66ee85
equal deleted inserted replaced
12124:86df5844137f 12125:0c49a3b13e43
   321 
   321 
   322 debug
   322 debug
   323     | suiteAndResult suite test result | 
   323     | suiteAndResult suite test result | 
   324 
   324 
   325     suiteAndResult := self resultHolder value.
   325     suiteAndResult := self resultHolder value.
   326     suite := suiteAndResult suite.
   326     suite := suiteAndResult suiteForRun.
   327     suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
   327     suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
   328     test := suiteAndResult suite tests anyOne.
   328     test := suiteAndResult suite tests anyOne.
   329     [
   329     [
   330         test debug.
   330         test debug.
   331         (test class testSelectorPassed:test selector) ifTrue:[
   331         (test class testSelectorPassed:test selector) ifTrue:[
   335             self resultHolder value:suiteAndResult.    
   335             self resultHolder value:suiteAndResult.    
   336         ].            
   336         ].            
   337     ] fork
   337     ] fork
   338 
   338 
   339     "Created: / 15-03-2010 / 15:43:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   339     "Created: / 15-03-2010 / 15:43:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   340     "Modified: / 15-03-2010 / 20:09:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   341     "Modified: / 05-07-2011 / 19:05:31 / cg"
   340     "Modified: / 05-07-2011 / 19:05:31 / cg"
   342     "Modified: / 07-07-2011 / 11:33:48 / Jan Vrany <jan.vrant@fit.cvut,cz>"
   341     "Modified: / 07-07-2011 / 11:33:48 / Jan Vrany <jan.vrant@fit.cvut,cz>"
   343     "Modified (format): / 02-08-2011 / 18:18:38 / cg"
   342     "Modified (format): / 02-08-2011 / 18:18:38 / cg"
       
   343     "Modified: / 22-08-2011 / 09:59:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   344 !
   344 !
   345 
   345 
   346 run
   346 run
   347 
   347     |suite|
   348     self run:  resultHolder value suite
   348 
       
   349     resultHolder value isNil ifTrue:[
       
   350         suite := self suiteForRun
       
   351     ] ifFalse:[
       
   352         suite := resultHolder value suiteForRun
       
   353     ].
       
   354     self run:suite
   349 
   355 
   350     "Created: / 10-03-2010 / 19:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   356     "Created: / 10-03-2010 / 19:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   351     "Modified: / 15-03-2010 / 20:00:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   357     "Modified: / 22-08-2011 / 09:58:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   358     "Modified: / 09-10-2011 / 10:56:39 / cg"
   352 !
   359 !
   353 
   360 
   354 run:suite 
   361 run:suite 
   355     |process suiteAndResult numTests|
   362     |process suiteAndResult numTests|
   356 
   363 
   405 
   412 
   406 runWithDebug
   413 runWithDebug
   407     "/ cg: I really do not want to run them twice to get a debugger 
   414     "/ cg: I really do not want to run them twice to get a debugger 
   408     "/ - I want to run them either with a debugger coming right away, or not.
   415     "/ - I want to run them either with a debugger coming right away, or not.
   409 
   416 
   410     | suiteAndResult suite result|
   417     | suiteAndResult suite|
   411 
   418 
   412     suiteAndResult := self resultHolder value.
   419     suiteAndResult := self resultHolder value.
   413     suite := suiteAndResult suite.
   420     suiteAndResult isNil ifTrue:[
   414     result := suiteAndResult result.
   421         suite := self suiteForRun.
   415 
   422     ] ifFalse:[
   416     suite tests do:[:each | 
   423         suite := suiteAndResult suiteForRun.
   417         |errorHappened failureHappened cls|
   424     ].
   418 
   425 
   419         errorHappened := failureHappened := false.
   426     suite run: TestResultForRunWithDebug new
   420         GenericException 
   427 
   421             handle:[:ex | 
   428 
   422                 (HaltInterrupt accepts:ex signal) ifFalse:[
       
   423                     ex signal == NoHandlerError ifFalse:[
       
   424                         (TestFailure accepts:ex signal) ifTrue:[
       
   425                             failureHappened := true
       
   426                         ] ifFalse:[
       
   427                             errorHappened := true.
       
   428                         ].
       
   429                     ]
       
   430                 ].
       
   431                 ex reject.
       
   432             ]
       
   433             do:[ 
       
   434                 infoHolder notNil ifTrue:[
       
   435                     infoHolder value:('Running "%1-%2"...' 
       
   436                                     bindWith:each name
       
   437                                     with:each getTestName allBold)
       
   438                 ].
       
   439                 each debug. 
       
   440                 infoHolder notNil ifTrue:[
       
   441                     infoHolder value:('Done.')
       
   442                 ]
       
   443             ].
       
   444 
       
   445         result failures remove:each ifAbsent:[].
       
   446         result passed remove:each ifAbsent:[].
       
   447         result errors remove:each ifAbsent:[].
       
   448 
       
   449         failureHappened ifTrue:[
       
   450             each class rememberErrorTest:each selector.
       
   451             result errors add:each.
       
   452         ] ifFalse:[
       
   453             errorHappened ifTrue:[
       
   454                 each class rememberFailedTest:each selector.
       
   455                 result failures add:each.
       
   456             ] ifFalse:[
       
   457                 each class rememberPassedTest:each selector.
       
   458                 result passed add:each.
       
   459             ]
       
   460         ]
       
   461     ]
       
   462 
   429 
   463     "/ suiteAndResult suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
   430     "/ suiteAndResult suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
   464     "/ [suiteAndResult suite tests anyOne debug] fork
   431     "/ [suiteAndResult suite tests anyOne debug] fork
   465 
   432 
   466     "Modified: / 15-03-2010 / 20:09:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   467     "Created: / 05-07-2011 / 18:45:43 / cg"
   433     "Created: / 05-07-2011 / 18:45:43 / cg"
       
   434     "Modified: / 22-08-2011 / 09:59:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   435     "Modified: / 09-10-2011 / 10:55:46 / cg"
   468 ! !
   436 ! !
   469 
   437 
   470 !TestRunnerEmbedded methodsFor:'aspects'!
   438 !TestRunnerEmbedded methodsFor:'aspects'!
   471 
   439 
   472 debugVisibleAspect
   440 debugVisibleAspect
   714     sender == methodGeneratorHolder ifTrue:[
   682     sender == methodGeneratorHolder ifTrue:[
   715         self updateTestSuiteAndResult.
   683         self updateTestSuiteAndResult.
   716         ^self
   684         ^self
   717     ].
   685     ].
   718 
   686 
       
   687     sender == Smalltalk ifTrue:[
       
   688         aspect == #lastTestRunResult ifTrue:[
       
   689             (selectedTestCases notNil and:[selectedTestCases includesIdentical: param first]) ifTrue:[
       
   690                 self updateTestSuiteAndResult.
       
   691                 ^self        
       
   692             ]
       
   693         ]        
       
   694     ].
       
   695 
   719 
   696 
   720 
   697 
   721     super update:aspect with:param from: sender
   698     super update:aspect with:param from: sender
   722 
   699 
   723     "Modified: / 07-09-2010 / 08:18:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   700     "Modified: / 20-11-2011 / 12:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   724 !
   701 !
   725 
   702 
   726 updateTestCases
   703 updateTestCases
   727     selectedTestCases := (self selectedClassesHolder value 
   704     selectedTestCases := ((self selectedClassesHolder value ? #()) 
   728                 select:[:cls | self isTestCaseLike:cls ]).
   705                 select:[:cls | self isTestCaseLike:cls ]).
   729     selectedTestCases := selectedTestCases isEmpty 
   706     selectedTestCases := selectedTestCases isEmpty 
   730                 ifTrue:[ nil ]
   707                 ifTrue:[ nil ]
   731                 ifFalse:[ selectedTestCases asArray ]
   708                 ifFalse:[ selectedTestCases asArray ]
   732 
   709 
   733     "Created: / 11-03-2010 / 10:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   710     "Created: / 11-03-2010 / 10:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   734     "Modified: / 15-03-2010 / 20:53:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   711     "Modified: / 24-01-2012 / 22:09:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   735 !
   712 !
   736 
   713 
   737 updateTestSuiteAndResult
   714 updateTestSuiteAndResult
   738 
   715 
   739     | suite suiteAndResult |
   716     | suite suiteAndResult |
   757     "Created: / 11-03-2010 / 09:02:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   734     "Created: / 11-03-2010 / 09:02:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   758 ! !
   735 ! !
   759 
   736 
   760 !TestRunnerEmbedded methodsFor:'hooks'!
   737 !TestRunnerEmbedded methodsFor:'hooks'!
   761 
   738 
       
   739 commonPostOpen
       
   740 
       
   741     Smalltalk addDependent: self.
       
   742 
       
   743     "Created: / 17-11-2011 / 20:59:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   744 !
       
   745 
   762 postBuildRunnerPanel: aView
   746 postBuildRunnerPanel: aView
   763 
   747 
   764     runnerPanel := aView.
   748     runnerPanel := aView.
   765     runnerPanel backgroundColor: self resultBackgroundColorAspect value
   749     runnerPanel backgroundColor: self resultBackgroundColorAspect value
   766 
   750 
   767     "Created: / 15-03-2010 / 14:26:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   751     "Created: / 15-03-2010 / 14:26:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   752 !
       
   753 
       
   754 releaseAsSubCanvas
       
   755 
       
   756     Smalltalk removeDependent: self.
       
   757 
       
   758     "Created: / 17-11-2011 / 21:03:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   768 ! !
   759 ! !
   769 
   760 
   770 !TestRunnerEmbedded methodsFor:'private'!
   761 !TestRunnerEmbedded methodsFor:'private'!
   771 
   762 
   772 hide
   763 hide
   825 resultForSuite:suite 
   816 resultForSuite:suite 
   826     |result|
   817     |result|
   827 
   818 
   828     result := TestResult new.
   819     result := TestResult new.
   829     suite tests do:[:test |
   820     suite tests do:[:test |
   830         |sel|
   821         | sel cls |
   831 
   822 
   832         sel := test selector.
   823         sel := test selector.
   833         (test class testSelectorPassed:sel) ifTrue:[
   824         cls := test class.
   834             result passed add:test
   825         (cls testSelectorPassed:sel) ifTrue:[
       
   826             result passedOutcomes add: (cls rememberedOutcomeFor: sel)
   835         ] ifFalse:[
   827         ] ifFalse:[
   836             (test class testSelectorError:sel) ifTrue:[
   828             (cls testSelectorError:sel) ifTrue:[
   837                 result errors add:test
   829                 result errorOutcomes add:(cls rememberedOutcomeFor: sel)
   838             ] ifFalse:[
   830             ] ifFalse:[
   839                 (test class testSelectorFailed:sel) ifTrue:[
   831                 (cls testSelectorFailed:sel) ifTrue:[
   840                     result failures add:test
   832                     result failureOutcomes add:(cls rememberedOutcomeFor: sel)
   841                 ]
   833                 ]
   842             ]
   834             ]
   843         ]
   835         ]
   844     ].
   836     ].
   845     ^ result
   837     ^ result
   846 
   838 
   847     "Created: / 15-03-2010 / 19:46:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   839     "Created: / 15-03-2010 / 19:46:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   848     "Modified: / 02-08-2011 / 18:20:00 / cg"
   840     "Modified: / 02-08-2011 / 18:20:00 / cg"
       
   841     "Modified: / 20-08-2011 / 14:30:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   849 !
   842 !
   850 
   843 
   851 suiteForRun
   844 suiteForRun
   852     | methods protocols suite selectedClass |
   845     | methods protocols suite selectedClass |
   853 
   846 
   952 
   945 
   953 suite:aTestSuite
   946 suite:aTestSuite
   954     suite := aTestSuite.
   947     suite := aTestSuite.
   955 !
   948 !
   956 
   949 
       
   950 suiteForRun
       
   951 
       
   952     | suiteForRun |
       
   953     suiteForRun := suite class named: suite name.
       
   954     suiteForRun addTests:
       
   955         (suite tests collect:[:testCase|testCase class selector: testCase selector]).
       
   956     ^suiteForRun
       
   957 
       
   958     "Created: / 22-08-2011 / 09:56:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   959 !
       
   960 
   957 testCount
   961 testCount
   958 
   962 
   959     ^suite tests size
   963     ^suite tests size
   960 
   964 
   961     "Created: / 15-03-2010 / 15:44:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   965     "Created: / 15-03-2010 / 15:44:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   992 ! !
   996 ! !
   993 
   997 
   994 !TestRunnerEmbedded class methodsFor:'documentation'!
   998 !TestRunnerEmbedded class methodsFor:'documentation'!
   995 
   999 
   996 version
  1000 version
   997     ^ '$Id: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.15 2011/08/09 21:57:18 cg Exp $'
  1001     ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.22 2012/01/24 22:20:06 vrany Exp $'
   998 !
  1002 !
   999 
  1003 
  1000 version_CVS
  1004 version_CVS
  1001     ^ '§Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.15 2011/08/09 21:57:18 cg Exp §'
  1005     ^ '§Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.22 2012/01/24 22:20:06 vrany Exp §'
  1002 !
  1006 !
  1003 
  1007 
  1004 version_SVN
  1008 version_SVN
  1005     ^ '$Id$'
  1009     ^ '$Id$'
  1006 ! !
  1010 ! !