SystemOrganization addCategory: #HudsonBuildTools!
Object subclass: #HDReport
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'HudsonBuildTools'!
HDReport subclass: #HDLintReport
instanceVariableNames: 'environment rules time'
classVariableNames: ''
poolDictionaries: ''
category: 'HudsonBuildTools'!
!HDLintReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:19'!
runClasses: aCollectionOfClasses named: aString
| classEnvironment |
classEnvironment := BrowserEnvironment new
forClasses: aCollectionOfClasses.
classEnvironment label: aString.
^ self runEnvironment: classEnvironment! !
!HDLintReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:20'!
runEnvironment: anEnvironment
^ self new
initializeOn: anEnvironment;
run! !
!HDLintReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:19'!
runPackage: aString
| packageEnvironment |
packageEnvironment := BrowserEnvironment new
forPackageNames: (Array with: aString).
packageEnvironment label: aString.
^ self runEnvironment: packageEnvironment! !
!HDLintReport methodsFor: 'private' stamp: 'lr 5/14/2010 13:56'!
column: aString at: anInteger
| index |
index := 1.
aString lineIndicesDo: [ :start :stop :delim |
index := anInteger - start + 1.
(anInteger between: start and: delim)
ifTrue: [ ^ index ] ].
^ index! !
!HDLintReport methodsFor: 'running' stamp: 'lr 5/14/2010 14:02'!
generate
| stream |
stream := StandardFileStream forceNewFileNamed: environment name , '-lint.xml'.
[ self generateOn: stream ] ensure: [ stream close ]! !
!HDLintReport methodsFor: 'running' stamp: 'lr 5/14/2010 15:17'!
generateClass: aClass selector: aSelector on: aStream
| matching filename source stream |
matching := rules
reject: [ :each | each result includesSelector: aSelector in: aClass ].
matching isEmpty
ifTrue: [ ^ self ].
source := aClass sourceCodeAt: aSelector.
source isNil
ifTrue: [ ^ self ].
source := source asString.
filename := aClass name , '-' , (aSelector copyReplaceAll: ':' with: '_') , '.st'.
stream := StandardFileStream forceNewFileNamed: filename.
[ stream nextPutAll: source ] ensure: [ stream close ].
aStream tab; nextPutAll: '"'; cr.
rules do: [ :each |
| interval |
interval := (each result selectionIntervalFor: source)
ifNil: [ 1 to: source size ].
aStream tab; tab; nextPutAll: ''; nextPutAll: (self encode: each rationale); nextPutAll: ''; cr ].
aStream tab; nextPutAll: ''; cr! !
!HDLintReport methodsFor: 'running' stamp: 'lr 5/14/2010 10:02'!
generateOn: aStream
aStream nextPutAll: ''; cr.
aStream nextPutAll: ''; cr.
environment classesAndSelectorsDo: [ :class :selector |
self generateClass: class selector: selector on: aStream ].
aStream nextPutAll: ''! !
!HDLintReport methodsFor: 'initialization' stamp: 'lr 5/14/2010 12:11'!
initializeOn: anEnvironment
environment := anEnvironment.
rules := RBCompositeLintRule rulesFor: RBLintRule! !
!HDLintReport methodsFor: 'private' stamp: 'lr 5/14/2010 13:57'!
line: aString at: anInteger
| index |
index := 0.
aString lineIndicesDo: [ :start :stop :delim |
index := index + 1.
(anInteger between: start and: delim)
ifTrue: [ ^ index ] ].
^ index! !
!HDLintReport methodsFor: 'running' stamp: 'lr 5/14/2010 12:12'!
run
time := [
SmalllintChecker
runRule: (RBCompositeLintRule rules: rules)
onEnvironment: environment ]
timeToRun.
self generate! !
!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:17'!
runCategories: aCollectionOfStrings
^ aCollectionOfStrings do: [ :each | self runCategory: each ]! !
!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:17'!
runCategory: aString
^ self runClasses: (Smalltalk organization classesInCategory: aString) named: aString! !
!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:15'!
runClasses: aCollectionOfClasses named: aString
self subclassResponsibility! !
!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:16'!
runPackage: aString
self subclassResponsibility! !
!HDReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:17'!
runPackages: aCollectionOfStrings
^ aCollectionOfStrings do: [ :each | self runPackage: each ]! !
!HDReport methodsFor: 'private' stamp: 'lr 5/14/2010 08:36'!
encode: aString
^ ((aString asString
copyReplaceAll: '&' with: '&')
copyReplaceAll: '"' with: '"')
copyReplaceAll: '<' with: '<'! !
!HDReport methodsFor: 'initialization' stamp: 'lr 5/14/2010 09:21'!
initializeOn: anObject
self subclassResponsibility! !
HDReport subclass: #HDTestReport
instanceVariableNames: 'suite stream suitePosition suiteTime suiteFailures suiteErrors'
classVariableNames: ''
poolDictionaries: ''
category: 'HudsonBuildTools'!
!HDTestReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:16'!
runClasses: aCollectionOfClasses named: aString
| suite classes |
suite := TestSuite named: aString.
classes := (aCollectionOfClasses
select: [ :each | (each includesBehavior: TestCase) and: [ each isAbstract not ] ])
asSortedCollection: [ :a :b | a name <= b name ].
classes isEmpty
ifTrue: [ ^ self ].
classes
do: [ :each | each addToSuiteFromSelectors: suite ].
^ self runSuite: suite! !
!HDTestReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:16'!
runPackage: aString
^ self runClasses: (PackageInfo named: aString) classes named: aString! !
!HDTestReport class methodsFor: 'running' stamp: 'lr 5/14/2010 09:16'!
runSuite: aTestSuite
^ self new
initializeOn: aTestSuite;
run! !
!HDTestReport methodsFor: 'initialization' stamp: 'lr 1/10/2010 10:22'!
initializeOn: aTestSuite
suite := aTestSuite.
suitePosition := suiteTime := suiteFailures := suiteErrors := 0! !
!HDTestReport methodsFor: 'running' stamp: 'lr 5/14/2010 14:05'!
run
Author uniqueInstance
ifUnknownAuthorUse: 'hudson'
during: [
[ self setUp.
suiteTime := [ self runAll ]
timeToRun ]
ensure: [ self tearDown ] ]! !
!HDTestReport methodsFor: 'running' stamp: 'lr 1/10/2010 15:22'!
run: aTestCase
| error time stack |
time := [ [ aTestCase runCase ]
on: Error , TestFailure
do: [ :err |
error := err.
stack := String streamContents: [ :str |
| context |
context := err signalerContext.
[ context isNil or: [ context receiver == aTestCase and: [ context methodSelector == #runCase ] ] ] whileFalse: [
str print: context; cr.
context := context sender ] ] ] ]
timeToRun.
stream tab; nextPutAll: ''; cr.
(error isNil or: [ aTestCase expectedFailures includes: aTestCase selector ]) ifFalse: [
(error isKindOf: TestFailure)
ifTrue: [
suiteFailures := suiteFailures + 1.
stream tab; tab; nextPutAll: ''; nextPutAll: (self encode: stack); nextPutAll: ''; cr ]
ifFalse: [
suiteErrors := suiteErrors + 1.
stream tab; tab; nextPutAll: ''; nextPutAll: (self encode: stack); nextPutAll: ''; cr ] ].
stream tab; nextPutAll: ''; cr! !
!HDTestReport methodsFor: 'running' stamp: 'lr 1/10/2010 01:27'!
runAll
suite tests do: [ :each | self run: each ]! !
!HDTestReport methodsFor: 'running' stamp: 'lr 5/14/2010 14:03'!
setUp
stream := StandardFileStream forceNewFileNamed: suite name , '-sunit.xml'.
stream nextPutAll: ''; cr.
stream nextPutAll: ''.
"Now this is ugly. We want to update the time and the number of failures and errors, but still at the same time stream a valid XML. So remember this position and add some whitespace, that we can fill later."
suitePosition := stream position - 1.
stream nextPutAll: (String new: 100 withAll: $ ); cr.
"Initialize the test resources."
suite resources do: [ :each |
each isAvailable
ifFalse: [ each signalInitializationError ] ]! !
!HDTestReport methodsFor: 'running' stamp: 'lr 1/10/2010 15:22'!
tearDown
suite resources
do: [ :each | each reset ].
stream tab; nextPutAll: ''; cr.
stream tab; nextPutAll: ''; cr.
stream nextPutAll: ''.
stream position: suitePosition.
stream nextPutAll: ' failures="'; print: suiteFailures; nextPutAll:'" errors="'; print: suiteErrors; nextPutAll: '" time="'; print: suiteTime / 1000.0; nextPutAll: '">'.
stream close! !