jan@72: "{ Package: 'stx:goodies/builder/reports' }"
jan@72: 
jan@72: "{ NameSpace: Builder }"
jan@72: 
jan@72: StandaloneStartup subclass:#ReportRunner
jan@72: 	instanceVariableNames:''
jan@72: 	classVariableNames:''
jan@72: 	poolDictionaries:''
jan@72: 	category:'Builder-Reports'
jan@72: !
jan@72: 
jan@217: ReportRunner class instanceVariableNames:'parser report debugging setup teardown ident'
jan@72: 
jan@72: "
jan@72:  The following class instance variables are inherited by this class:
jan@72: 
jan@72: 	StandaloneStartup - MutexHandle
jan@217: 	Object - 
jan@72: "
jan@72: !
jan@72: 
jan@72: 
jan@72: !ReportRunner class methodsFor:'initialization'!
jan@72: 
jan@72: initialize
jan@72: 
jan@72:     super initialize.
jan@72:     debugging := Transcript notNil and:[Transcript isView].
jan@184:     self setupSignalHandlers.
jan@72: 
jan@72:     "Created: / 06-11-2011 / 22:07:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184:     "Modified: / 28-06-2013 / 01:13:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@72: ! !
jan@72: 
jan@72: !ReportRunner class methodsFor:'command line options'!
jan@72: 
jan@217: cmdlineOptionIdent
jan@217: 
jan@217:     ^CmdLineOption new
jan@217:         short: $i;
jan@217:         long: 'ident';
jan@217:         description: 'run/configuration identification';
jan@217:         action:[:option |
jan@217:             ident := option.
jan@217:         ];
jan@217:         yourself
jan@217: 
jan@217:     "Created: / 22-01-2014 / 10:00:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@217: !
jan@217: 
jan@72: cmdlineOptionOutputDirectory
jan@72: 
jan@72:     ^CmdLineOption new
jan@72:         short: $D;
jan@72:         long: 'output-directory';
jan@72:         description: 'Default report output directory';
jan@188:         action:[:outputdir |
jan@72:             Report outputDir: outputdir.
jan@72:             self  verboseInfo:'Report dir: ' , Report outputDir asString.
jan@217:         ];
jan@217:         yourself
jan@72: 
jan@72:     "Created: / 06-11-2011 / 09:33:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@217:     "Modified: / 22-01-2014 / 10:00:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@72: !
jan@72: 
jan@72: cmdlineOptionReport
jan@72: 
jan@72:     ^CmdLineOption new
jan@72:         short: $r;
jan@97:         long: 'report';
jan@72:         description: 'Report to run';
jan@72:         action:[:option |
jan@72:             report := Smalltalk at: option asSymbol.
jan@72:             report isNil ifTrue:[
jan@188:                 Stderr nextPutLine:('ERROR: Report class %1 does not exist (forgot to load package?)' bindWith: option).
jan@188:                 "/Smalltalk exit: 1.
jan@72:             ].
jan@72:             report := report new.
jan@72:             parser options addAll: (CmdLineOption optionsFor: report)
jan@217:         ];
jan@217:         yourself
jan@72: 
jan@72:     "Created: / 06-11-2011 / 09:45:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@217:     "Modified: / 22-01-2014 / 10:00:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@147: !
jan@147: 
jan@147: cmdlineOptionSetup
jan@147: 
jan@147:     ^CmdLineOption new
jan@225:         short: $S;
jan@147:         long: 'setup';
jan@147:         description: 'Code executed before tests are loaded and executed';
jan@188:         action:[:option |
jan@147:             setup := option
jan@217:         ];
jan@217:         yourself
jan@147: 
jan@147:     "Created: / 15-05-2013 / 16:50:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@225:     "Modified: / 24-01-2014 / 15:26:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@147: !
jan@147: 
jan@147: cmdlineOptionTeardown
jan@147: 
jan@147:     ^CmdLineOption new
jan@217:         short: $T;
jan@217:         long: 'teardown';
jan@147:         description: 'Code executed after all tests are executed';
jan@188:         action:[:option |
jan@147:             teardown := option
jan@217:         ];
jan@217:         yourself
jan@147: 
jan@147:     "Created: / 15-05-2013 / 16:50:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@217:     "Modified: / 22-01-2014 / 10:01:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@72: ! !
jan@72: 
jan@184: !ReportRunner class methodsFor:'debugging'!
jan@184: 
jan@184: dumpProcess: aProcess
jan@184:     Stderr cr; cr
jan@184: 
jan@184:     "Created: / 27-06-2013 / 23:41:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184: !
jan@184: 
jan@184: dumpProcess: aProcess on: aStream
jan@184:     | ctx |
jan@184:     aStream cr; cr.
jan@184:     aStream nextPutAll: '== ['; nextPutAll: aProcess id printString; nextPutAll:'] '; nextPutAll: aProcess name; nextPutAll: ' =='; cr.
jan@184:     aStream cr.
jan@238:     aStream nextPutAll: '  State:   '; nextPutAll: aProcess state printString; cr.
jan@238:     aStream nextPutAll: '  Group:   '; nextPutAll: aProcess processGroupId printString; cr.
jan@238:     aStream nextPutAll: '  Creator: '; nextPutAll: aProcess processGroupId printString; cr.
jan@238:     aStream nextPutAll: '  Stack:   '; cr; cr.
jan@184: 
jan@188:     aProcess == Processor activeProcess ifTrue:[ctx := thisContext] ifFalse:[ctx := aProcess suspendedContext].
jan@184:     [ ctx notNil ] whileTrue:[
jan@184:         aStream nextPutAll: '  '.
jan@188:         ctx fullPrintOn: aStream.
jan@184:         aStream cr.
jan@184:         ctx := ctx sender.
jan@184:     ].
jan@184:     aStream cr.
jan@184: 
jan@184:     "
jan@184:         self dumpProcess: Processor activeProcess on: Transcript.
jan@184:     "
jan@184: 
jan@184:     "Created: / 28-06-2013 / 01:00:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@238:     "Modified: / 06-06-2014 / 09:14:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184: !
jan@184: 
jan@184: dumpProcesses
jan@184:     self dumpProcessesOn: Stderr
jan@184: 
jan@184:     "
jan@184:     self dumpProcessesOn: Transcript.
jan@184:     "
jan@184: 
jan@184:     "Created: / 27-06-2013 / 23:41:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184:     "Modified (comment): / 28-06-2013 / 01:06:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184: !
jan@184: 
jan@184: dumpProcessesOn: aStream
jan@184:     Process allInstancesDo:[:process|
jan@184:         process isDead ifFalse:[
jan@184:             self dumpProcess: process on: aStream
jan@184:         ]
jan@184:     ]
jan@184: 
jan@184:     "Created: / 27-06-2013 / 23:42:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184: ! !
jan@184: 
jan@72: !ReportRunner class methodsFor:'defaults'!
jan@72: 
jan@77: allowCoverageMeasurementOption
jan@77: 
jan@77:     ^false "CoverageReport will do that"
jan@77: 
jan@77:     "Created: / 13-01-2012 / 11:48:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@77: !
jan@77: 
jan@72: allowDebugOption
jan@72: 
jan@72:     ^true
jan@72: 
jan@72:     "Created: / 21-07-2011 / 09:48:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@72: ! !
jan@72: 
jan@72: !ReportRunner class methodsFor:'multiple applications support'!
jan@72: 
jan@72: applicationRegistryPath
jan@72:     "the key under which this application stores its process ID in the registry
jan@72:      as a collection of path-components.
jan@72:      i.e. if #('foo' 'bar' 'baz') is returned here, the current applications ID will be stored
jan@72:      in HKEY_CURRENT_USER\Software\foo\bar\baz\CurrentID.
jan@72:      (would also be used as a relative path for a temporary lock file under unix).
jan@72:      Used to detect if another instance of this application is already running."
jan@72: 
jan@72:     ^ #('exept' 'smalltallx' 'hdreportrunner')
jan@72: 
jan@72:     "Modified: / 21-07-2011 / 09:43:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@72: !
jan@72: 
jan@72: applicationUUID
jan@72:     "answer an application-specific unique uuid.
jan@72:      This is used as the name of some exclusive OS-resource, which is used to find out,
jan@72:      if another instance of this application is already running.
jan@72:      Under win32, a mutex is used; under unix, an exclusive file in the tempDir could be used."
jan@72: 
jan@72:     ^ '99f65c80-b375-11e0-86ad-0013e89c0459' asUUID
jan@72: 
jan@72:     "Modified: / 21-07-2011 / 09:44:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@72: ! !
jan@72: 
jan@72: !ReportRunner class methodsFor:'startup'!
jan@72: 
jan@184: handleSIGTERM
jan@184:     self dumpProcesses.
jan@184:     debugging ifFalse:[
jan@184:         Smalltalk exit:127.
jan@184:     ].
jan@184: 
jan@184:     "Created: / 27-06-2013 / 23:10:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184:     "Modified: / 28-06-2013 / 01:08:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184: !
jan@184: 
jan@184: handleSIGUSR2
jan@184:     self dumpProcesses
jan@184: 
jan@184:     "Created: / 27-06-2013 / 23:10:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184: !
jan@184: 
jan@184: setupSignalHandlers
jan@184:     "On UNIX, this sets up a custom signal handler on SIGUSR2 and SIGTERM that
jan@184:      dumps stacks on all threads"
jan@184: 
jan@188:     | sigusr2 sigterm |
jan@188: 
jan@184:     OperatingSystem isUNIXlike ifTrue:[
jan@188: 
jan@184: 
jan@184:         sigterm := Signal new.
jan@184:         sigterm handlerBlock: [:ex | self handleSIGTERM].
jan@184:         OperatingSystem operatingSystemSignal:OperatingSystem sigTERM install: sigterm.
jan@184:         OperatingSystem enableSignal: OperatingSystem sigTERM.
jan@184: 
jan@184:         sigusr2 := Signal new.
jan@184:         sigusr2 handlerBlock: [:ex | self handleSIGUSR2].
jan@184:         OperatingSystem operatingSystemSignal:OperatingSystem sigUSR2 install: sigusr2.
jan@184:         OperatingSystem enableSignal: OperatingSystem sigUSR2.
jan@184:     ].
jan@184: 
jan@184:     "
jan@188:     OperatingSystem sendSignal: OperatingSystem sigUSR2 to: OperatingSystem getProcessId
jan@184:     "
jan@184: 
jan@184:     "Created: / 27-06-2013 / 20:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184:     "Modified: / 28-06-2013 / 01:11:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@184: !
jan@184: 
jan@72: setupToolsForDebug
jan@72: 
jan@72:     super setupToolsForDebug.
jan@72:     debugging := true.
jan@72: 
jan@72:     "Created: / 06-11-2011 / 22:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@77: !
jan@77: 
jan@217: start
jan@217:     Smalltalk silentLoading: true.
jan@217:     ^ super start.
jan@217: 
jan@217:     "Created: / 22-01-2014 / 09:17:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@217: !
jan@217: 
jan@77: usage
jan@77: 
jan@77:     Stderr nextPutAll:'usage: report-runner.';
jan@77:            nextPutAll: (OperatingSystem isMSWINDOWSlike ifTrue:['bat'] ifFalse:['sh']);
jan@77:            nextPutAll: ' [-D <dir>] -r <report> [-p <package1> [-p <package2> [...]]]'; cr.
jan@77: 
jan@232:     Stderr nextPutLine:'Common options:'; cr.
jan@232: 
jan@77:     Stderr nextPutLine:'  --help .................. output this message'.
jan@232: "/    Stderr nextPutLine:'  --verbose ............... verbose startup'.
jan@232: "/    Stderr nextPutLine:'  --noBanner .............. no splash screen'.
jan@232: "/    Stderr nextPutLine:'  --newAppInstance ........ start as its own application process (do not reuse'.
jan@232: "/    Stderr nextPutLine:'                            a running instance)'.
jan@232: "/    self allowScriptingOption ifTrue:[
jan@232: "/        Stderr nextPutLine:'  --scripting portNr ...enable scripting via port (or stdin/stdOut if 0)'.
jan@232: "/    ].
jan@77:     self allowDebugOption ifTrue:[
jan@77:         Stderr nextPutLine:'  --debug ................. enable Debugger'.
jan@77:     ].
jan@77:     "/                 '  ......................... '
jan@77:     Stderr nextPutLine:'  -D <dir>'.
jan@77:     Stderr nextPutLine:'  --output-directory=<dir>  directory where report files will go'.
jan@217:     Stderr nextPutLine:'  -S <expr>'.
jan@217:     Stderr nextPutLine:'  --setup=<expr> .......... smalltalk expression that is evaluated before'. 
jan@217:     Stderr nextPutLine:'                            any report is run'.
jan@217:     Stderr nextPutLine:'  -T <expr>'.
jan@217:     Stderr nextPutLine:'  --teardown=<expr> ....... smalltalk expression that is evaluated before'. 
jan@217:     Stderr nextPutLine:'                            after all reports finished'.
jan@217:     Stderr nextPutLine:'  -i <ident>'.
jan@217:     Stderr nextPutLine:'  --ident=<ident> ......... run/configuration identification string to'.
jan@217:     Stderr nextPutLine:'                            use when creating output files'.
jan@77:     Stderr nextPutLine:'  -r <report class>'.
jan@77:     Stderr nextPutLine:'  --report=<report class> . report to run. available reports:'.
jan@77:     Report available do:[:report|
jan@77:         Stderr nextPutAll:'      '; nextPutLine: report name
jan@77:     ].
jan@77:     Stderr nextPutLine:'  -p <package>'.
jan@77:     Stderr nextPutLine:'  --package=<package> ..... package to run report on'.
jan@77:     Stderr nextPutLine:'                            May be specified multiple times.'.
jan@232: 
jan@232:     Report available do:[:cls|
jan@232:         self usageForReportClass: cls.
jan@232:     ].
jan@232: 
jan@232: 
jan@232:     debugging ifFalse:[
jan@217:         Smalltalk exit:1.
jan@232:     ].
jan@77:     "
jan@77:     self usage
jan@77:     "
jan@77: 
jan@77:     "Created: / 13-01-2012 / 11:48:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@232:     "Modified: / 27-05-2014 / 17:02:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@232: !
jan@232: 
jan@232: usageForReportClass: class
jan@232:     | options |
jan@232: 
jan@232:     "/ '.........................' size  25
jan@232:     options := CmdLineOption optionsFor: class new.
jan@232:     options := options reject:[:option | 'pF' includes: option short  ].
jan@232:     options notEmptyOrNil ifTrue:[
jan@232:         Stderr cr.
jan@232:         Stderr nextPutAll: class name; nextPutLine:' options:'; cr.
jan@232:         options do:[:option |                
jan@232:             | optlen |  
jan@232: 
jan@232:             option short notNil ifTrue:[ 
jan@243:                 Stderr nextPutAll: '  '.
jan@232:                 Stderr nextPut: $-; nextPut: option short; space.
jan@232:                 optlen := 2.
jan@232:                 option hasParam ifTrue:[ 
jan@232:                     | paramName |
jan@232: 
jan@232:                     paramName := 'val'.
jan@232:                     Stderr nextPut:$<; nextPutAll: paramName; nextPut:$>; space.
jan@232:                     optlen := optlen + 3 + paramName size.
jan@232:                 ].
jan@232:             ].
jan@232:             option long notNil ifTrue:[ 
jan@232:                  option short notNil ifTrue:[ 
jan@232:                     Stderr cr.
jan@232:                 ].
jan@232:                 Stderr nextPutAll: '  --'.
jan@232:                 Stderr nextPutAll: option long.
jan@232:                 optlen := option long size + 2.
jan@232:                 option hasParam ifTrue:[ 
jan@232:                     | paramName |
jan@232: 
jan@232:                     paramName := 'val'.
jan@232:                     Stderr nextPut:$=; nextPut:$<; nextPutAll: paramName; nextPut:$>.
jan@232:                     optlen := optlen + 3 + paramName size.
jan@232:                 ].
jan@232:                 Stderr space.
jan@232:             ].
jan@232:             Stderr next: (26 - 1"space" -2"--" - optlen) put: $..    
jan@232:             Stderr space.
jan@232:             option description notNil ifTrue:[
jan@232:                 Stderr nextPutAll: option description
jan@232:             ].
jan@232:             Stderr cr.
jan@232:         ]
jan@232:     ]
jan@232: 
jan@243:     "
jan@243:     ReportRunner usageForReportClass: TestReport.
jan@243:     "
jan@243: 
jan@232:     "Created: / 27-05-2014 / 16:42:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@243:     "Modified: / 16-06-2014 / 11:25:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@72: ! !
jan@72: 
jan@72: !ReportRunner class methodsFor:'startup-to be redefined'!
jan@72: 
jan@189: main:argv0
sv@143:     "Process command line arguments"
jan@102: 
jan@189:     | argv |
jan@189: 
jan@189:     argv := argv0 asOrderedCollection.
jan@232:     argv isEmpty ifTrue:[ 
jan@232:         self usage.
jan@232:     ].
jan@189:     argv remove: '--abortOnSEGV' ifAbsent:[nil].
jan@72:     parser := CmdLineParser new.
sv@144:     CmdLineOptionError autoload.
sv@144: 
jan@188:     [
jan@188:         parser parse: argv for: self.
sv@143:     ] on:CmdLineOptionError do:[:ex|
jan@72:         Stderr nextPutLine:'Error when processing options: ', ex description.
jan@188:         debugging ifFalse:[
jan@92:             ex suspendedContext fullPrintAllOn: Stderr.
jan@72:             Stderr nextPutLine:'Exiting'.
jan@72:             Smalltalk exit:1.
jan@72:         ] ifTrue:[
jan@72:             ex pass
jan@188:         ]
jan@72:     ].
jan@72: 
jan@230:     debugging ifFalse:[ 
jan@230:         NoHandlerError emergencyHandler:(NoHandlerError abortingEmergencyHandler)
jan@230:     ].
jan@230: 
jan@72:     [
jan@147:         setup notNil ifTrue:[Compiler evaluate: setup].
jan@147:         [
jan@217:             report ident: ident.
jan@147:             report run.
jan@147:         ] ensure:[
jan@147:             teardown notNil ifTrue:[Compiler evaluate: teardown].
jan@147:         ].
jan@72:         debugging ifFalse:[
jan@72:             Smalltalk exit:0.
jan@72:         ].
jan@72:     ] on: Error do:[:ex|
jan@72:         Stderr nextPutAll:'Error when running tests: '.
jan@72:         Stderr nextPutAll:ex description; cr.
jan@72:         ex suspendedContext printAllOn:Stderr.
jan@147: 
jan@147: 
jan@72:         debugging ifFalse:[
jan@72:             Smalltalk exit:1.
jan@72:         ] ifTrue:[
jan@72:             ex pass
jan@72:         ]
jan@72:     ]
jan@72: 
jan@232:     "Modified: / 27-05-2014 / 17:05:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
jan@72: ! !
jan@72: 
jan@72: !ReportRunner class methodsFor:'documentation'!
jan@72: 
jan@72: version
jan@72:     ^ '$Header$'
jan@72: !
jan@72: 
jan@72: version_CVS
jan@72:     ^ '$Header$'
jan@72: !
jan@72: 
jan@72: version_SVN
jan@147:     ^ '$Id$'
jan@72: ! !
jan@72: 
sv@143: 
jan@72: ReportRunner initialize!