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.! |
This one broke my update because WantsChangeSetLogging wantsChangeSetLogging is answering nil... 2013/9/24 <[hidden email]> Frank Shearar uploaded a new version of Tests to project The Trunk: SqueakDebug.log (14K) Download Attachment |
Free forum by Nabble | Edit this page |