The Inbox: SUnitTools-tcj.4.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
3 messages Options
Reply | Threaded
Open this post in threaded view
|

The Inbox: SUnitTools-tcj.4.mcz

commits-2
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
+ !
-
-
- !


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: SUnitTools-tcj.4.mcz

Tm Jhnsn
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
> + !
> -
> -
> - !
>
>
>


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: SUnitTools-tcj.4.mcz

David T. Lewis
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
> > + !
> > -
> > -
> > - !
> >
> >
> >
>
>