[Pkg] The Trunk: Tests-fbs.254.mcz

[commits at source.squeak.org]

Frank Shearar uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-fbs.254.mcz

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

Name: Tests-fbs.254
Author: fbs
Time: 24 September 2013, 10:20:04.736 pm
UUID: a3fc070d-993c-4b4a-ba6e-55916e3aa234
Ancestors: Tests-nice.253

Tests (gasp!) for RecentMessages. Note the hopefully novel use of an Environment as a sandbox.

=============== Diff against Tests-nice.253 ===============

Item was added:
+ Object subclass: #FakeObjectOut
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-System-Support'!
+ 
+ !FakeObjectOut commentStamp: 'fbs 9/2/2013 11:08' prior: 0!
+ RecentMessagesTest uses me to show how it behaves when recent submissions contain references to methods in classes no longer in the image.!

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

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

Item was added:
+ TestCase subclass: #RecentMessagesTest
+ 	instanceVariableNames: 'rm env'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-System-Support'!

Item was added:
+ ----- Method: RecentMessagesTest>>createClass: (in category 'private') -----
+ createClass: aSymbol
+ 	| builder |
+ 	builder := ClassBuilder new.
+ 	builder
+ 		name: aSymbol
+ 		inEnvironment: env
+ 		subclassOf: Object
+ 		type: #normal
+ 		instanceVariableNames: ''
+ 		classVariableNames: ''
+ 		poolDictionaries: ''
+ 		category: 'Test'.
+ 	^ env at: aSymbol.!

Item was added:
+ ----- Method: RecentMessagesTest>>setUp (in category 'running') -----
+ setUp
+ 	rm := RecentMessages new.
+ 	env := Environment withName: 'EnvironmentForRecentMessagesTest'.
+ 	env at: #FakeObjectOut put: FakeObjectOut new.!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 oldest selector.!

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

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: RecentMessagesTest>>testMostRecentReturnsLastExtantReference (in category 'testing') -----
+ testMostRecentReturnsLastExtantReference
+ 	| 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: #foo equals: rm mostRecent selector.!

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

Item was added:
+ ----- Method: RecentMessagesTest>>testPurgeMissingMethods (in category 'testing') -----
+ testPurgeMissingMethods
+ 	rm recordSelector: #utilitiesDoesNotKnowThisSelector forClass: Utilities inEnvironment: Smalltalk globals.
+ 	rm recordSelector: #utilitiesDoesNotKnowThisSelectorEither forClass: Utilities inEnvironment: Smalltalk globals.
+ 	rm purgeMissingMethods.
+ 	self assert: 0 equals: rm size.!

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

Item was added:
+ ----- Method: RecentMessagesTest>>testPurgeMissingMethodsRemovesSubmissionsForMissingClasses (in category 'testing') -----
+ testPurgeMissingMethodsRemovesSubmissionsForMissingClasses
+ 	| missingClass |
+ 	missingClass := FakeObjectOut new.
+ 	rm recordSelector: #Comment forClass: missingClass inEnvironment: env.
+ 	rm recordSelector: #foo forClass: missingClass inEnvironment: env.
+ 	rm purgeMissingMethods.
+ 	self assert: rm isEmpty.!

Item was added:
+ ----- Method: RecentMessagesTest>>testPurgeRemovesReferences (in category 'testing') -----
+ testPurgeRemovesReferences
+ 	| ref |
+ 	rm recordSelector: #foo forClass: Utilities inEnvironment: Smalltalk globals.
+ 	ref := MethodReference class: Utilities selector: #foo environment: Smalltalk globals.
+ 	rm purge: ref.
+ 	self assert: 0 equals: rm size.!

Item was added:
+ ----- Method: RecentMessagesTest>>testRecordSelectorForClassInEnvironmentAlwaysReturnsMethodReference (in category 'testing') -----
+ testRecordSelectorForClassInEnvironmentAlwaysReturnsMethodReference
+ 	| r |
+ 	WantsChangeSetLogging no.
+ 	r := rm recordSelector: #foo forClass: WantsChangeSetLogging inEnvironment: Smalltalk globals.	
+ 	self assert: MethodReference equals: r class description: 'Even when not logging, always return a MethodReference'.!

Item was added:
+ ----- Method: RecentMessagesTest>>testRecordSelectorForClassInEnvironmentReturnsMethodReference (in category 'testing') -----
+ testRecordSelectorForClassInEnvironmentReturnsMethodReference
+ 	| r sel class env |
+ 	sel := #foo.
+ 	class := self class.
+ 	env := self class environment.
+ 	r := rm recordSelector: sel forClass: class inEnvironment: env.
+ 	self assert: sel equals: r selector.
+ 	self assert: class equals: r actualClass.
+ 	self assert: env equals: r environment.
+ 	
+ 	self assert: r equals: (rm recordSelector: sel forClass: class inEnvironment: env).!

Item was added:
+ ----- 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 added:
+ ----- Method: RecentMessagesTest>>testRevertLastRemovesLatestVersion (in category 'testing') -----
+ testRevertLastRemovesLatestVersion
+ 	| victim |
+ 	victim := self createClass: #Victim.
+ 	victim compile: 'foo ^ 1'.
+ 	victim compile: 'foo ^ 2'.
+ 	rm recordSelector: #foo forClass: victim inEnvironment: env.
+ 	rm revertLast.
+ 	self assert: 1 equals: victim new foo description: 'Version not removed'.!

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ Object subclass: #WantsChangeSetLogging
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'WantsChangeSetLoggingFlag'
+ 	poolDictionaries: ''
+ 	category: 'Tests-System-Support'!
+ 
+ !WantsChangeSetLogging commentStamp: 'fbs 9/2/2013 11:08' prior: 0!
+ RecentMessagesTest uses me to show how it behaves when classes don't want to log to a change set.!

Item was added:
+ ----- Method: WantsChangeSetLogging class>>no (in category 'instance creation') -----
+ no
+ 	 WantsChangeSetLoggingFlag := false.!

Item was added:
+ ----- Method: WantsChangeSetLogging class>>wantsChangeSetLogging (in category 'compiling') -----
+ wantsChangeSetLogging
+ 	^ WantsChangeSetLoggingFlag.!

Item was added:
+ ----- Method: WantsChangeSetLogging class>>yes (in category 'instance creation') -----
+ yes
+ 	 WantsChangeSetLoggingFlag := true.!