quickSelfTest/RunUnitTests.st
author Claus Gittinger <cg@exept.de>
Thu, 28 Mar 2019 13:54:38 +0100
changeset 542 aa25a71be62a
parent 539 532fab2fb2a5
child 544 fda58d35b323
permissions -rw-r--r--
#DOCUMENTATION by cg
class: stx_goodies_builder_quickSelfTest
class definition

class: stx_goodies_builder_quickSelfTest class
added:18 methods
     1 "{ Encoding: utf8 }"
     2 
     3 "{ Package: 'stx:goodies/builder/quickSelfTest' }"
     4 
     5 "{ NameSpace: Smalltalk }"
     6 
     7 Object subclass:#RunUnitTests
     8 	instanceVariableNames:''
     9 	classVariableNames:''
    10 	poolDictionaries:''
    11 	category:'tests-Regression'
    12 !
    13 
    14 !RunUnitTests class methodsFor:'documentation'!
    15 
    16 documentation
    17 "
    18     typically invoked by RunUnitTestsStart
    19 
    20     [author:]
    21         sr
    22 
    23     [instance variables:]
    24 
    25     [class variables:]
    26 
    27     [see also:]
    28 
    29 "
    30 ! !
    31 
    32 !RunUnitTests class methodsFor:'actions'!
    33 
    34 run
    35     self runWithCompiledUnitTestClasses:false.
    36 !
    37 
    38 runWithCompiledUnitTestClasses:useCompiledUnitTestClasses
    39     |cmdArgs|
    40 
    41     cmdArgs := Smalltalk commandLineArguments.
    42 
    43     self
    44 	runWithCompiledUnitTestClasses:useCompiledUnitTestClasses
    45 	arguments:cmdArgs
    46 	debug:(cmdArgs includes:'--debug')
    47 !
    48 
    49 runWithCompiledUnitTestClasses:useCompiledUnitTestClasses
    50     arguments:argumentsIn
    51     debug:debug
    52 
    53     |arguments
    54      doRunSpecificUnitTests unitTestSuiteName excludedUnitTestClassNames corruptedUnitTestClassNames
    55      unitTestSuite
    56      eachClass
    57      result index
    58      settingsFilePathName resultFilePathName forceTestCase runTestCases|
    59 
    60     arguments := argumentsIn asOrderedCollection.
    61 
    62     runTestCases := OrderedCollection new.
    63     doRunSpecificUnitTests := false.
    64     unitTestSuiteName := 'All Unit Tests'.
    65     excludedUnitTestClassNames := self excludedUnitTestClassNamesForAll.
    66     corruptedUnitTestClassNames := self corruptedUnitTestClassNames.
    67 
    68     index := arguments indexOf:'--settingsFile'.
    69     index > 0 ifTrue:[
    70         settingsFilePathName := arguments at:index + 1.
    71         self logInfo:'load settings file: ', settingsFilePathName printString.
    72         settingsFilePathName asFilename fileIn.
    73         self logInfo:'ParserFlags makeCommand: ', ParserFlags makeCommand printString.
    74     ].
    75 
    76     (arguments includes:'--runOnlyExpeccoUnitTests') ifTrue:[
    77         self logInfo:'configured to run expecco unit tests only'.
    78         doRunSpecificUnitTests := true.
    79         unitTestSuiteName := 'expecco Unit Tests'.
    80         excludedUnitTestClassNames := self excludedUnitTestClassNamesForExpecco.
    81     ].
    82 
    83     index := arguments indexOf:'--resultFile'.
    84     index > 0 ifTrue:[
    85         resultFilePathName := arguments at:index + 1.
    86         self logInfo:'set custom result file: ', resultFilePathName printString.
    87     ].
    88 
    89     [   
    90         (index := arguments indexOf:'--run') > 0 
    91     ] whileTrue:[
    92         runTestCases add:(arguments at:index + 1).
    93         self logInfo:'run test case: ', (arguments at:index + 1) printString.
    94         arguments removeIndex:index + 1.
    95         arguments removeIndex:index.
    96     ].
    97     
    98     index := arguments indexOf:'--forceTestCase'.
    99     index > 0 ifTrue:[
   100         forceTestCase := arguments at:index + 1.
   101         self logInfo:'set force test case: ', forceTestCase printString.
   102     ].
   103 
   104     doRunSpecificUnitTests ifFalse:[
   105         self logInfo:'configured to run all available unit tests'.
   106     ].
   107 
   108     self logInfo:'collecting unit test classes to run'.
   109     unitTestSuite := TestSuite named:unitTestSuiteName.
   110 
   111     (Smalltalk at: #'stx_goodies_regression') classNames do:[:eachClassName |
   112         (excludedUnitTestClassNames includes:eachClassName) ifTrue:[
   113             self
   114                 logInfo:('excluded unit test class "%1".'
   115                     bindWith:eachClassName).
   116         ] ifFalse:[
   117             (corruptedUnitTestClassNames includes:eachClassName) ifTrue:[
   118                 self
   119                     logWarning:('RunUnitTest: unit test class is marked as corrupted, please fix #%1'
   120                         bindWith:eachClassName).
   121             ] ifFalse:[
   122                 (eachClassName notNil
   123                 and:[
   124                     "/ skip non test case classes
   125                     (#(
   126                         'stx_goodies_regression'
   127                     ) includes:eachClassName) not
   128                 and:[
   129                     forceTestCase isNil
   130                     or:[forceTestCase = eachClassName
   131                     or:[forceTestCase = ((eachClassName subStrings:'::') lastIfEmpty:nil)]]
   132                 ]]) ifTrue:[
   133                     eachClass := Smalltalk at:eachClassName.
   134 
   135                     useCompiledUnitTestClasses ifFalse:[
   136                         "here we want test the jitter code
   137                          therfor we file in, exit if the class is already present somwhow"
   138                         eachClass notNil ifTrue:[
   139                             self
   140                                 logWarning:('Unit test class "%1" was already present before file in.'
   141                                     bindWith:eachClassName).
   142 
   143                             Smalltalk exit:1.
   144                         ].
   145 
   146                         eachClass := Smalltalk
   147                             fileInClass:eachClassName
   148                             package:'stx:goodies/regression'.
   149                     ].
   150 
   151                     eachClass notNil ifTrue:[
   152                         (eachClass isTestCaseLike
   153                         and:[eachClass isAbstract not]) ifTrue:[
   154                             self
   155                                 logInfo:('added unit test class "%1".'
   156                                     bindWith:eachClassName).
   157 
   158                             unitTestSuite addTest:eachClass suite.
   159                         ] ifFalse:[
   160                             self
   161                                 logInfo:('not a unit test class "%1" (class is abstract or something else).'
   162                                     bindWith:eachClassName).
   163                         ].
   164                     ] ifFalse:[
   165                         self
   166                             logWarning:('unit test class "%1" is not loaded.'
   167                                 bindWith:eachClassName).
   168                     ].
   169                 ] ifFalse:[
   170                     self
   171                         logInfo:('skipped unit test class "%1".'
   172                             bindWith:eachClassName).
   173                 ].
   174             ].
   175         ].
   176     ].
   177 
   178     self
   179         logInfo:('%1 unit test classes collected'
   180             bindWith:unitTestSuite tests size).
   181 
   182     self logInfo:'start tests...'.
   183     result := unitTestSuite
   184         run:TestResultStX new
   185         beforeEachDo:[:test | self logInfo:'performing unit test ', test printString]
   186         afterEachDo:[:test| ]
   187         debug:debug.
   188 
   189     self logInfo:'tests finished.'.
   190     
   191     self logInfo:'generating xml report...'.
   192     TestResultReporter
   193         report:result
   194         format:#xml_jUnit
   195         as:resultFilePathName ? 'testresult.xml'.
   196 
   197     self logInfo:('xml report in %1' bindWith:(resultFilePathName ? 'testresult.xml') asFilename pathName).
   198 
   199     self logInfo:'Summary:'.
   200     self logInfo:('%1 tests' bindWith:result tests size).
   201     self logInfo:('%1 run' bindWith:result runCount).
   202     self logInfo:('%1 skipped' bindWith:result skippedCount).
   203     self logInfo:('%1 passed' bindWith:result passedCount).
   204     self logInfo:('%1 failed' bindWith:result failureCount).
   205     self logInfo:('%1 errors' bindWith:result errorCount).
   206 
   207     "Modified (format): / 16-05-2018 / 13:59:47 / sr"
   208     "Modified: / 26-03-2019 / 19:00:38 / Claus Gittinger"
   209 ! !
   210 
   211 !RunUnitTests class methodsFor:'constants'!
   212 
   213 corruptedUnitTestClassNames
   214     ^ #(
   215 	#'RegressionTests::ExternalInterfaceTests'
   216 	#'RegressionTests::DebuggerTest'
   217 	#'RegressionTests::ContextTest2'
   218     )
   219 !
   220 
   221 excludedUnitTestClassNamesForAll
   222     ^ #(
   223 	#'RegressionTests::SelectorNamespacesTests'
   224     )
   225 !
   226 
   227 excludedUnitTestClassNamesForExpecco
   228     ^ self excludedUnitTestClassNamesForAll
   229 	, #(
   230 	    #'RegressionTests::VMCrashTestCase'
   231 	    #'RegressionTests::VMCrashTests'
   232 	    #'RegressionTests::ParserTests'
   233 	    #'RegressionTests::BreakpointTests'
   234 	    #'RegressionTests::SunitXMLOutputTest'
   235 	    #'RegressionTests::CompilerTests2'
   236 	    #'RegressionTests::BehaviorLookupObjectTests'
   237 	    #'RegressionTests::ChangeSetTests'
   238 	    #'RegressionTests::MakefileTests'
   239 	    #'RegressionTests::MetaphoneStringComparatorTest'
   240 	    #'RegressionTests::STCCompilerTests'
   241 	    #'RegressionTests::VMCrashTests'
   242 	    #'RegressionTests::SnapshotRestartTests'
   243 	    #'RegressionTests::GraphicDrawingTest'
   244 	    #'RegressionTests::OS_OLE_Tests'
   245 	    #'RegressionTests::ExternalInterfaceTests'
   246 	    #'RegressionTests::DebuggerTest'
   247 	    #'RegressionTests::ContextTest2'
   248 	    #'RegressionTests::QDoubleTests'
   249 	)
   250 ! !
   251 
   252 !RunUnitTests class methodsFor:'examples'!
   253 
   254 example1
   255     Processor activeProcess exceptionHandlerSet
   256 	on:Class updateChangeFileQuerySignal
   257 	do:[:ex | ex proceedWith:false].
   258 
   259     self
   260 	runWithCompiledUnitTestClasses:true
   261 	arguments:#(
   262 	    '--runOnlyExpeccoUnitTests'
   263 	    '--forceTestCase'
   264 	    'ExternalStreamTest'
   265 	)
   266 	debug:true
   267 !
   268 
   269 example2
   270     Processor activeProcess exceptionHandlerSet
   271         on:Class updateChangeFileQuerySignal
   272         do:[:ex | ex proceedWith:false].
   273 
   274     self
   275         runWithCompiledUnitTestClasses:true
   276         arguments:#(
   277             '--forceTestCase'
   278             'RegressionTests::ExternalStreamTest'
   279         )
   280         debug:true
   281 
   282     "Created: / 26-03-2019 / 18:46:46 / Claus Gittinger"
   283 !
   284 
   285 example2b
   286     Processor activeProcess exceptionHandlerSet
   287         on:Class updateChangeFileQuerySignal
   288         do:[:ex | ex proceedWith:false].
   289 
   290     self
   291         runWithCompiledUnitTestClasses:true
   292         arguments:#(
   293             '--forceTestCase'
   294             'ExternalStreamTest'
   295         )
   296         debug:true
   297 
   298     "Created: / 26-03-2019 / 18:55:46 / Claus Gittinger"
   299 !
   300 
   301 example2c
   302     Processor activeProcess exceptionHandlerSet
   303         on:Class updateChangeFileQuerySignal
   304         do:[:ex | ex proceedWith:false].
   305 
   306     self
   307         runWithCompiledUnitTestClasses:true
   308         arguments:#(
   309             '--forceTestCase'
   310             'CRCTests'
   311         )
   312         debug:true
   313 
   314     "Created: / 26-03-2019 / 18:58:36 / Claus Gittinger"
   315 !
   316 
   317 example3
   318     Processor activeProcess exceptionHandlerSet
   319         on:Class updateChangeFileQuerySignal
   320         do:[:ex | ex proceedWith:false].
   321 
   322     self
   323         runWithCompiledUnitTestClasses:true
   324         arguments:#(
   325             '--run'
   326             'ExternalStreamTest'
   327         )
   328         debug:true
   329 
   330     "Created: / 26-03-2019 / 18:51:42 / Claus Gittinger"
   331 ! !
   332 
   333 !RunUnitTests class methodsFor:'logging'!
   334 
   335 log:aString type:aType
   336     Transcript notNil ifTrue:[
   337         Transcript showCR:'%1 [%2] : %3'
   338                 with:Timestamp now printString
   339                 with:(aType printString asLowercase paddedTo:'warning' size)
   340                 with:aString.
   341         ^ self       
   342     ].    
   343     Stderr showCR:'%1 [%2] : %3'
   344             with:Timestamp now printString
   345             with:(aType printString asLowercase paddedTo:'warning' size)
   346             with:aString.
   347 
   348     "Modified: / 26-03-2019 / 18:53:48 / Claus Gittinger"
   349 !
   350 
   351 logInfo:aString
   352     self
   353 	log:aString
   354 	type:'INFO'
   355 !
   356 
   357 logWarning:aString
   358     self
   359 	log:aString
   360 	type:'WARNING'
   361 ! !
   362 
   363 !RunUnitTests class methodsFor:'documentation'!
   364 
   365 version
   366     ^ '$Header$'
   367 !
   368 
   369 version_CVS
   370     ^ '$Header$'
   371 ! !
   372