A new version of SUnitTools was added to project The Inbox:
http://source.squeak.org/inbox/SUnitTools-tcj.4.mcz ==================== Summary ==================== Name: SUnitTools-tcj.4 Author: tcj Time: 9 June 2018, 12:55:17.485052 pm UUID: 9f8d6f94-46c6-4bb1-884d-1d0e66fd5b62 Ancestors: SUnitTools-mt.3 Fixes use of 'find tested item' on TestCase subclasses whose name end in 'Tests' rather than 'Test'. This opens up 'find tested item' to work on 24 additional TestCase subclasses where it would not have worked before. It should result in only one false positive (LongTestCaseTestUnderTest) which will silently fail to locate, as designed =============== Diff against SUnitTools-mt.3 =============== Item was changed: ----- Method: CodeHolder>>testFindTested (in category '*SUnitTools-running') ----- testFindTested + | cls classNameParts destClassName destMessage | - | cls destClassName destMessage | cls := self selectedClass ifNil: [^ self]. cls isTestClass ifFalse: [" already there " ^ self]. + + classNameParts := cls name asString piecesCutWhere: [:a :b | b isUppercase]. + destClassName := (classNameParts last beginsWith: 'Test') + ifTrue: [classNameParts allButLast join] - - destClassName := (cls name asString endsWith: 'Test') - ifTrue: [cls name asString allButLast: 4] ifFalse: [^ self]. destMessage := self selectedMessageName ifNotNil: [:selector | | messageName | messageName := selector asString. (messageName beginsWith: 'test') "operate on test methods only" ifTrue: [ (self class environment classNamed: destClassName) ifNotNil: [:destClass | destClass selectors detect: [:destSelector | (self testSelectorFrom: destSelector) = messageName] ifNone: [nil]]] ifFalse: [nil]]. self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage + ! - - - ! |
Hi,
For the curious, here is extra info beyond what is in the commit message. This opens up the menu choice 'find tested item' for the following TestCase subclasses whose names end in 'Tests' rather than 'Test': Smalltalk classNames select: [:className | className endsWith: 'Tests' ] => #(#BitmapStreamTests #BorderedMorphTests #BytecodeDecodingTests #ClosureTests #CogVMBaseImageTests #DecompilerTests #DosFileDirectoryTests #ExceptionTests #FlapTabTests #HandMorphForEventTests #MVCToolBuilderTests #MethodHighlightingTests #MirrorPrimitiveTests #MorphForEventTests #MorphicEventDispatcherTests #MorphicEventFilterTests #MorphicEventTests #MorphicToolBuilderTests #ObjectFinalizerTests #PluggableMenuItemSpecTests #SUnitToolBuilderTests #ToolBuilderTests #UnixFileDirectoryTests #UserInputEventTests) Out of curiosity, I also wanted to justify testing camelCase parts against just getting the index of the word 'Test'. So I checked for TestCase subclasses who (1) end in 'Test' or 'Tests' and (2) contain the word 'Test' somewhere else in the middle of their names. There are four: | camelTest | camelTest := Smalltalk classNames collect: [:cn | cn piecesCutWhere: [:a :b | b isUppercase]] thenSelect: [:oc | oc last beginsWith: 'Test']. "drop final Test/Tests and then test intermediate camel humps for word 'Test' " camelTest select: [:oc | oc allButLast anySatisfy: [:s | s beginsWith: 'Test']] thenCollect: [:oc | oc join] => #('ClassFactoryForTestCaseTest' 'HashTesterTest' 'LongTestCaseTest' 'LongTestCaseTestUnderTest') This fix of course has no effect on those, except they work just as well as they used to. :) AFAICT of those four classes, only LongTestCaseTestUnderTest is named such that 'find tested item' results in a class that does not exist (there is no class named LongTestCaseTestUnder). Again, my fix has no effect on this. Thanks, Tim > On Jun 9, 2018, at 12:55 PM, [hidden email] wrote: > > A new version of SUnitTools was added to project The Inbox: > http://source.squeak.org/inbox/SUnitTools-tcj.4.mcz > > ==================== Summary ==================== > > Name: SUnitTools-tcj.4 > Author: tcj > Time: 9 June 2018, 12:55:17.485052 pm > UUID: 9f8d6f94-46c6-4bb1-884d-1d0e66fd5b62 > Ancestors: SUnitTools-mt.3 > > Fixes use of 'find tested item' on TestCase subclasses whose name end in 'Tests' rather than 'Test'. This opens up 'find tested item' to work on 24 additional TestCase subclasses where it would not have worked before. It should result in only one false positive (LongTestCaseTestUnderTest) which will silently fail to locate, as designed > > =============== Diff against SUnitTools-mt.3 =============== > > Item was changed: > ----- Method: CodeHolder>>testFindTested (in category '*SUnitTools-running') ----- > testFindTested > + | cls classNameParts destClassName destMessage | > - | cls destClassName destMessage | > cls := self selectedClass ifNil: [^ self]. > cls isTestClass ifFalse: [" already there " ^ self]. > + > + classNameParts := cls name asString piecesCutWhere: [:a :b | b isUppercase]. > + destClassName := (classNameParts last beginsWith: 'Test') > + ifTrue: [classNameParts allButLast join] > - > - destClassName := (cls name asString endsWith: 'Test') > - ifTrue: [cls name asString allButLast: 4] > ifFalse: [^ self]. > destMessage := self selectedMessageName ifNotNil: [:selector | | messageName | > messageName := selector asString. > (messageName beginsWith: 'test') "operate on test methods only" > ifTrue: [ (self class environment classNamed: destClassName) > ifNotNil: [:destClass | destClass selectors > detect: [:destSelector | (self testSelectorFrom: destSelector) = messageName] > ifNone: [nil]]] > ifFalse: [nil]]. > self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage > + ! > - > - > - ! > > > |
Thanks Tim,
I moved your package to trunk. Dave On Sat, Jun 09, 2018 at 01:11:57PM -0700, Tim Johnson wrote: > Hi, > > For the curious, here is extra info beyond what is in the commit message. > > This opens up the menu choice 'find tested item' for the following TestCase subclasses whose names end in 'Tests' rather than 'Test': > > Smalltalk classNames select: [:className | className endsWith: 'Tests' ] > => > #(#BitmapStreamTests #BorderedMorphTests #BytecodeDecodingTests #ClosureTests #CogVMBaseImageTests #DecompilerTests #DosFileDirectoryTests #ExceptionTests #FlapTabTests #HandMorphForEventTests #MVCToolBuilderTests #MethodHighlightingTests #MirrorPrimitiveTests #MorphForEventTests #MorphicEventDispatcherTests #MorphicEventFilterTests #MorphicEventTests #MorphicToolBuilderTests #ObjectFinalizerTests #PluggableMenuItemSpecTests #SUnitToolBuilderTests #ToolBuilderTests #UnixFileDirectoryTests #UserInputEventTests) > > Out of curiosity, I also wanted to justify testing camelCase parts against just getting the index of the word 'Test'. So I checked for TestCase subclasses who (1) end in 'Test' or 'Tests' and (2) contain the word 'Test' somewhere else in the middle of their names. There are four: > > | camelTest | > camelTest := Smalltalk classNames > collect: [:cn | cn piecesCutWhere: [:a :b | b isUppercase]] > thenSelect: [:oc | oc last beginsWith: 'Test']. > "drop final Test/Tests and then test intermediate camel humps for word 'Test' " > camelTest > select: [:oc | oc allButLast anySatisfy: [:s | s beginsWith: 'Test']] > thenCollect: [:oc | oc join] > > => > #('ClassFactoryForTestCaseTest' 'HashTesterTest' 'LongTestCaseTest' 'LongTestCaseTestUnderTest') > > This fix of course has no effect on those, except they work just as well as they used to. :) > > AFAICT of those four classes, only LongTestCaseTestUnderTest is named such that 'find tested item' results in a class that does not exist (there is no class named LongTestCaseTestUnder). Again, my fix has no effect on this. > > Thanks, > Tim > > > > On Jun 9, 2018, at 12:55 PM, [hidden email] wrote: > > > > A new version of SUnitTools was added to project The Inbox: > > http://source.squeak.org/inbox/SUnitTools-tcj.4.mcz > > > > ==================== Summary ==================== > > > > Name: SUnitTools-tcj.4 > > Author: tcj > > Time: 9 June 2018, 12:55:17.485052 pm > > UUID: 9f8d6f94-46c6-4bb1-884d-1d0e66fd5b62 > > Ancestors: SUnitTools-mt.3 > > > > Fixes use of 'find tested item' on TestCase subclasses whose name end in 'Tests' rather than 'Test'. This opens up 'find tested item' to work on 24 additional TestCase subclasses where it would not have worked before. It should result in only one false positive (LongTestCaseTestUnderTest) which will silently fail to locate, as designed > > > > =============== Diff against SUnitTools-mt.3 =============== > > > > Item was changed: > > ----- Method: CodeHolder>>testFindTested (in category '*SUnitTools-running') ----- > > testFindTested > > + | cls classNameParts destClassName destMessage | > > - | cls destClassName destMessage | > > cls := self selectedClass ifNil: [^ self]. > > cls isTestClass ifFalse: [" already there " ^ self]. > > + > > + classNameParts := cls name asString piecesCutWhere: [:a :b | b isUppercase]. > > + destClassName := (classNameParts last beginsWith: 'Test') > > + ifTrue: [classNameParts allButLast join] > > - > > - destClassName := (cls name asString endsWith: 'Test') > > - ifTrue: [cls name asString allButLast: 4] > > ifFalse: [^ self]. > > destMessage := self selectedMessageName ifNotNil: [:selector | | messageName | > > messageName := selector asString. > > (messageName beginsWith: 'test') "operate on test methods only" > > ifTrue: [ (self class environment classNamed: destClassName) > > ifNotNil: [:destClass | destClass selectors > > detect: [:destSelector | (self testSelectorFrom: destSelector) = messageName] > > ifNone: [nil]]] > > ifFalse: [nil]]. > > self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage > > + ! > > - > > - > > - ! > > > > > > > > |
Free forum by Nabble | Edit this page |