Smalltalk › Squeak › Squeak - Dev

The Trunk: Tests-pre.404.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

2 messages Options

commits-2

The Trunk: Tests-pre.404.mcz

Patrick Rein uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-pre.404.mcz

==================== Summary ====================

Name: Tests-pre.404
Author: pre
Time: 7 December 2018, 1:27:40.307037 pm
UUID: d2787b99-db2d-4f7a-b4ed-4735c24b6eca
Ancestors: Tests-dtl.403

Categorizes unclassified methods in the Tests package, also recategorizes some test methods from testing to tests but not all (another door of the message categories advent calendar)

=============== Diff against Tests-dtl.403 ===============

Item was changed:
+ ----- Method: AbstractObjectsAsMethod>>flushCache (in category 'cleaning') -----
- ----- Method: AbstractObjectsAsMethod>>flushCache (in category 'as yet unclassified') -----
flushCache!

Item was changed:
+ ----- Method: AbstractObjectsAsMethod>>methodClass: (in category 'accessing') -----
- ----- Method: AbstractObjectsAsMethod>>methodClass: (in category 'as yet unclassified') -----
methodClass: aMethodClass!

Item was changed:
+ ----- Method: AbstractObjectsAsMethod>>selector: (in category 'accessing') -----
- ----- Method: AbstractObjectsAsMethod>>selector: (in category 'as yet unclassified') -----
selector: aSymbol!

Item was changed:
+ ----- Method: BitBltClipBugs>>testDrawingWayOutside (in category 'tests') -----
- ----- Method: BitBltClipBugs>>testDrawingWayOutside (in category 'as yet unclassified') -----
testDrawingWayOutside
| f1 bb f2 |
f1 := Form extent: 100@100 depth: 1.
f2 := Form extent: 100@100 depth: 1.
bb := BitBlt toForm: f1.
bb combinationRule: 3.
bb sourceForm: f2.
bb destOrigin: SmallInteger maxVal squared asPoint.
bb width: 100; height: 100.

"This should not throw an exception:"
bb copyBits.
!

Item was changed:
+ ----- Method: BitBltClipBugs>>testDrawingWayOutside2 (in category 'tests') -----
- ----- Method: BitBltClipBugs>>testDrawingWayOutside2 (in category 'as yet unclassified') -----
testDrawingWayOutside2
| f1 bb f2 |
f1 := Form extent: 100@100 depth: 1.
f2 := Form extent: 100@100 depth: 1.
bb := BitBlt toForm: f1.
bb combinationRule: 3.
bb sourceForm: f2.
bb destOrigin: 0@0.
bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.

"This should not throw an exception:"
bb copyBits.!

Item was changed:
+ ----- Method: BitBltClipBugs>>testDrawingWayOutside3 (in category 'tests') -----
- ----- Method: BitBltClipBugs>>testDrawingWayOutside3 (in category 'as yet unclassified') -----
testDrawingWayOutside3
| f1 bb f2 |
f1 := Form extent: 100@100 depth: 1.
f2 := Form extent: 100@100 depth: 1.
bb := BitBlt toForm: f1.
bb combinationRule: 3.
bb sourceForm: f2.
bb destOrigin: SmallInteger maxVal squared asPoint.
bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.

"This should not throw an exception:"
bb copyBits.
!

Item was changed:
+ ----- Method: BitBltClipBugs>>testDrawingWayOutside4 (in category 'tests') -----
- ----- Method: BitBltClipBugs>>testDrawingWayOutside4 (in category 'as yet unclassified') -----
testDrawingWayOutside4
| f1 bb f2 |
f1 := Form extent: 100@100 depth: 1.
f2 := Form extent: 100@100 depth: 1.
bb := BitBlt toForm: f1.
bb combinationRule: 3.
bb sourceForm: f2.
bb destOrigin: SmallInteger maxVal squared asPoint.
bb width: 100; height: 100.
bb sourceOrigin: SmallInteger maxVal squared asPoint.

"This should not throw an exception:"
bb copyBits.
!

Item was changed:
+ ----- Method: BitBltClipBugs>>testDrawingWayOutside5 (in category 'tests') -----
- ----- Method: BitBltClipBugs>>testDrawingWayOutside5 (in category 'as yet unclassified') -----
testDrawingWayOutside5
| f1 bb f2 |
f1 := Form extent: 100@100 depth: 1.
f2 := Form extent: 100@100 depth: 1.
bb := BitBlt toForm: f1.
bb combinationRule: 3.
bb sourceForm: f2.
bb destOrigin: 0@0.
bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.
bb sourceOrigin: SmallInteger maxVal squared asPoint.

"This should not throw an exception:"
bb copyBits.!

Item was changed:
+ ----- Method: BitBltClipBugs>>testDrawingWayOutside6 (in category 'tests') -----
- ----- Method: BitBltClipBugs>>testDrawingWayOutside6 (in category 'as yet unclassified') -----
testDrawingWayOutside6
| f1 bb f2 |
f1 := Form extent: 100@100 depth: 1.
f2 := Form extent: 100@100 depth: 1.
bb := BitBlt toForm: f1.
bb combinationRule: 3.
bb sourceForm: f2.
bb destOrigin: SmallInteger maxVal squared asPoint.
bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.
bb sourceOrigin: SmallInteger maxVal squared asPoint.

"This should not throw an exception:"
bb copyBits.
!

Item was changed:
+ ----- Method: BitBltClipBugs>>testFillingWayOutside (in category 'tests') -----
- ----- Method: BitBltClipBugs>>testFillingWayOutside (in category 'as yet unclassified') -----
testFillingWayOutside
| f1 bb |
f1 := Form extent: 100@100 depth: 1.
bb := BitBlt toForm: f1.
bb combinationRule: 3.
bb fillColor: Color black.
bb destOrigin: SmallInteger maxVal squared asPoint.
bb width: 100; height: 100.

"This should not throw an exception:"
bb copyBits.
!

Item was changed:
+ ----- Method: BitBltClipBugs>>testFillingWayOutside2 (in category 'tests') -----
- ----- Method: BitBltClipBugs>>testFillingWayOutside2 (in category 'as yet unclassified') -----
testFillingWayOutside2
| f1 bb |
f1 := Form extent: 100@100 depth: 1.
bb := BitBlt toForm: f1.
bb combinationRule: 3.
bb fillColor: Color black.
bb destOrigin: 0@0.
bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.

"This should not throw an exception:"
bb copyBits.!

Item was changed:
+ ----- Method: BitBltClipBugs>>testFillingWayOutside3 (in category 'tests') -----
- ----- Method: BitBltClipBugs>>testFillingWayOutside3 (in category 'as yet unclassified') -----
testFillingWayOutside3
| f1 bb |
f1 := Form extent: 100@100 depth: 1.
bb := BitBlt toForm: f1.
bb combinationRule: 3.
bb fillColor: Color black.
bb destOrigin: SmallInteger maxVal squared asPoint.
bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.

"This should not throw an exception:"
bb copyBits.
!

Item was changed:
+ ----- Method: BitmapStreamTests class>>testSelectors (in category 'accessing') -----
- ----- Method: BitmapStreamTests class>>testSelectors (in category 'Accessing') -----
testSelectors
"The ImageSegment-based Bitmap Test is known to not work on SPUR VMs
with the prospect of crashing. #expectedFailure does not cut it here,
don't even try to run them"
^ super testSelectors copyWithout: #testMatrixTransform2x3WithImageSegment!

Item was changed:
+ ----- Method: BitmapStreamTests>>setUp (in category 'running') -----
- ----- Method: BitmapStreamTests>>setUp (in category 'Running') -----
setUp
random := Random new.!

Item was changed:
+ ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariable (in category 'tests') -----
- ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariable (in category 'testing') -----
testAddInstanceVariable
"Adding an instance variable to the class should result in a change
record being added to the current change set."

| saveClassDefinition |
"Define a class and save its definition"
Object subclass: #JunkClass
instanceVariableNames: 'zzz'
classVariableNames: ''
poolDictionaries: ''
category: 'DeleteMe-1'.
saveClassDefinition := (Smalltalk classNamed: #JunkClass) definition.
self assert: (self
isDefinition: saveClassDefinition
equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))).

"Redefine the class, adding one instance variable"
Object subclass: #JunkClass
instanceVariableNames: 'zzz aaa'
classVariableNames: ''
poolDictionaries: ''
category: 'DeleteMe-1'.

"Assert that the class definition has changed"
self deny: (self
isDefinition: (Smalltalk classNamed: #JunkClass) definition
equivalentTo: saveClassDefinition).
self deny: (self
isDefinition: saveClassDefinition
equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))).
self assert: (self
isDefinition: (Smalltalk classNamed: #JunkClass) definition
equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))).

"Assert that the change has been recorded in the current change set"
self assert: (self
isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass))
priorDefinition
equivalentTo: saveClassDefinition).
!

Item was changed:
+ ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariableAddsNewChangeRecord (in category 'tests') -----
- ----- Method: ChangeSetClassChangesTest>>testAddInstanceVariableAddsNewChangeRecord (in category 'testing') -----
testAddInstanceVariableAddsNewChangeRecord
"Changing the class category for a class should result in a change
record being updated in the current change set."

"At the start of this test, JunkClass should not exist, and there should be
no change records pertaining to it in the change set."
self deny: (Smalltalk hasClassNamed: 'JunkClass').
self assert: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass))
thisName = 'nil'.
"Remove bogus change records created as side effect of preceding assert"
ChangeSet current removeClassChanges: 'nil'.
"Define a class and save its definition"
Object subclass: #JunkClass
instanceVariableNames: 'zzz'
classVariableNames: ''
poolDictionaries: ''
category: 'DeleteMe-1'.

