[squeak-dev] The Inbox: SUnitTools-jr.5.mcz

christoph.thiede at student.hpi.uni-potsdam.de christoph.thiede at student.hpi.uni-potsdam.de
Sun Jan 16 20:30:03 UTC 2022 

Hi Jakob,

please find the attached changeset, which revises the changes, allows the user to edit the new test case definition before creating it, and uses the 'KernelTests-Objects' pattern for test category derivation which is known from most Trunk packages. No further heuristics for related class search are included. I also revised the logic for subclass templates in the Kernel package a bit. If you like it, I can merge it into the Trunk. :-)

(At a later point in time, we might want to create a hook in the ToolSet for creating a new subclass and also make use of it in Parser>>#defineClass:. But for now, I think the change is fine.)

=============== Diff ===============

BasicClassOrganizer>>categoryForTestCases {*SUnitTools-accessing} · jr 3/5/2020 22:07
+ categoryForTestCases
+ 	^ self categories
+ 		detect: [:each | each beginsWith: 'test']
+ 		ifNone: [Categorizer allCategory]

Browser>>newClassContents {accessing} · ct 1/16/2022 20:57 (changed)
newClassContents
- 	| theClassName |
- 	^ (theClassName := self selectedClassName)
- 		ifNil:
- 			[Class template: self selectedSystemCategory]
- 		ifNotNil:
- 			[Class templateForSubclassOf: theClassName asString category: self selectedSystemCategory]
+ 
+ 	^ self selectedClass
+ 		ifNil: [Class template: self selectedSystemCategory]
+ 		ifNotNil: [:theClass | theClass templateForSubclassInCategory: self selectedSystemCategory]

Class class>>template: {instance creation} · ct 1/16/2022 21:19 (changed)
- template: aSystemCategoryName 
+ template: systemCategoryName 
	"Answer an expression that can be edited and evaluated in order to define a new class."

- 	^ self templateForSubclassOf: Object name category: aSystemCategoryName 
+ 	^ Object templateForSubclassInCategory: systemCategoryName

Class class>>templateForSubclassOf:category: {instance creation} · ct 1/16/2022 20:58 (changed)
templateForSubclassOf: priorClassName category: systemCategoryName 
	"Answer an expression that can be edited and evaluated in order to define a new class, given that the class previously looked at was as given"

+ 	self deprecated: 'ct: Use Class >> #templateForSubclassInCategory:'.
	^priorClassName asString, ' subclass: #NameOfSubclass
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''' , systemCategoryName asString , ''''

Class>>templateForSubclassInCategory: {subclass creation} · ct 1/16/2022 21:19
+ templateForSubclassInCategory: categoryName
+ 	"Answer an expression that can be edited and evaluated in order to define a new class."
+ 
+ 	^ self
+ 		templateForSubclassNamed: #NameOfSubclass
+ 		category: categoryName

Class>>templateForSubclassNamed:category: {subclass creation} · ct 1/16/2022 21:19
+ templateForSubclassNamed: subclassName category: categoryName
+ 	"Answer an expression that can be edited and evaluated in order to define a new class."
+ 
+ 	^ '<1p> subclass: <2p>
+ 	instanceVariableNames: ''''
+ 	classVariableNames: ''''
+ 	poolDictionaries: ''''
+ 	category: <3p>' expandMacrosWithArguments:
+ 		{self. subclassName asSymbol. categoryName}

CodeHolder>>testBrowseClassNamed:possibleMessageNamed: {*SUnitTools-running} · ct 1/16/2022 21:15 (changed)
testBrowseClassNamed: aClassName possibleMessageNamed: aMessageName
	
	| cls selector |
- 	(self class environment hasClassNamed: aClassName) ifFalse: ["no dice" ^ self].
+ 	(self class environment hasClassNamed: aClassName)
+ 		ifFalse: [^ false].
	cls := self class environment classNamed: aClassName.

	(aMessageName notNil and: [cls includesLocalSelector: (selector := aMessageName asSymbol)])
		ifTrue: [ToolSet browse: cls selector: selector]
- 		ifFalse: [ToolSet browseClass: cls].
+ 		ifFalse: [ToolSet browseClass: cls category:
+ 			cls organization categoryForTestCases].
+ 	
+ 	^ true

CodeHolder>>testFindTest {*SUnitTools-running} · ct 1/16/2022 21:21 (changed)
testFindTest
	| cls destClassName destMessage |
	cls := self selectedClass ifNil: [^ self].
	destClassName := cls name asString, 'Test'.
	destMessage := self selectedMessageName ifNotNil: [:name | self testSelectorFrom: name].
- 	self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage
+ 	
+ 	(self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage)
+ 		ifTrue: [^ self].
+ 	(Project uiManager
+ 		chooseFromLabeledValues: (OrderedDictionary new
+ 			at: 'Create test case' translated put: [self testMakeTestCaseClassFor: destClassName];
+ 			at: 'Cancel' translated put: [];
+ 			yourself)
+ 		title: ('There is no test for {1}' translated
+ 			format: {self selectedMessageName ifNil: [cls]})) value.


CodeHolder>>testMakeTestCaseClassFor: {*SUnitTools-running} · ct 1/16/2022 21:21
+ testMakeTestCaseClassFor: className
+ 
+ 	| category template |
+ 	self selectedClassOrMetaClass ifNil: [^ self].
+ 	self okToChange ifFalse: [^ self].
+ 	
+ 	category := (self selectedClass category findTokens: $-) in: [:testedCategoryTokens |
+ 		({testedCategoryTokens first , 'Tests'} , testedCategoryTokens allButFirst)
+ 			joinSeparatedBy: $-].
+ 	template := TestCase
+ 		templateForSubclassNamed: className
+ 		category: category.
+ 	(Browser fullOnCategory: category)
+ 		editSelection: #newClass;
+ 		contentsChanged;
+ 		changed: #editString with: template.

Best,
Christoph

---
Sent from Squeak Inbox Talk

On 2022-01-10T18:24:35+01:00, jakres+squeak at gmail.com wrote:

> Since there are so many different combinations you can probably make this
> arbitrarily complex. Then 7/8 of the feature are the guessing of the
> category.  The question is whether it is worth it.
> 
> You could search all registered packages that start with the same stem for
> subclasses of TestCase. That may introduce some unwanted dependency between
> trunk packages, so you may want to stick to categories rather than packages
> instead. You may program for the known patterns, so add your *Tests-*
> pattern to the list. Which one comes next? If there is no existing test
> category with the stem, which of the conventions do you choose?
> 
> Per KISS I would stick to just one convention, which can also be the one
> you mentioned rather than the one I implemented. Changing the category of
> the class afterwards should be easy enough.
> 
> <christoph.thiede at student.hpi.uni-potsdam.de> schrieb am Mo., 10. Jan.
> 2022, 18:02:
> 
> > Hi Jakob,
> >
> > while reviewing this patch, I noticed that the category heuristic does not
> > work in all situations. For example, it classifies a newly created
> > WideSymbolTest under Collections-Tests rather than CollectionTests-Text. Do
> > you have an idea how to improve the heuristic (e.g., search for other test
> > classes in the same package, ...)? :)
> >
> > Best,
> > Christoph
> >
> > ---
> > *Sent from **Squeak Inbox Talk
> > <https://github.com/hpi-swa-lab/squeak-inbox-talk>*
> >
> > On 2020-03-07T14:08:02+00:00, christoph.thiede at student.hpi.uni-potsdam.de
> > wrote:
> >
> > > Ah, ok :-)
> > >
> > > <http://www.hpi.de/>
> > > ________________________________
> > > Von: Squeak-dev <squeak-dev-bounces at lists.squeakfoundation.org> im
> > Auftrag von Jakob Reschke <forums.jakob at resfarm.de>
> > > Gesendet: Samstag, 7. März 2020 14:57:12
> > > An: The general-purpose Squeak developers list
> > > Betreff: Re: [squeak-dev] The Inbox: SUnitTools-jr.5.mcz
> > >
> > >
> > >
> > > Thiede, Christoph <Christoph.Thiede at student.hpi.uni-potsdam.de
> > <mailto:Christoph.Thiede at student.hpi.uni-potsdam.de>> schrieb am Sa.,
> > 7. März 2020, 14:31:
> > >
> > > What is the reason to use ClassBuilder instead of
> > #subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:?
> > >
> > > The ability to specify the target environment.
> > > -------------- next part --------------
> > > An HTML attachment was scrubbed...
> > > URL: <
> > http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20200307/0bf3af36/attachment.html
> > >
> > >
> > >
> >
> -------------- next part --------------
> An HTML attachment was scrubbed...
> URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220110/790ecbf5/attachment.html>
> 
> 
["makeTestCaseClass.2.cs"]
["makeTestCaseClass-1-ask.png"]
["makeTestCaseClass-2-define.png"]
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220116/56417e72/attachment-0001.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: makeTestCaseClass.2.cs
Type: application/octet-stream
Size: 3956 bytes
Desc: not available
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220116/56417e72/attachment-0003.obj>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: makeTestCaseClass-2-define.png
Type: application/octet-stream
Size: 55497 bytes
Desc: not available
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220116/56417e72/attachment-0004.obj>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: makeTestCaseClass-1-ask.png
Type: application/octet-stream
Size: 7457 bytes
Desc: not available
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220116/56417e72/attachment-0005.obj>

More information about the Squeak-dev mailing list