"Forget about JunkClass in the change set"
ChangeSet current removeClassChanges: 'JunkClass'.

"Redefine the class, adding one instance variable"
Object subclass: #JunkClass
instanceVariableNames: 'zzz aaa'
classVariableNames: ''
poolDictionaries: ''
category: 'DeleteMe-1'.

"A change record should now exist in the change set"
self assert: (self
isDefinition: (ChangeSet current
changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition
equivalentTo:
'Object subclass: #JunkClass
instanceVariableNames: ''zzz ''
classVariableNames: ''''
poolDictionaries: ''''
category: ''DeleteMe-1''')
!

Item was changed:
+ ----- Method: ChangeSetClassChangesTest>>testChangeClassCategory (in category 'tests') -----
- ----- Method: ChangeSetClassChangesTest>>testChangeClassCategory (in category 'testing') -----
testChangeClassCategory
"Changing the class category for a class should result in a change
record being added to the current change set."

| saveClassDefinition |
"Define a class and save its definition"
Object subclass: #JunkClass
instanceVariableNames: 'zzz'
classVariableNames: ''
poolDictionaries: ''
category: 'DeleteMe-1'.
saveClassDefinition := (Smalltalk classNamed: #JunkClass) definition.
self assert: saveClassDefinition =
(ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass)).

"Redefine the class, changing only the class category"
Object subclass: #JunkClass
instanceVariableNames: 'zzz'
classVariableNames: ''
poolDictionaries: ''
category: 'DeleteMe-2'.

"Assert that the class definition has changed"
self deny: (self
isDefinition: (Smalltalk classNamed: #JunkClass) definition
equivalentTo: saveClassDefinition).
self deny: (self
isDefinition: saveClassDefinition
equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))).
self assert: (self
isDefinition: (Smalltalk classNamed: #JunkClass) definition
equivalentTo: (ChangeSet current fatDefForClass: (Smalltalk classNamed: #JunkClass))).

"Assert that the change has been recorded in the current change set"
self assert: (self
isDefinition: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass))
priorDefinition
equivalentTo:
'Object subclass: #JunkClass
instanceVariableNames: ''zzz ''
classVariableNames: ''''
poolDictionaries: ''''
category: ''DeleteMe-2''')!

Item was changed:
+ ----- Method: ChangeSetClassChangesTest>>testChangeClassCategoryAddsNewChangeRecord (in category 'tests') -----
- ----- Method: ChangeSetClassChangesTest>>testChangeClassCategoryAddsNewChangeRecord (in category 'testing') -----
testChangeClassCategoryAddsNewChangeRecord
"Changing the class category for a class should result in a change
record being updated in the current change set."

"At the start of this test, JunkClass should not exist, and there should be
no change records pertaining to it in the change set."
self deny: (Smalltalk hasClassNamed: 'JunkClass').
self assert: (ChangeSet current changeRecorderFor: (Smalltalk classNamed: #JunkClass))
thisName = 'nil'.
"Remove bogus change records created as side effect of preceding assert"
ChangeSet current removeClassChanges: 'nil'.
"Define a class and save its definition"
Object subclass: #JunkClass
instanceVariableNames: 'zzz'
classVariableNames: ''
poolDictionaries: ''
category: 'DeleteMe-1'.

"Forget about JunkClass in the change set"
ChangeSet current removeClassChanges: 'JunkClass'.

"Redefine the class, changing only the class category"
Object subclass: #JunkClass
instanceVariableNames: 'zzz'
classVariableNames: ''
poolDictionaries: ''
category: 'DeleteMe-2'.

"A change record should now exist in the change set"
self assert: (self
isDefinition: (ChangeSet current
changeRecorderFor: (Smalltalk classNamed: #JunkClass)) priorDefinition
equivalentTo:
'Object subclass: #JunkClass
instanceVariableNames: ''zzz ''
classVariableNames: ''''
poolDictionaries: ''''
category: ''DeleteMe-2''')!

Item was changed:
+ ----- Method: ChangeSetClassChangesTest>>testInitialChangeSet (in category 'tests') -----
- ----- Method: ChangeSetClassChangesTest>>testInitialChangeSet (in category 'testing') -----
testInitialChangeSet
"Run this to assure the initial changeset is named. Checks bug found in 3.9 7052."
"self new testInitialChangeSet"
"self run: #testInitialChangeSet"

self deny: (ChangeSet current printString = 'a ChangeSet named <no name -- garbage?>') .

^true!

Item was changed:
+ ----- Method: ClassBindingTest>>setUp (in category 'running') -----
- ----- Method: ClassBindingTest>>setUp (in category 'as yet unclassified') -----
setUp
key := Object new.
value := Object new.!

Item was changed:
+ ----- Method: ClassBindingTest>>testArrowBinding (in category 'tests') -----
- ----- Method: ClassBindingTest>>testArrowBinding (in category 'as yet unclassified') -----
testArrowBinding
| binding |
binding := #Griffle => self class.
self assert: binding class = ClassBinding.
self assert: binding key = #Griffle.
self assert: binding value = self class.
!

Item was changed:
+ ----- Method: ClassBindingTest>>testAsBindingAlias (in category 'tests') -----
- ----- Method: ClassBindingTest>>testAsBindingAlias (in category 'as yet unclassified') -----
testAsBindingAlias
| binding imported |
binding := ClassBinding key: #Griffle value: value.
imported := binding asBinding: #Plonk.
self assert: imported class == Alias!

Item was changed:
+ ----- Method: ClassBindingTest>>testAsBindingOriginal (in category 'tests') -----
- ----- Method: ClassBindingTest>>testAsBindingOriginal (in category 'as yet unclassified') -----
testAsBindingOriginal
| binding imported |
binding := ClassBinding key: #Griffle value: value.
imported := binding asBinding: #Griffle.
self assert: binding == imported!

Item was changed:
+ ----- Method: ClassBindingTest>>testAsBindingRead (in category 'tests') -----
- ----- Method: ClassBindingTest>>testAsBindingRead (in category 'as yet unclassified') -----
testAsBindingRead
| binding imported |
binding := ClassBinding key: #Griffle value: value.
imported := binding asBinding: #Plonk.
self assert: imported key = #Plonk.
self assert: imported value == value.!

Item was changed:
+ ----- Method: ClassBindingTest>>testAsBindingWrite (in category 'tests') -----
- ----- Method: ClassBindingTest>>testAsBindingWrite (in category 'as yet unclassified') -----
testAsBindingWrite
| binding imported |
binding := ClassBinding key: #Griffle value: value.
imported := binding asBinding: #Plonk.
self
should: [imported value: Object new]
raise: AttemptToWriteReadOnlyGlobal
!

Item was changed:
+ ----- Method: ClassBindingTest>>testCanAssign (in category 'tests') -----
- ----- Method: ClassBindingTest>>testCanAssign (in category 'as yet unclassified') -----
testCanAssign
| binding |
binding := ClassBinding key: key value: value.
self deny: binding canAssign!

Item was changed:
+ ----- Method: ClassBindingTest>>testIsSpecialRead (in category 'tests') -----
- ----- Method: ClassBindingTest>>testIsSpecialRead (in category 'as yet unclassified') -----
testIsSpecialRead
| binding |
binding := ClassBinding key: key value: value.
self deny: binding isSpecialReadBinding!

Item was changed:
+ ----- Method: ClassBindingTest>>testIsSpecialWrite (in category 'tests') -----
- ----- Method: ClassBindingTest>>testIsSpecialWrite (in category 'as yet unclassified') -----
testIsSpecialWrite
| binding |
binding := ClassBinding key: key value: value.
self assert: binding isSpecialWriteBinding!

Item was changed:
+ ----- Method: ClassBindingTest>>testLiteralEqual (in category 'tests') -----
- ----- Method: ClassBindingTest>>testLiteralEqual (in category 'as yet unclassified') -----
testLiteralEqual
| b1 b2 |
b1 := #Griffle => self class.
b2 := #Plonk => self class.
self assert: (b1 literalEqual: b2)!

Item was changed:
+ ----- Method: ClassBindingTest>>testLiteralUnequal (in category 'tests') -----
- ----- Method: ClassBindingTest>>testLiteralUnequal (in category 'as yet unclassified') -----
testLiteralUnequal
| b1 b2 |
b1 := #Griffle => self class.
b2 := #Griffle => self class superclass.
self deny: (b1 literalEqual: b2)!

Item was changed:
+ ----- Method: ClassBindingTest>>testRead (in category 'tests') -----
- ----- Method: ClassBindingTest>>testRead (in category 'as yet unclassified') -----
testRead
| binding |
binding := ClassBinding key: key value: value.
self assert: binding key == key.
self assert: binding value == value!

Item was changed:
+ ----- Method: ClassBindingTest>>testResumeExceptionToWrite (in category 'tests') -----
- ----- Method: ClassBindingTest>>testResumeExceptionToWrite (in category 'as yet unclassified') -----
testResumeExceptionToWrite
| binding |
binding := ClassBinding key: key value: Object new.
[binding value: value]
on: AttemptToWriteReadOnlyGlobal
do: [:ex | ex resume: true].
self assert: binding value == value!

Item was changed:
+ ----- Method: ClassBindingTest>>testSource (in category 'tests') -----
- ----- Method: ClassBindingTest>>testSource (in category 'as yet unclassified') -----
testSource
| binding |
binding := ClassBinding key: #Griffle value: value.
self assert: binding source == binding!

Item was changed:
+ ----- Method: ClassBindingTest>>testWriteRaisesException (in category 'tests') -----
- ----- Method: ClassBindingTest>>testWriteRaisesException (in category 'as yet unclassified') -----
testWriteRaisesException
| binding |
binding := ClassBinding key: key value: value.
self
should: [binding value: Object new]
raise: AttemptToWriteReadOnlyGlobal.!

Item was changed:
+ ----- Method: ClassRenameFixTest>>newUniqueClassName (in category 'private') -----
- ----- Method: ClassRenameFixTest>>newUniqueClassName (in category 'Private') -----
newUniqueClassName
"Return a class name that is not used in the system."

"self new newClassName"

| baseName newName |
baseName := 'AutoGeneratedClassForTestingSystemChanges'.
1 to: 9999
do:
[:number |
newName := baseName , number printString.
(Smalltalk hasClassNamed: newName) ifFalse: [^newName asSymbol]].
^self
error: 'Can no longer find a new and unique class name for the SystemChangeTest !!'!

Item was changed:
+ ----- Method: ClassRenameFixTest>>removeEverythingInSetFromSystem: (in category 'private') -----
- ----- Method: ClassRenameFixTest>>removeEverythingInSetFromSystem: (in category 'Private') -----
removeEverythingInSetFromSystem: aChangeSet

aChangeSet changedMessageList
do: [:methodRef | methodRef actualClass removeSelector: methodRef methodSymbol].
aChangeSet changedClasses
do: [:each | each isMeta
ifFalse: [each removeFromSystemUnlogged]]!

Item was changed:
+ ----- Method: ClassRenameFixTest>>renameClassUsing: (in category 'tests') -----
- ----- Method: ClassRenameFixTest>>renameClassUsing: (in category 'Tests') -----
renameClassUsing: aBlock

| createdClass foundClasses |
originalName := self newUniqueClassName.
createdClass := Object
subclass: originalName
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'ClassRenameFix-GeneradClass'.
newClassName := self newUniqueClassName.
aBlock value: createdClass value: newClassName.
self assert: (Smalltalk classNamed: originalName) isNil.
self assert: (Smalltalk classNamed: newClassName) notNil.
foundClasses := Smalltalk organization listAtCategoryNamed: 'ClassRenameFix-GeneradClass'.
self assert: (foundClasses notEmpty).
self assert: (foundClasses includes: newClassName).
self assert: (createdClass name = newClassName).!

Item was changed:
+ ----- Method: ClassRenameFixTest>>setUp (in category 'running') -----
- ----- Method: ClassRenameFixTest>>setUp (in category 'Running') -----
setUp

previousChangeSet := ChangeSet current.
testsChangeSet := ChangeSet new.
ChangeSet newChanges: testsChangeSet.
SystemChangeNotifier uniqueInstance
notify: self
ofSystemChangesOfItem: #class
change: #Renamed
using: #verifyRenameEvent:.
super setUp!

Item was changed:
+ ----- Method: ClassRenameFixTest>>tearDown (in category 'running') -----
- ----- Method: ClassRenameFixTest>>tearDown (in category 'Running') -----
tearDown

self removeEverythingInSetFromSystem: testsChangeSet.
ChangeSet newChanges: previousChangeSet.
ChangesOrganizer removeChangeSet: testsChangeSet.
previousChangeSet := nil.
testsChangeSet := nil.
SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self.
super tearDown.!

Item was changed:
+ ----- Method: ClassRenameFixTest>>testRenameClassUsingClass (in category 'tests') -----
- ----- Method: ClassRenameFixTest>>testRenameClassUsingClass (in category 'Tests') -----
testRenameClassUsingClass
"self run: #testRenameClassUsingClass"

self renameClassUsing: [:class :newName | class rename: newName].!

Item was changed:
+ ----- Method: ClassRenameFixTest>>verifyRenameEvent: (in category 'private') -----
- ----- Method: ClassRenameFixTest>>verifyRenameEvent: (in category 'Running') -----
verifyRenameEvent: aRenamedEvent

| renamedClass |
self assert: aRenamedEvent isRenamed.
renamedClass := aRenamedEvent item.
self assert: (Smalltalk classNamed: newClassName) name = newClassName.
self assert: renamedClass name = newClassName!

Item was changed:
+ ----- Method: ClipboardTest>>setUp (in category 'running') -----
- ----- Method: ClipboardTest>>setUp (in category 'as yet unclassified') -----
setUp
"Store the contents of the default clipboard. This is necessary, because all Clipboard instances modify the contents of the system clipboard."

originalClipboardText := Clipboard default clipboardText!

Item was changed:
+ ----- Method: ClipboardTest>>tearDown (in category 'running') -----
- ----- Method: ClipboardTest>>tearDown (in category 'as yet unclassified') -----
tearDown
"Restore the contents of the default clipboard. This is necessary, because all Clipboard instances modify the contents of the system clipboard."

Clipboard default clipboardText: originalClipboardText!

Item was changed:
+ ----- Method: ClipboardTest>>testClipboardText (in category 'tests') -----
- ----- Method: ClipboardTest>>testClipboardText (in category 'as yet unclassified') -----
testClipboardText

| uuidString clipboard |
uuidString := UUID new asString36.
clipboard := Clipboard new.
clipboard clipboardText: uuidString.
self assert: uuidString equals: clipboard clipboardText asString!

Item was changed:
+ ----- Method: ClipboardTest>>testClipboardTextNotifyWith (in category 'tests') -----
- ----- Method: ClipboardTest>>testClipboardTextNotifyWith (in category 'as yet unclassified') -----
testClipboardTextNotifyWith

| uuidString clipboard subscriber notifiedText notifiedSource |
uuidString := UUID new asString36.
clipboard := Clipboard new.
subscriber := [ :text :source |
notifiedText := text.
notifiedSource := source ].
clipboard
when: #contentChanged
send: #value:value:
to: subscriber.
clipboard clipboardText: uuidString.
self
assert: uuidString equals: notifiedText;
assert: nil equals: notifiedSource.
clipboard clipboardText: uuidString reversed notifyWith: self.
self
assert: uuidString reversed equals: notifiedText;
assert: self == notifiedSource.
clipboard removeActionsWithReceiver: subscriber.
clipboard clipboardText: uuidString.
self
assert: uuidString reversed equals: notifiedText;
assert: self == notifiedSource!

Item was changed:
+ ----- Method: EqualityTester>>resultFor: (in category 'running') -----
- ----- Method: EqualityTester>>resultFor: (in category 'as yet unclassified') -----
resultFor: runs
"Test that equality is the same over runs and answer the result"
1
to: runs
do: [:i | self prototype = self prototype
ifFalse: [^ false]].
^ true!

Item was changed:
+ ----- Method: EventManagerTest>>testBlockReceiverNoArgs (in category 'tests-dependent action') -----
- ----- Method: EventManagerTest>>testBlockReceiverNoArgs (in category 'running-dependent action') -----
testBlockReceiverNoArgs
eventSource when: #anEvent evaluate:[self heardEvent].
eventSource triggerEvent: #anEvent.
self should: [succeeded]!

Item was changed:
+ ----- Method: EventManagerTest>>testBlockReceiverOneArg (in category 'tests-dependent action') -----
- ----- Method: EventManagerTest>>testBlockReceiverOneArg (in category 'running-dependent action') -----
testBlockReceiverOneArg
eventSource when: #anEvent: evaluate:[:arg1| eventListener add: arg1].
eventSource triggerEvent: #anEvent: with: 9.
self should: [eventListener includes: 9]!

Item was changed:
+ ----- Method: EventManagerTest>>testBlockReceiverTwoArgs (in category 'tests-dependent action') -----
- ----- Method: EventManagerTest>>testBlockReceiverTwoArgs (in category 'running-dependent action') -----
testBlockReceiverTwoArgs
eventSource when: #anEvent:info: evaluate:[:arg1 :arg2| self addArg1: arg1 addArg2: arg2].
eventSource triggerEvent: #anEvent:info: withArguments: #( 9 42 ).
self should: [(eventListener includes: 9) and: [eventListener includes: 42]]!

Item was changed:
+ ----- Method: EventManagerTest>>testCopy (in category 'tests-copying') -----
- ----- Method: EventManagerTest>>testCopy (in category 'running-copying') -----
testCopy
"Ensure that the actionMap is zapped when
you make a copy of anEventManager"

eventSource when: #blah send: #yourself to: eventListener.
self assert: eventSource actionMap keys isEmpty not.
self assert: eventSource copy actionMap keys isEmpty!

Item was changed:
+ ----- Method: EventManagerTest>>testMultipleValueSuppliers (in category 'tests-broadcast query') -----
- ----- Method: EventManagerTest>>testMultipleValueSuppliers (in category 'running-broadcast query') -----
testMultipleValueSuppliers

eventSource
when: #needsValue
send: #getFalse
to: self.
eventSource
when: #needsValue
send: #getTrue
to: self.
succeeded := eventSource triggerEvent: #needsValue.
self should: [succeeded]!

Item was changed:
+ ----- Method: EventManagerTest>>testMultipleValueSuppliersEventHasArguments (in category 'tests-broadcast query') -----
- ----- Method: EventManagerTest>>testMultipleValueSuppliersEventHasArguments (in category 'running-broadcast query') -----
testMultipleValueSuppliersEventHasArguments

eventSource
when: #needsValue:
send: #getFalse:
to: self.
eventSource
when: #needsValue:
send: #getTrue:
to: self.
succeeded := eventSource triggerEvent: #needsValue: with: 'kolme'.
self should: [succeeded]!

Item was changed:
+ ----- Method: EventManagerTest>>testNoArgumentEvent (in category 'tests-dependent action') -----
- ----- Method: EventManagerTest>>testNoArgumentEvent (in category 'running-dependent action') -----
testNoArgumentEvent

eventSource when: #anEvent send: #heardEvent to: self.
eventSource triggerEvent: #anEvent.
self should: [succeeded]!

Item was changed:
+ ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArgument (in category 'tests-dependent action supplied arguments') -----
- ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArgument (in category 'running-dependent action supplied arguments') -----
testNoArgumentEventDependentSuppliedArgument

eventSource when: #anEvent send: #add: to: eventListener with: 'boundValue'.
eventSource triggerEvent: #anEvent.
self should: [eventListener includes: 'boundValue']!

Item was changed:
+ ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArguments (in category 'tests-dependent action supplied arguments') -----
- ----- Method: EventManagerTest>>testNoArgumentEventDependentSuppliedArguments (in category 'running-dependent action supplied arguments') -----
testNoArgumentEventDependentSuppliedArguments

eventSource
when: #anEvent
send: #addArg1:addArg2:
to: self
withArguments: #('hello' 'world').
eventSource triggerEvent: #anEvent.
self should: [(eventListener includes: 'hello') and: [eventListener includes: 'world']]!

Item was changed:
+ ----- Method: EventManagerTest>>testNoValueSupplier (in category 'tests-broadcast query') -----
- ----- Method: EventManagerTest>>testNoValueSupplier (in category 'running-broadcast query') -----
testNoValueSupplier

succeeded := eventSource
triggerEvent: #needsValue
ifNotHandled: [true].
self should: [succeeded]!

Item was changed:
+ ----- Method: EventManagerTest>>testNoValueSupplierHasArguments (in category 'tests-broadcast query') -----
- ----- Method: EventManagerTest>>testNoValueSupplierHasArguments (in category 'running-broadcast query') -----
testNoValueSupplierHasArguments

succeeded := eventSource
triggerEvent: #needsValue:
with: 'nelja'
ifNotHandled: [true].
self should: [succeeded]!

Item was changed:
+ ----- Method: EventManagerTest>>testOneArgumentEvent (in category 'tests-dependent action') -----
- ----- Method: EventManagerTest>>testOneArgumentEvent (in category 'running-dependent action') -----
testOneArgumentEvent

eventSource when: #anEvent: send: #add: to: eventListener.
eventSource triggerEvent: #anEvent: with: 9.
self should: [eventListener includes: 9]!

Item was changed:
+ ----- Method: EventManagerTest>>testRemoveActionsForEvent (in category 'tests-remove actions') -----
- ----- Method: EventManagerTest>>testRemoveActionsForEvent (in category 'running-remove actions') -----
testRemoveActionsForEvent

eventSource
when: #anEvent send: #size to: eventListener;
when: #anEvent send: #getTrue to: self;
when: #anEvent: send: #fizzbin to: self.
eventSource removeActionsForEvent: #anEvent.
self shouldnt: [eventSource hasActionForEvent: #anEvent]!

Item was changed:
+ ----- Method: EventManagerTest>>testRemoveActionsTwiceForEvent (in category 'tests-remove actions') -----
- ----- Method: EventManagerTest>>testRemoveActionsTwiceForEvent (in category 'running-remove actions') -----
testRemoveActionsTwiceForEvent

eventSource
when: #anEvent send: #size to: eventListener;
when: #anEvent send: #getTrue to: self;
when: #anEvent: send: #fizzbin to: self.
eventSource removeActionsForEvent: #anEvent.
self assert: (eventSource hasActionForEvent: #anEvent) not.
eventSource removeActionsForEvent: #anEvent.
self assert: (eventSource hasActionForEvent: #anEvent) not.!

Item was changed:
+ ----- Method: EventManagerTest>>testRemoveActionsWithReceiver (in category 'tests-remove actions') -----
- ----- Method: EventManagerTest>>testRemoveActionsWithReceiver (in category 'running-remove actions') -----
testRemoveActionsWithReceiver

| action |
eventSource
when: #anEvent send: #size to: eventListener;
when: #anEvent send: #getTrue to: self;
when: #anEvent: send: #fizzbin to: self.
eventSource removeActionsWithReceiver: self.
action := eventSource actionForEvent: #anEvent.
self assert: (action respondsTo: #receiver).
self assert: ((action receiver == self) not)!

Item was changed:
+ ----- Method: EventManagerTest>>testReturnValueWithManyListeners (in category 'tests-dependent value') -----
- ----- Method: EventManagerTest>>testReturnValueWithManyListeners (in category 'running-dependent value') -----
testReturnValueWithManyListeners

| value newListener |
newListener := 'busybody'.
eventSource
when: #needsValue
send: #yourself
to: eventListener.
eventSource
when: #needsValue
send: #yourself
to: newListener.
value := eventSource triggerEvent: #needsValue.
self should: [value == newListener]!

Item was changed:
+ ----- Method: EventManagerTest>>testReturnValueWithNoListeners (in category 'tests-dependent value') -----
- ----- Method: EventManagerTest>>testReturnValueWithNoListeners (in category 'running-dependent value') -----
testReturnValueWithNoListeners

| value |
value := eventSource triggerEvent: #needsValue.
self should: [value == nil]!

Item was changed:
+ ----- Method: EventManagerTest>>testReturnValueWithOneListener (in category 'tests-dependent value') -----
- ----- Method: EventManagerTest>>testReturnValueWithOneListener (in category 'running-dependent value') -----
testReturnValueWithOneListener

| value |
eventSource
when: #needsValue
send: #yourself
to: eventListener.
value := eventSource triggerEvent: #needsValue.
self should: [value == eventListener]!

Item was changed:
+ ----- Method: EventManagerTest>>testSingleValueSupplier (in category 'tests-broadcast query') -----
- ----- Method: EventManagerTest>>testSingleValueSupplier (in category 'running-broadcast query') -----
testSingleValueSupplier

eventSource
when: #needsValue
send: #getTrue
to: self.
succeeded := eventSource triggerEvent: #needsValue.
self should: [succeeded]!

Item was changed:
+ ----- Method: EventManagerTest>>testTwoArgumentEvent (in category 'tests-dependent action') -----
- ----- Method: EventManagerTest>>testTwoArgumentEvent (in category 'running-dependent action') -----
testTwoArgumentEvent

eventSource when: #anEvent:info: send: #addArg1:addArg2: to: self.
eventSource triggerEvent: #anEvent:info: withArguments: #( 9 42 ).
self should: [(eventListener includes: 9) and: [eventListener includes: 42]]!

Item was changed:
+ ----- Method: FakeObjectOut>>doesNotUnderstand: (in category 'error handling') -----
- ----- Method: FakeObjectOut>>doesNotUnderstand: (in category 'as yet unclassified') -----
doesNotUnderstand: aMessage
^ aMessage sendTo: self class !

Item was changed:
+ ----- Method: FakeObjectOut>>isInMemory (in category 'testing') -----
- ----- Method: FakeObjectOut>>isInMemory (in category 'as yet unclassified') -----
isInMemory
^ false.!

Item was changed:
+ ----- Method: HandBugs>>testTargetPoint (in category 'tests') -----
- ----- Method: HandBugs>>testTargetPoint (in category 'as yet unclassified') -----
testTargetPoint
"self new testTargetPoint"
"self run: #testTargetPoint"

"This should not throw an exception."
ActiveHand targetPoint

!

Item was changed:
+ ----- Method: HashAndEqualsTestCase>>setUp (in category 'running') -----
- ----- Method: HashAndEqualsTestCase>>setUp (in category 'as yet unclassified') -----
setUp
"subclasses will add their prototypes into this collection"
prototypes := OrderedCollection new !

Item was changed:
+ ----- Method: HashAndEqualsTestCase>>testEquality (in category 'tests') -----
- ----- Method: HashAndEqualsTestCase>>testEquality (in category 'as yet unclassified') -----
testEquality
"Check that TextFontChanges report equality correctly"
prototypes
do: [:p | self
should: [(EqualityTester with: p) result]] !

Item was changed:
+ ----- Method: HashAndEqualsTestCase>>testHash (in category 'tests') -----
- ----- Method: HashAndEqualsTestCase>>testHash (in category 'as yet unclassified') -----
testHash
"test that TextFontChanges hash correctly"
prototypes
do: [:p | self
should: [(HashTester with: p) result]] !

Item was changed:
+ ----- Method: HashTester>>resultFor: (in category 'running') -----
- ----- Method: HashTester>>resultFor: (in category 'as yet unclassified') -----
resultFor: runs
"Test that the hash is the same over runs and answer the result"
| hash |
hash := self prototype hash.
1
to: runs
do: [:i | hash = self prototype hash
ifFalse: [^ false]].
^ true !

Item was changed:
+ ----- Method: HashTesterTest>>testBasicBehaviour (in category 'tests') -----
- ----- Method: HashTesterTest>>testBasicBehaviour (in category 'as yet unclassified') -----
testBasicBehaviour
self
should: [(HashTester with: 1)
resultFor: 100].
self
should: [(HashTester with: 'fred')
resultFor: 100].
self
shouldnt: [(HashTester with: BadHasher new)
resultFor: 100] !

Item was changed:
+ ----- Method: HexTest>>testCharacterHex (in category 'tests') -----
- ----- Method: HexTest>>testCharacterHex (in category 'as yet unclassified') -----
testCharacterHex
| result |
result := $a hex.
self assert: result = '61'.
result := $A hex.
self assert: result = '41'.

!

Item was changed:
+ ----- Method: HexTest>>testColorPrintHtmlString (in category 'tests') -----
- ----- Method: HexTest>>testColorPrintHtmlString (in category 'as yet unclassified') -----
testColorPrintHtmlString
self assert: (Color red printHtmlString ) = ( Color red asHTMLColor allButFirst asUppercase).

!

Item was changed:
+ ----- Method: HexTest>>testIntegerHex (in category 'tests') -----
- ----- Method: HexTest>>testIntegerHex (in category 'as yet unclassified') -----
testIntegerHex
| result |
result := 15 asInteger hex.
self assert: result = '16rF'.
result := 0 asInteger hex.
self assert: result = '16r0'.
result := 255 asInteger hex.
self assert: result = '16rFF'.
result := 90 asInteger hex.
self assert: result = '16r5A'!

Item was changed:
+ ----- Method: HexTest>>testStringAsHex (in category 'tests') -----
- ----- Method: HexTest>>testStringAsHex (in category 'as yet unclassified') -----
testStringAsHex
| result |
result := 'abc' asHex.
self assert: result = '616263'.

!

Item was changed:
+ ----- Method: ImageSegmentTest>>testContextsShouldBeWritableToaFile (in category 'tests') -----
- ----- Method: ImageSegmentTest>>testContextsShouldBeWritableToaFile (in category 'testing') -----
testContextsShouldBeWritableToaFile
"This should not throw an exception"
NativeImageSegment new
copyFromRoots: {thisContext. thisContext copyStack} sizeHint: 100;
extract;
writeToFile: 'ContextChain';
yourself

"TODO: write assertions showing that something meaningful actually happened."

"TODO: bring them back in again"!

Item was changed:
+ ----- Method: ImageSegmentTest>>testImageSegmentsShouldBeWritableToaFile (in category 'tests') -----
- ----- Method: ImageSegmentTest>>testImageSegmentsShouldBeWritableToaFile (in category 'testing') -----
testImageSegmentsShouldBeWritableToaFile
"This should not throw an exception"
| classes |
classes := UIManager subclasses reject: [:sc| sc isActiveManager].
NativeImageSegment new
copyFromRoots: classes asArray sizeHint: 100;
extract;
writeToFile: 'InactiveUIManagers';
yourself.

"TODO: write assertions showing that something meaningful actually happened."

"now bring them back in again"
classes do: [:ea| ea new]!

Item was changed:
+ ----- Method: InstallerUrlTest>>testAddPackageShouldResultInCorrectUrl (in category 'tests') -----
- ----- Method: InstallerUrlTest>>testAddPackageShouldResultInCorrectUrl (in category 'as yet unclassified') -----
testAddPackageShouldResultInCorrectUrl
| url |
url := (Installer url: 'http://seaside.gemstone.com/ss/metacello')
addPackage: 'ConfigurationOfMetacello-dkh.754.mcz';
urlToDownload.
"Note the insertion of a / in the URL."
self
assert: 'http://seaside.gemstone.com/ss/metacello/ConfigurationOfMetacello-dkh.754.mcz'
equals: url.!

Item was changed:
+ ----- Method: LangEnvBugs>>defaultTimeout (in category 'accessing') -----
- ----- Method: LangEnvBugs>>defaultTimeout (in category 'as yet unclassified') -----
defaultTimeout

^ super defaultTimeout * 10 "seconds"!

Item was changed:
+ ----- Method: LangEnvBugs>>tearDown (in category 'running') -----
- ----- Method: LangEnvBugs>>tearDown (in category 'as yet unclassified') -----
tearDown

[Preferences restoreDefaultFonts] valueSupplyingAnswers: #(('Sorry, could not revert font choices' #default))!

Item was changed:
+ ----- Method: LangEnvBugs>>testIsFontAvailable (in category 'tests') -----
- ----- Method: LangEnvBugs>>testIsFontAvailable (in category 'as yet unclassified') -----
testIsFontAvailable
"self new testIsFontAvailable"
"self run: #testIsFontAvailable"
| oldPref |
oldPref := Preferences valueOfPreference: #tinyDisplay.
Preferences restoreFontsAfter: [
[Preferences enable: #tinyDisplay.
"This should not throw an exception."
(LanguageEnvironment localeID: (LocaleID isoLanguage: 'en')) isFontAvailable]
ensure: [Preferences setPreference: #tinyDisplay toValue: oldPref]].!

Item was changed:
+ ----- Method: LocaleTest>>setUp (in category 'running') -----
- ----- Method: LocaleTest>>setUp (in category 'testing') -----
setUp

previousID := Locale current localeID.
previousKeyboardInterpreter := ActiveHand instVarNamed: 'keyboardInterpreter'.
previousClipboardInterpreter := Clipboard default instVarNamed: 'interpreter'.
ActiveHand clearKeyboardInterpreter.
Clipboard default clearInterpreter.
!

Item was changed:
+ ----- Method: LocaleTest>>tearDown (in category 'running') -----
- ----- Method: LocaleTest>>tearDown (in category 'testing') -----
tearDown

ActiveHand instVarNamed: 'keyboardInterpreter' put: previousKeyboardInterpreter.
Clipboard default instVarNamed: 'interpreter' put: previousClipboardInterpreter.
Locale switchToID: (LocaleID isoLanguage: previousID).!

Item was changed:
+ ----- Method: LocaleTest>>testEncodingName (in category 'tests') -----
- ----- Method: LocaleTest>>testEncodingName (in category 'testing') -----
testEncodingName
"self debug: #testEncodingName"
| locale |
locale := Locale isoLanguage: 'ja'.
self assert: locale languageEnvironment fontEncodingName = #FontJapaneseEnvironment!

Item was changed:
+ ----- Method: LocaleTest>>testIsFontAvailable (in category 'tests') -----
- ----- Method: LocaleTest>>testIsFontAvailable (in category 'testing') -----
testIsFontAvailable
"self debug: #testIsFontAvailable"

<timeout: 60> "takes quite a while"
self ensureInternetConnectionTo: 'http://metatoys.org/pub/'.

Preferences restoreFontsAfter: [
| currentDefaultTextStyle |
currentDefaultTextStyle := TextStyle default.
[
TextStyle setDefault: (TextStyle actualTextStyles at: #Accuny).
(Locale isoLanguage: 'ja') languageEnvironment removeFonts.
self assert: (Locale isoLanguage: 'en') languageEnvironment isFontAvailable.
"Next test should fail after installing Japanese font"
self assert: (Locale isoLanguage: 'ja') languageEnvironment isFontAvailable not.
(Locale isoLanguage: 'ja') languageEnvironment installFont.
self assert: (Locale isoLanguage: 'ja') languageEnvironment isFontAvailable ]
ensure: [ TextStyle setDefault: currentDefaultTextStyle.
FileDirectory default deleteFileNamed: (Locale isoLanguage: 'ja') languageEnvironment fontFullName. ] ].!

Item was changed:
+ ----- Method: LocaleTest>>testLocaleChanged (in category 'tests') -----
- ----- Method: LocaleTest>>testLocaleChanged (in category 'testing') -----
testLocaleChanged
"self debug: #testLocaleChanged"
"LanguageEnvironment >> startUp is called from Prject >> localeChanged"
<timeout: 60> "takes quite a while"
Project current updateLocaleDependents.
self assert: (ActiveHand instVarNamed: 'keyboardInterpreter') isNil description: 'non-nil keyboardInterpreter'.
self assert: (Clipboard default instVarNamed: 'interpreter') isNil description: 'non-nil interpreter'.
Locale switchToID: (LocaleID isoLanguage: 'ja').
self assert: 'ja' equals: Locale current localeID isoLanguage.
Locale switchToID: (LocaleID isoLanguage: 'en').
self assert: 'en' equals: Locale current localeID isoLanguage.!

Item was changed:
+ ----- Method: MCDirtyPackageInfo>>classes (in category 'listing') -----
- ----- Method: MCDirtyPackageInfo>>classes (in category 'as yet unclassified') -----
classes
^ Array new: 0.!

Item was changed:
+ ----- Method: MCDirtyPackageInfo>>methods (in category 'listing') -----
- ----- Method: MCDirtyPackageInfo>>methods (in category 'as yet unclassified') -----
methods
^ MCMockClassA selectors
select: [:ea | ea beginsWith: 'ordinal']
thenCollect:
[:ea |
MethodReference
class: MCMockClassA
selector: ea].!

Item was changed:
+ ----- Method: MCDirtyPackageInfo>>packageName (in category 'naming') -----
- ----- Method: MCDirtyPackageInfo>>packageName (in category 'as yet unclassified') -----
packageName
^ 'MCDirtyPackage'!

Item was changed:
+ ----- Method: MCEmptyPackageInfo>>classes (in category 'listing') -----
- ----- Method: MCEmptyPackageInfo>>classes (in category 'as yet unclassified') -----
classes
^ #()!

Item was changed:
+ ----- Method: MCEmptyPackageInfo>>methods (in category 'listing') -----
- ----- Method: MCEmptyPackageInfo>>methods (in category 'as yet unclassified') -----
methods
^ #()!

Item was changed:
+ ----- Method: MCEmptyPackageInfo>>packageName (in category 'naming') -----
- ----- Method: MCEmptyPackageInfo>>packageName (in category 'as yet unclassified') -----
packageName
^ 'MCEmptyPackage'!

Item was changed:
+ ----- Method: MCMockClassA>>d (in category 'numeric') -----
- ----- Method: MCMockClassA>>d (in category 'as yet classified') -----
d
^ 'd'!

Item was changed:
+ ----- Method: MCMockDefinition>>= (in category 'comparing') -----
- ----- Method: MCMockDefinition>>= (in category 'as yet unclassified') -----
= definition
^definition token = token!

Item was changed:
+ ----- Method: MCMockDefinition>>asString (in category 'converting') -----
- ----- Method: MCMockDefinition>>asString (in category 'as yet unclassified') -----
asString

^ token!

Item was changed:
+ ----- Method: MCMockDefinition>>description (in category 'comparing') -----
- ----- Method: MCMockDefinition>>description (in category 'as yet unclassified') -----
description

^ token first!

Item was changed:
+ ----- Method: MCMockDefinition>>hash (in category 'comparing') -----
- ----- Method: MCMockDefinition>>hash (in category 'as yet unclassified') -----
hash

^ token hash!

Item was changed:
+ ----- Method: MCMockDefinition>>printString (in category 'printing') -----
- ----- Method: MCMockDefinition>>printString (in category 'as yet unclassified') -----
printString

^ token!

Item was changed:
+ ----- Method: MCMockDefinition>>summary (in category 'printing') -----
- ----- Method: MCMockDefinition>>summary (in category 'as yet unclassified') -----
summary

^ token!

Item was changed:
+ ----- Method: MCMockDefinition>>token (in category 'accessing') -----
- ----- Method: MCMockDefinition>>token (in category 'as yet unclassified') -----
token

^ token!

Item was changed:
+ ----- Method: MCMockDefinition>>token: (in category 'accessing') -----
- ----- Method: MCMockDefinition>>token: (in category 'as yet unclassified') -----
token: aString

token := aString!

Item was changed:
+ ----- Method: MCMockPackageInfo>>classNames (in category 'constants') -----
- ----- Method: MCMockPackageInfo>>classNames (in category 'as yet unclassified') -----
classNames
^ #( MCMockClassA
MCMockASubclass
MCMockClassB
MCMockClassD
MCMockClassE
MCMockClassF
MCMockClassG
MCMockClassH
MCMockClassI
)!

Item was changed:
+ ----- Method: MCMockPackageInfo>>classes (in category 'listing') -----
- ----- Method: MCMockPackageInfo>>classes (in category 'as yet unclassified') -----
classes
^ self classNames
select: [:name | Smalltalk hasClassNamed: name]
thenCollect: [:name | Smalltalk at: name]!

Item was changed:
+ ----- Method: MCMockPackageInfo>>extensionMethods (in category 'listing') -----
- ----- Method: MCMockPackageInfo>>extensionMethods (in category 'as yet unclassified') -----
extensionMethods
^ Array with: (MethodReference
class: MCSnapshotTest
selector: #mockClassExtension)!

Item was changed:
+ ----- Method: MCMockPackageInfo>>includesClass: (in category 'testing') -----
- ----- Method: MCMockPackageInfo>>includesClass: (in category 'as yet unclassified') -----
includesClass: aClass
^self classes includes: aClass!

Item was changed:
+ ----- Method: MCMockPackageInfo>>includesSystemCategory: (in category 'testing') -----
- ----- Method: MCMockPackageInfo>>includesSystemCategory: (in category 'as yet unclassified') -----
includesSystemCategory: categoryName
^self systemCategories anySatisfy: [:cat | cat sameAs: categoryName]!

Item was changed:
+ ----- Method: MCMockPackageInfo>>packageName (in category 'naming') -----
- ----- Method: MCMockPackageInfo>>packageName (in category 'as yet unclassified') -----
packageName
^ 'MonticelloMocks'!

Item was changed:
+ ----- Method: MCMockPackageInfo>>systemCategories (in category 'listing') -----
- ----- Method: MCMockPackageInfo>>systemCategories (in category 'as yet unclassified') -----
systemCategories
^ Array with: 'Tests-MonticelloMocks'!

Item was changed:
+ ----- Method: MCTestCase>>performTest (in category 'private') -----
- ----- Method: MCTestCase>>performTest (in category 'as yet unclassified') -----
performTest

Utilities
useAuthorInitials: self className
during: [ super performTest ]!

Item was changed:
+ ----- Method: MethodReferenceTest>>testEquals (in category 'tests') -----
- ----- Method: MethodReferenceTest>>testEquals (in category 'Running') -----
testEquals
| aMethodReference anotherMethodReference |
aMethodReference := MethodReference new.
anotherMethodReference := MethodReference new.
"Two fresh instances should be equals between them"
self assert: MethodReference new equals: MethodReference new.
self assert: MethodReference new hash equals: MethodReference new hash.

"Two instances representing the same method (same class and
same selector) should be equals"
self assert: (MethodReference class: String selector: #foo) equals: (MethodReference class: String selector: #foo).
self assert: (MethodReference class: String selector: #foo) hash equals: (MethodReference class: String selector: #foo) hash.!

Item was changed:
+ ----- Method: MethodReferenceTest>>testNotEquals (in category 'tests') -----
- ----- Method: MethodReferenceTest>>testNotEquals (in category 'Running') -----
testNotEquals
self
deny: (MethodReference class: String selector: #foo) = (MethodReference class: String class selector: #foo)
description: 'Different classes, same selector -> no more equals'.
self
deny: (MethodReference class: String selector: #foo) = (MethodReference class: String selector: #bar)
description: 'Same class, different selectors -> no more equals'.!

Item was changed:
+ ----- Method: NamePolicyTest class>>isAbstract (in category 'testing') -----
- ----- Method: NamePolicyTest class>>isAbstract (in category 'as yet unclassified') -----
isAbstract
^ self name = #NamePolicyTest!

Item was changed:
+ ----- Method: ObjectsAsMethodsExample>>add:with: (in category 'example methods') -----
- ----- Method: ObjectsAsMethodsExample>>add:with: (in category 'as yet unclassified') -----
add: a with: b
^a + b!

Item was changed:
+ ----- Method: ObjectsAsMethodsExample>>answer42 (in category 'example methods') -----
- ----- Method: ObjectsAsMethodsExample>>answer42 (in category 'as yet unclassified') -----
answer42
^42!

Item was changed:
+ ----- Method: ObjectsAsMethodsExample>>run:with:in: (in category 'example methods') -----
- ----- Method: ObjectsAsMethodsExample>>run:with:in: (in category 'as yet unclassified') -----
run: oldSelector with: arguments in: aReceiver
^self perform: oldSelector withArguments: arguments!

Item was changed:
+ ----- Method: PCCByCompilationTest class>>isAbstract (in category 'testing') -----
- ----- Method: PCCByCompilationTest class>>isAbstract (in category 'Testing') -----
isAbstract
^ false!

Item was changed:
+ ----- Method: PCCByLiteralsTest class>>isAbstract (in category 'testing') -----
- ----- Method: PCCByLiteralsTest class>>isAbstract (in category 'Testing') -----
isAbstract
^ false!

Item was changed:
+ ----- Method: PrimCallControllerAbstractTest class>>isAbstract (in category 'testing') -----
- ----- Method: PrimCallControllerAbstractTest class>>isAbstract (in category 'Testing') -----
isAbstract
^ true!

Item was changed:
+ ----- Method: PrimCallControllerAbstractTest>>setUp (in category 'running') -----
- ----- Method: PrimCallControllerAbstractTest>>setUp (in category 'tests') -----
setUp
super setUp.
pcc := self classToBeTested new.
"set failed call"
(self class >> self failedCallSelector) literals first at: 4 put: -1.
"set it to false for some very slow tests..."
doNotMakeSlowTestsFlag := true!

Item was changed:
+ ----- Method: PrototypeTester>>prototype (in category 'accessing') -----
- ----- Method: PrototypeTester>>prototype (in category 'as yet unclassified') -----
prototype
"Get a prototype"
^ prototype copy !

Item was changed:
+ ----- Method: PrototypeTester>>prototype: (in category 'accessing') -----
- ----- Method: PrototypeTester>>prototype: (in category 'as yet unclassified') -----
prototype: aPrototype
"Set my prototype"
prototype := aPrototype copy !

Item was changed:
+ ----- Method: PrototypeTester>>result (in category 'running') -----
- ----- Method: PrototypeTester>>result (in category 'as yet unclassified') -----
result
"Perform the test the default number of times"
^ self resultFor: self class defaultRuns !

Item was changed:
+ ----- Method: RecentMessagesTest>>testIsEmpty (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testIsEmpty (in category 'testing') -----
testIsEmpty
self assert: rm isEmpty description: 'Initially, must be empty'.
rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals.
self deny: rm isEmpty description: 'After submission, must not be empty'.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCanReduceNumberOfReferences (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCanReduceNumberOfReferences (in category 'testing') -----
testMaximumSubmissionCountCanReduceNumberOfReferences
rm maximumSubmissionCount: 2.
rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals.
rm recordSelector: #bar forClass: Utilities inEnvironment: Smalltalk globals.
rm maximumSubmissionCount: 1.
self assert: 1 equals: rm size.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCapsReferenceCount (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testMaximumSubmissionCountCapsReferenceCount (in category 'testing') -----
testMaximumSubmissionCountCapsReferenceCount
rm maximumSubmissionCount: 2.
rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals.
rm recordSelector: #bar forClass: Utilities inEnvironment: Smalltalk globals.
rm recordSelector: #baz forClass: Utilities inEnvironment: Smalltalk globals.
self assert: #bar equals: rm leastRecent selector.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testMaximumSubmissionCountDefaultsToTen (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testMaximumSubmissionCountDefaultsToTen (in category 'testing') -----
testMaximumSubmissionCountDefaultsToTen
self assert: 30 equals: rm maximumSubmissionCount.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testMaximumSubmissionCountReturnsMaximumNumberOfRecordedMethodSubmissions (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testMaximumSubmissionCountReturnsMaximumNumberOfRecordedMethodSubmissions (in category 'testing') -----
testMaximumSubmissionCountReturnsMaximumNumberOfRecordedMethodSubmissions
rm maximumSubmissionCount: 0.
self assert: 0 equals: rm maximumSubmissionCount.
rm maximumSubmissionCount: 1.
self assert: 1 equals: rm maximumSubmissionCount.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testMethodReferencesReturnsAllSubmissions (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testMethodReferencesReturnsAllSubmissions (in category 'testing') -----
testMethodReferencesReturnsAllSubmissions
| expected |
expected := {
MethodReference class: Utilities selector: #bar environment: env.
MethodReference class: Utilities selector: #foo environment: env }.
rm recordSelector: #foo forClass: Utilities inEnvironment: env.
rm recordSelector: #bar forClass: Utilities inEnvironment: env.
self assert: expected equals: rm methodReferences!

Item was changed:
+ ----- Method: RecentMessagesTest>>testMethodReferencesReturnsaCopy (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testMethodReferencesReturnsaCopy (in category 'testing') -----
testMethodReferencesReturnsaCopy
| expected original |
rm recordSelector: #foo forClass: Utilities inEnvironment: env.
original := rm methodReferences.
expected := original copy.
rm recordSelector: #bar forClass: Utilities inEnvironment: env.
self assert: expected equals: original.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testMostRecentReturnsLastAddedReference (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testMostRecentReturnsLastAddedReference (in category 'testing') -----
testMostRecentReturnsLastAddedReference
| victim |
victim := self createClass: #Victim.
victim compile: 'foo ^ 1'.
victim compile: 'bar ^ 1'.
rm recordSelector: #foo forClass: victim inEnvironment: env.
self assert: #foo equals: rm mostRecent selector.
rm recordSelector: #bar forClass: victim inEnvironment: env.
self assert: #bar equals: rm mostRecent selector.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testMostRecentReturnsRemovedReference (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testMostRecentReturnsRemovedReference (in category 'testing') -----
testMostRecentReturnsRemovedReference
| victim |
victim := self createClass: #Victim.
victim compile: 'foo ^ 1'.
victim compile: 'bar ^ 1'.
rm recordSelector: #foo forClass: victim inEnvironment: env.
rm recordSelector: #bar forClass: victim inEnvironment: env.
victim removeSelector: #bar.
self assert: #bar equals: rm mostRecent selector.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testOldestReturnsOldestSubmission (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testOldestReturnsOldestSubmission (in category 'testing') -----
testOldestReturnsOldestSubmission
self assert: nil equals: rm leastRecent description: 'Return nil if no submissions yet'.
rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals.
self assert: #foo equals: rm leastRecent selector.
rm recordSelector: #baz forClass: Utilities inEnvironment: Smalltalk globals.
self assert: #foo equals: rm leastRecent selector.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testPurgeMissingMethodsKeepsComments (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testPurgeMissingMethodsKeepsComments (in category 'testing') -----
testPurgeMissingMethodsKeepsComments
rm recordSelector: #Comment forClass: Utilities inEnvironment: Smalltalk globals.
self deny: rm isEmpty.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testReferencesAreUnique (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testReferencesAreUnique (in category 'testing') -----
testReferencesAreUnique
rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals.
rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals.
self assert: 1 equals: rm size description: 'After duplicate'.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesLatestVersion (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesLatestVersion (in category 'testing') -----
testRevertMostRecentRemovesLatestVersion
| victim |
victim := self createClass: #Victim.
victim compile: 'foo ^ 1'.
victim compile: 'foo ^ 2'.
rm recordSelector: #foo forClass: victim inEnvironment: env.
rm revertMostRecent.
self assert: 1 equals: victim new foo description: 'Version not removed'.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesNewMethod (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testRevertMostRecentRemovesNewMethod (in category 'testing') -----
testRevertMostRecentRemovesNewMethod
| victim |
victim := self createClass: #Victim.
victim compile: 'foo ^ 1'.
rm recordSelector: #foo forClass: victim inEnvironment: env.
rm revertMostRecent.
self deny: (victim includesSelector: #foo) description: 'Method not removed'.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testSizeReturnsNumberOfRecordedMethodSubmissions (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testSizeReturnsNumberOfRecordedMethodSubmissions (in category 'testing') -----
testSizeReturnsNumberOfRecordedMethodSubmissions
self assert: 0 equals: rm size description: 'Initial state'.
rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals.
self assert: 1 equals: rm size description: 'After 1 submission'.
rm recordSelector: #bar forClass: Utilities inEnvironment: Smalltalk globals.
self assert: 2 equals: rm size description: 'After 2 submissions'.!

Item was changed:
+ ----- Method: RecentMessagesTest>>testSubmissionClassControlsLogging (in category 'tests') -----
- ----- Method: RecentMessagesTest>>testSubmissionClassControlsLogging (in category 'testing') -----
testSubmissionClassControlsLogging
WantsChangeSetLogging yes.
rm recordSelector: #foo forClass: WantsChangeSetLogging inEnvironment: Smalltalk globals.
WantsChangeSetLogging no.
rm recordSelector: #bar forClass: WantsChangeSetLogging inEnvironment: Smalltalk globals.
self assert: 1 equals: rm size description: 'Class asked for logging not to happen'.!

Item was changed:
+ ----- Method: ReleaseTest>>testClassesSystemCategory (in category 'tests') -----
- ----- Method: ReleaseTest>>testClassesSystemCategory (in category 'testing') -----
testClassesSystemCategory
"Find cases where classes have nil system categories.
This test will tell you the classes.
This is inspired by the proposed fix of a bug in release of 3.10.1
see Mantis #7070"
| rejectClasses |

rejectClasses :=
nil systemNavigation allClasses reject: [ :each |
each category notNil ] .

self assert: rejectClasses isEmpty description: ('Classes with nil system categories: {1}' format: {rejectClasses asCommaString}).!

Item was changed:
+ ----- Method: ReleaseTest>>testMethodsWithUnboundGlobals (in category 'tests') -----
- ----- Method: ReleaseTest>>testMethodsWithUnboundGlobals (in category 'testing') -----
testMethodsWithUnboundGlobals
| unbound |
unbound := SystemNavigation default methodsWithUnboundGlobals.
Smalltalk cleanOutUndeclared.
self assert: unbound isEmpty description: 'Unbound: ', unbound asCommaString!

Item was changed:
+ ----- Method: ReleaseTest>>testNoObsoleteClasses (in category 'tests') -----
- ----- Method: ReleaseTest>>testNoObsoleteClasses (in category 'testing') -----
testNoObsoleteClasses

| obsoleteClasses |
obsoleteClasses := self systemNavigation obsoleteClasses.
self
assert: obsoleteClasses isEmpty
description: ('{1} {2} obsolete' format: {
obsoleteClasses asCommaStringAnd.
obsoleteClasses size = 1
ifTrue: [ 'is' ]
ifFalse: [ 'are' ] })

!

Item was changed:
+ ----- Method: ReleaseTest>>testSqueakThemeFonts (in category 'tests') -----
- ----- Method: ReleaseTest>>testSqueakThemeFonts (in category 'testing') -----
testSqueakThemeFonts
"Check whether the fonts installed in the active theme in the release are correct"

"preference selector - font family name - font size"
{ #(standardDefaultTextFont 'Bitmap DejaVu Sans' 9).
#(standardListFont 'Bitmap DejaVu Sans' 9).
#(standardFlapFont 'Bitmap DejaVu Sans' 7).
#(standardMenuFont 'Bitmap DejaVu Sans' 9).
#(windowTitleFont 'Bitmap DejaVu Sans' 9).
#(standardBalloonHelpFont 'Bitmap DejaVu Sans' 7).
#(standardCodeFont 'Bitmap DejaVu Sans' 9).
#(standardButtonFont 'Bitmap DejaVu Sans' 7) }
do: [:triple | | font |
font := Preferences perform: triple first.
self assert: triple second equals: font familyName.
self assert: triple third equals: font pointSize ]

!

Item was changed:
+ ----- Method: ReleaseTest>>testSuperSubclassReferences (in category 'tests') -----
- ----- Method: ReleaseTest>>testSuperSubclassReferences (in category 'testing') -----
testSuperSubclassReferences
"see mantis bug 7090 for more info on this"
"If the reason for this test to fail is above bug, the following might fix the system"
"(ProtoObject subclasses reject: [:each | each isMeta or: [each environment includes: each]]) do: [:each | ProtoObject removeSubclass: each]"

| strangeClasses |
strangeClasses := ProtoObject allSubclasses reject: [:each | each isMeta or: [each environment includes: each]].
self assert: strangeClasses isEmpty description: ('Not expecting to find any of {1}' format: {strangeClasses asCommaString}).!

Item was changed:
+ ----- Method: ReleaseTest>>testSwapMouseButtonsPreference (in category 'tests') -----
- ----- Method: ReleaseTest>>testSwapMouseButtonsPreference (in category 'testing') -----
testSwapMouseButtonsPreference
"Swap mouse buttons should be enabled"
self assert: Preferences swapMouseButtons!

Item was changed:
+ ----- Method: ReleaseTest>>testSystemCategoryClasses (in category 'tests') -----
- ----- Method: ReleaseTest>>testSystemCategoryClasses (in category 'testing') -----
testSystemCategoryClasses
"Find cases where system categories name absent classes.
This test will tell you the classes.
This is inspired by a bug in release of 3.10.1
see Mantis #7070"
| rejectCats rejectClasses |
rejectCats :=
SystemOrganization categories reject: [ :catName |
(SystemOrganization listAtCategoryNamed: catName)
allSatisfy: [ :className |
( Smalltalk includesKey: className ) ] ] .
"self assert: rejectCats isEmpty ."

rejectCats isEmpty ifTrue: [ ^ true ] .

rejectClasses :=
rejectCats collect: [ :each |
each ->
( (SystemOrganization listAtCategoryNamed: each)
reject: [ :eachOne |
( Smalltalk includesKey: eachOne ) ] ) ] .

self assert: rejectCats isEmpty description: ('Not expecting any of {1}' format: { rejectClasses asCommaString}).
!

Item was changed:
+ ----- Method: ReleaseTest>>testUndeclared (in category 'tests') -----
- ----- Method: ReleaseTest>>testUndeclared (in category 'testing') -----
testUndeclared

Smalltalk cleanOutUndeclared.
self
assert: Undeclared isEmpty
description: ('{1} {2} in Undeclared'
format: {
Undeclared keys asCommaStringAnd.
Undeclared keys size = 1
ifTrue: [ 'is' ]
ifFalse: [ 'are' ] })!

Item was changed:
+ ----- Method: ScannerTest>>testLiteralSymbols (in category 'tests') -----
- ----- Method: ScannerTest>>testLiteralSymbols (in category 'testing') -----
testLiteralSymbols

self assert: ('*+-/\~=<>&@%,|' allSatisfy: [:char | Scanner isLiteralSymbol: (String with: char) asSymbol])
description: 'single letter binary symbols can be printed without string quotes'.

self assert: (#('x' 'x:' 'x:y:' 'from:to:by:' 'yourself') allSatisfy: [:str | Scanner isLiteralSymbol: str asSymbol])
description: 'valid ascii selector symbols can be printed without string quotes'.

((32 to: 126) collect: [:ascii | Character value: ascii]) ,
#(':x:yourself' '::' 'x:yourself' '123' 'x0:1:2:' 'x.y.z' '1abc' 'a1b0c2' ' x' 'x ' '+x-y' '||' '--' '++' '+-' '+/-' '-/+' '<|>' '#x' '()' '[]' '{}' '')
do: [:str |
self assert: (Compiler evaluate: str asSymbol printString) = str asSymbol
description: 'in all case, a Symbol must be printed in an interpretable fashion']!

Item was changed:
+ ----- Method: SecureHashAlgorithmTest>>testEmptyInput (in category 'tests - examples') -----
- ----- Method: SecureHashAlgorithmTest>>testEmptyInput (in category 'testing - examples') -----
testEmptyInput
self assert: ((SecureHashAlgorithm new hashMessage: '') radix: 16)
= 'DA39A3EE5E6B4B0D3255BFEF95601890AFD80709'!

Item was changed:
+ ----- Method: SecureHashAlgorithmTest>>testExample1 (in category 'tests - examples') -----
- ----- Method: SecureHashAlgorithmTest>>testExample1 (in category 'testing - examples') -----
testExample1

"This is the first example from the specification document (FIPS PUB 180-1)"

hash := SecureHashAlgorithm new hashMessage: 'abc'.
self assert: (hash = 16rA9993E364706816ABA3E25717850C26C9CD0D89D).
!

Item was changed:
+ ----- Method: SecureHashAlgorithmTest>>testExample2 (in category 'tests - examples') -----
- ----- Method: SecureHashAlgorithmTest>>testExample2 (in category 'testing - examples') -----
testExample2

"This is the second example from the specification document (FIPS PUB 180-1)"

hash := SecureHashAlgorithm new hashMessage:
'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'.
self assert: (hash = 16r84983E441C3BD26EBAAE4AA1F95129E5E54670F1).!

Item was changed:
+ ----- Method: SecureHashAlgorithmTest>>testExample3 (in category 'tests - examples') -----
- ----- Method: SecureHashAlgorithmTest>>testExample3 (in category 'testing - examples') -----
testExample3

"This is the third example from the specification document (FIPS PUB 180-1).
This example may take several minutes."

hash := SecureHashAlgorithm new hashMessage: (String new: 1000000 withAll: $a).
self assert: (hash = 16r34AA973CD4C4DAA4F61EEB2BDBAD27316534016F).!

Item was changed:
+ ----- Method: SumBugs>>testSummingColors (in category 'tests') -----
- ----- Method: SumBugs>>testSummingColors (in category 'as yet unclassified') -----
testSummingColors
"self run: #testSummingColors"
| cases |
cases := {
Color black.
Color red.
Color green.
Color blue.
Color cyan.
Color magenta.
Color yellow.
Color white.
}.

cases do: [ :each |
self assert: ((Array with: each) sum = each)
].
!

Item was changed:
+ ----- Method: SumBugs>>testSummingToTen (in category 'tests') -----
- ----- Method: SumBugs>>testSummingToTen (in category 'as yet unclassified') -----
testSummingToTen
"self run: #testSummingToTen"

| cases |
cases :={
{ 1 . 2 . 3 . 4 }.
{ 2.0 . 2.0 . 2.0 . 2.0 . 2.0 }.
{ 2/5 . 5/2 . 5/2 . 3/5 . 4 }
} .

cases do: [ :each |
self assert: (each sum = 10 )
] .!

Item was changed:
+ ----- Method: SumBugs>>testSummingToWhite (in category 'tests') -----
- ----- Method: SumBugs>>testSummingToWhite (in category 'as yet unclassified') -----
testSummingToWhite
"self run: #testSummingToWhite"

| cases |
cases := {
{ Color black . Color white }.
{ Color red . Color green. Color blue }.
{ Color gray . Color gray }.
{ Color cyan. Color magenta. Color yellow }.
{ Color cyan. Color magenta. }.
{ Color magenta. Color yellow }.
{ Color cyan. Color yellow }.
{ Color cyan. Color red }.
{ Color green .Color magenta. }.
{ Color blue. Color yellow }.
} .

cases do: [ :each |
self assert: (each sum = Color white)
] .

!

Item was changed:
+ ----- Method: SumBugs>>testSummingWithBlack (in category 'tests') -----
- ----- Method: SumBugs>>testSummingWithBlack (in category 'as yet unclassified') -----
testSummingWithBlack
"self run: #testSummingWithBlack"

| cases |
cases := {
Color black.
Color red.
Color green.
Color blue.
Color cyan.
Color magenta.
Color yellow.
Color white.
}.

cases do: [ :each |
self assert: ((Array with: each with: Color black) sum = each)
] .

!

Item was changed:
+ ----- Method: SumBugs>>testSummingWithWhite (in category 'tests') -----
- ----- Method: SumBugs>>testSummingWithWhite (in category 'as yet unclassified') -----
testSummingWithWhite
"self run: #testSummingWithWhite"

| cases |
cases := {
Color black.
Color red.
Color green.
Color blue.
Color cyan.
Color magenta.
Color yellow.
Color white.
} .

cases do: [ :each |
self assert: ((Array with: Color white with: each ) sum = Color white)
] .

!

Item was changed:
+ ----- Method: SystemVersionTest>>testMajorMinorVersion (in category 'tests') -----
- ----- Method: SystemVersionTest>>testMajorMinorVersion (in category 'as yet unclassified') -----
testMajorMinorVersion
"
SystemVersionTest run: #testMajorMinorVersion
"
self assert: (SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion = 'Squeak3.7'.
self assert: (SystemVersion new version: 'Squeak3.7') majorMinorVersion = 'Squeak3.7'.
self assert: (SystemVersion new version: 'Squeak3') majorMinorVersion = 'Squeak3'.
self assert: (SystemVersion new version: '') majorMinorVersion = ''.
!

Item was changed:
+ ----- Method: TestObjectsAsMethods>>testAddNumbers (in category 'tests') -----
- ----- Method: TestObjectsAsMethods>>testAddNumbers (in category 'testing') -----
testAddNumbers
self assert: (self add: 3 with: 4) = 7.
self assert: (self perform: #add:with: withArguments: #(3 4)) = 7.!

Item was changed:
+ ----- Method: TestObjectsAsMethods>>testAnswer42 (in category 'tests') -----
- ----- Method: TestObjectsAsMethods>>testAnswer42 (in category 'testing') -----
testAnswer42
self assert: self answer42 = 42!

Item was changed:
+ ----- Method: TestObjectsAsMethods>>testDNU (in category 'tests') -----
- ----- Method: TestObjectsAsMethods>>testDNU (in category 'testing') -----
testDNU
self should: [self foo] raise: MessageNotUnderstood!

Item was changed:
+ ----- Method: TestVMStatistics>>testVmStatisticsReportString (in category 'tests') -----
- ----- Method: TestVMStatistics>>testVmStatisticsReportString (in category 'testing') -----
testVmStatisticsReportString
"Results of this test vary by VM implementation. Failure usually indicates
an unchecked assumption about the array size."

self shouldnt: [Smalltalk vmStatisticsReportString]
raise: Error
description: 'probable unchecked VM statistics array size'
!

Item was changed:
+ ----- Method: TestValueWithinFix>>valueWithinNonLocalReturn (in category 'private') -----
- ----- Method: TestValueWithinFix>>valueWithinNonLocalReturn (in category 'tests') -----
valueWithinNonLocalReturn
"Do a non-local return from a valueWithin: block"
[^self] valueWithin: 20 milliSeconds onTimeout:[].
!

Jakob Reschke

Re: The Trunk: Tests-pre.404.mcz

Am Fr., 7. Dez. 2018 um 13:28 Uhr schrieb <[hidden email]>:

Patrick Rein uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-pre.404.mcz

=============== Diff against Tests-dtl.403 ===============

[...]

Item was changed:
+ ----- Method: MCMockClassA>>d (in category 'numeric') -----
- ----- Method: MCMockClassA>>d (in category 'as yet classified') -----
d
^ 'd'!

[...]

Note that the category was "classified" instead of "unclassified" before. ;-) Looks like a joke to me.

This made a code serialization test in a non-trunk Monticello-related package fail and I wondered all the time what caused it... the test compares serialized code with an expected string, which still contains the old category, of course.

So now the test would need one expected string for Squeak <= 5.2 and a different one for later, or it must build the expected string dynamically. :-(

What do you think, should we rather revert this one category change instead?