[Pkg] The Trunk: Tests-ar.41.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jan 4 23:44:38 UTC 2010


Andreas Raab uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-ar.41.mcz

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

Name: Tests-ar.41
Author: ar
Time: 4 January 2010, 4:25:19 am
UUID: 341c7ef2-7570-984a-b573-31398e30ac36
Ancestors: Tests-nice.40

Making Tests unloadable: Move tests from Exceptions, Files, Compiler, System, Monticello into Tests package.

=============== Diff against Tests-nice.40 ===============

Item was added:
+ ----- Method: ExceptionTester>>doYetAnotherThingString (in category 'accessing') -----
+ doYetAnotherThingString
+ 
+ 	^'Do yet another thing.'!

Item was added:
+ ----- Method: MCTestCase>>mockMessageString (in category 'mocks') -----
+ mockMessageString
+ 	^ 'A version generated for testing purposes.'!

Item was added:
+ ----- Method: MCDependencySorterTest>>testExtraProvisions (in category 'tests') -----
+ testExtraProvisions
+ 	self assertItems:
+ 		#((a (x) (z))
+ 		(b () (x)))
+ 	orderAs: #(a b)
+ 	withRequired: #()
+ 	toLoad: #()	
+ 	extraProvisions: #(x z)!

Item was added:
+ ----- Method: FileStreamTest>>testDetectFileDo (in category 'as yet unclassified') -----
+ testDetectFileDo
+ 	"Mantis #1838"
+ 	
+ 	| filename |
+ 	filename := 'filestream.tst'.
+ 	
+ 	[(FileDirectory default forceNewFileNamed: filename)
+ 		nextPutAll: '42';
+ 		close.
+ 		
+ 	FileStream 
+ 		detectFile: [FileDirectory default oldFileNamed: filename]
+ 		do: [:file |
+ 			self assert: file notNil.
+ 			self deny: file closed.
+ 			self assert: file contentsOfEntireFile = '42']]
+ 	
+ 		ensure: [FileDirectory default deleteFileNamed: filename ifAbsent: [] ]!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesQAtoQM (in category 'tests') -----
+ testDecompilerInClassesQAtoQM
+ 	self decompileClassesSelect: [:cn| cn first = $Q and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCDependencySorterTest>>testUnusedAlternateProvider (in category 'tests') -----
+ testUnusedAlternateProvider
+ 	self assertItems: #(
+ 		(a (x) (z))
+ 		(b () (x))
+ 		(c (x) ()))
+ 	orderAs: #(c b)
+ 	withRequired: #(z)
+ 	toLoad: #(a)	!

Item was added:
+ ----- Method: MCMergingTest>>assertMerge:with:base:gives:conflicts: (in category 'asserting') -----
+ assertMerge: local with: remote base: ancestor gives: result conflicts: conflictResult
+ 	| merger |
+ 	conflicts := #().
+ 	merger := MCThreeWayMerger
+ 				base: (self snapshotWithElements: local)
+ 				target: (self snapshotWithElements: remote)
+ 				ancestor: (self snapshotWithElements: ancestor).
+ 	merger conflicts do: [:ea | self handleConflict: ea].
+ 	self assert: merger mergedSnapshot definitions hasElements: result.
+ 	self assert: conflicts asSet = conflictResult asSet.!

Item was added:
+ ----- Method: FileDirectoryTest>>testNonExistentDirectory (in category 'existence tests') -----
+ testNonExistentDirectory
+ 
+ 	| directory parentDirectory |
+ 	directory :=FileDirectory default
+ 				directoryNamed: 'nonExistentFolder'.
+ 	self shouldnt: [directory exists] 
+ 		description: 'A FileDirectory instance should know if it points to a non-existent directory.'.
+ 
+ 	parentDirectory :=FileDirectory default.
+ 	self shouldnt: [parentDirectory directoryExists: 'nonExistentFolder'] 
+ 		description: 'A FileDirectory instance should know when a directory of the given name doesn''t exist'.
+ !

Item was added:
+ ----- Method: StandardSystemFontsTest>>testRestoreDefaultFonts (in category 'testing') -----
+ testRestoreDefaultFonts
+ 	self saveStandardSystemFontsDuring: [
+ 		Preferences restoreDefaultFonts.
+ 		self assert: #standardDefaultTextFont familyName: 'Bitmap DejaVu Sans' pointSize: 9.
+ 		self assert: #standardListFont familyName: 'Bitmap DejaVu Sans' pointSize: 9.
+ 		self assert: #standardFlapFont familyName: 'Accushi' pointSize: 12.
+ 		self assert: #standardEToysFont familyName: 'BitstreamVeraSans' pointSize: 9.
+ 		self assert: #standardMenuFont familyName: 'Bitmap DejaVu Sans' pointSize: 9.
+ 		self assert: #windowTitleFont familyName: 'Bitmap DejaVu Sans' pointSize: 12.
+ 		self assert: #standardBalloonHelpFont familyName: 'Accujen' pointSize: 9.
+ 		self assert: #standardCodeFont familyName: 'Bitmap DejaVu Sans' pointSize: 9.
+ 		self assert: #standardButtonFont familyName: 'BitstreamVeraSansMono' pointSize: 9]!

Item was added:
+ ----- Method: MCScannerTest>>test4 (in category 'tests') -----
+ test4
+ 	self assertScans: #(a '23' (x () ')''q' y12)).!

Item was added:
+ ----- Method: MCAncestryTest>>testDescendants (in category 'tests') -----
+ testDescendants
+ 	| c1 a1 b3 q1 q2 c2 |
+ 	c1 := self tree.
+ 	a1 := self treeFrom: #(a1 (('00'))).
+ 	b3 := self treeFrom: #(b3
+ 				((b2
+ 					((b1
+ 						((b0
+ 							(('00')))))))
+ 				(a1
+ 					(('00'))))).
+ 	q1 := MCWorkingAncestry new addAncestor: a1.
+ 	q2 := MCWorkingAncestry new addAncestor: q1.
+ 	self assert: (q2 commonAncestorWith: b3) = a1.
+ 	self assert: (b3 commonAncestorWith: q2) = a1.
+ 	self assert: (q2 commonAncestorWith: c1) = a1.
+ 	self assert: (c1 commonAncestorWith: q2) = a1.
+ 	q1 addStepChild: c1.
+ 	self assert: (q2 commonAncestorWith: c1) = q1.
+ 	self assert: (c1 commonAncestorWith: q2) = q1.
+ 	c2 := MCWorkingAncestry new addAncestor: c1.
+ 	self assert: (q2 commonAncestorWith: c2) = q1.
+ 	self assert: (c2 commonAncestorWith: q2) = q1.
+ !

Item was added:
+ ----- Method: ExceptionTester>>doSomethingExceptionalString (in category 'accessing') -----
+ doSomethingExceptionalString
+ 
+ 	^'Do something exceptional.'!

Item was added:
+ ----- Method: MCTestCase>>mockVersionInfo: (in category 'mocks') -----
+ mockVersionInfo: tag 
+ 	^ MCVersionInfo
+ 		name: self mockVersionName, '-', tag asString
+ 		id: UUID new
+ 		message: self mockMessageString, '-', tag asString
+ 		date: Date today
+ 		time: Time now
+ 		author: Utilities authorInitials 
+ 		ancestors: #()
+ !

Item was added:
+ ----- Method: MCTestCase>>change:toReturn: (in category 'compiling') -----
+ change: aSelector toReturn: anObject
+ 	self 
+ 		compileClass: self mockClassA 
+ 		source: aSelector, ' ^ ', anObject printString 
+ 		category: 'numeric'!

Item was added:
+ ----- Method: ClosureTests>>testCopyNonLocalReturn (in category 'testing') -----
+ testCopyNonLocalReturn
+ 	self
+ 		shouldnt: [self methodWithNonLocalReturn]
+ 		raise: Error!

Item was added:
+ ----- Method: MCStWriterTest>>assertChunkIsWellFormed: (in category 'asserting') -----
+ assertChunkIsWellFormed: chunk
+ 	self class parserClass new
+ 		parse: chunk readStream 
+ 		class: UndefinedObject 
+ 		noPattern: true
+ 		context: nil
+ 		notifying: nil
+ 		ifFail: [self assert: false]!

Item was added:
+ ----- Method: MCTestCase>>mockEmptyPackage (in category 'mocks') -----
+ mockEmptyPackage
+ 	^ MCPackage named: (MCEmptyPackageInfo new packageName)!

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

Item was added:
+ ----- Method: ExceptionTester>>simpleEnsureTestWithErrorResults (in category 'results') -----
+ simpleEnsureTestWithErrorResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: 'Unhandled Exception';
+ 		add: self doYetAnotherThingString;
+ 		yourself!

Item was added:
+ ----- Method: MirrorPrimitiveTests>>expectedFailures (in category 'testing') -----
+ expectedFailures
+ 
+ 	^#(testMirrorAt testMirrorEqEq testMirrorInstVarAt testMirrorPerform testMirrorSize)!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesJAtoJM (in category 'tests') -----
+ testDecompilerInClassesJAtoJM
+ 	self decompileClassesSelect: [:cn| cn first = $J and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: ExceptionTester>>simpleEnsureTestWithNotification (in category 'tests') -----
+ simpleEnsureTestWithNotification
+ 
+ 	[self doSomething.
+ 	self methodWithNotification.
+ 	self doSomethingElse]
+ 		ensure:
+ 			[self doYetAnotherThing].
+ 	!

Item was added:
+ ----- Method: ProcessTerminateBug>>testUnwindFromForeignProcess (in category 'tests') -----
+ testUnwindFromForeignProcess
+ 	| sema process |
+ 	sema := Semaphore forMutualExclusion.
+ 	self assert: sema isSignaled.
+ 	process := [
+ 		sema critical:[
+ 			self deny: sema isSignaled.
+ 			sema wait. "deadlock"
+ 		]
+ 	] forkAt: Processor userInterruptPriority.
+ 	self deny: sema isSignaled.
+ 	"This is for illustration only - the BlockCannotReturn cannot 
+ 	be handled here (it's truncated already)"
+ 	self shouldnt: [process terminate] raise: BlockCannotReturn.
+ 	self assert: sema isSignaled.
+ 	!

Item was added:
+ ----- Method: MCMczInstallerTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ 	expected := self mockVersion.
+ 	self change: #one toReturn: 2.!

Item was added:
+ ----- Method: ArrayLiteralTest>>tearDown (in category 'initialize-release') -----
+ tearDown
+ 	self class removeSelector: #array!

Item was added:
+ ----- Method: ExceptionTester>>simpleTimeoutTestResults (in category 'results') -----
+ simpleTimeoutTestResults
+ 
+ 	| things |
+ 	things := OrderedCollection new: self iterationsBeforeTimeout.
+ 
+ 	self iterationsBeforeTimeout timesRepeat: [ things add: self  doSomethingString ].
+ 	things add: self doSomethingElseString.
+ 
+ 	^ things!

Item was added:
+ ----- Method: MCMczInstallerTest>>assertNoChange (in category 'as yet unclassified') -----
+ assertNoChange
+ 	| actual |
+ 	actual := MCSnapshotResource takeSnapshot.
+ 	diff := actual patchRelativeToBase: expected snapshot.
+ 	self assert: diff isEmpty!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesWAtoWM (in category 'tests') -----
+ testDecompilerInClassesWAtoWM
+ 	self decompileClassesSelect: [:cn| cn first = $W and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: ExceptionTester>>contents (in category 'logging') -----
+ contents
+ 
+ 	^( self log
+ 		inject: (WriteStream on: (String new: 80))
+ 		into: 
+ 			[:result :item |
+ 			result 
+ 				cr; 
+ 				nextPutAll: item;
+ 				yourself] ) contents!

Item was added:
+ ----- Method: MCAncestryTest>>testPathToMissingAncestor (in category 'tests') -----
+ testPathToMissingAncestor
+ 	self assert: (self tree allAncestorsOnPathTo: MCVersionInfo new) isEmpty!

Item was added:
+ ----- Method: ClosureTests>>testToDoInsideTemp (in category 'testing-todo') -----
+ testToDoInsideTemp
+ 	1 to: 5 do: [ :index | 
+ 		| temp | 
+ 		temp := index. 
+ 		collection add: [ temp ] ].
+ 	self assertValues: #(1 2 3 4 5)!

Item was added:
+ ----- Method: MCMczInstallerTest class>>isAbstract (in category 'as yet unclassified') -----
+ isAbstract
+ 	^ (Smalltalk hasClassNamed: #MczInstaller) not
+ 		!

Item was added:
+ ----- Method: EventManagerTest>>tearDown (in category 'running') -----
+ tearDown
+ 
+ 	eventSource releaseActionMap.
+ 	eventSource := nil.
+ 	eventListener := nil.
+ 	super tearDown.
+ !

Item was added:
+ Object subclass: #ExceptionTester
+ 	instanceVariableNames: 'log suiteLog iterationsBeforeTimeout'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Exceptions'!

Item was added:
+ MCTestCase subclass: #MCOrganizationTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: DecompilerTests>>blockingClasses (in category 'utilities') -----
+ blockingClasses
+ 
+ 
+ 	^ #(CompiledMethod)!

Item was added:
+ ----- Method: LocaleTest>>testIsFontAvailable (in category 'testing') -----
+ testIsFontAvailable
+ 	"self debug: #testIsFontAvailable"
+ 	(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!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesCAtoCM (in category 'tests') -----
+ testDecompilerInClassesCAtoCM
+ 	self decompileClassesSelect: [:cn| cn first = $C and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: ExpandedSourceFileArrayTest>>testSourcePointerFromFileIndexAndPosition (in category 'testing') -----
+ testSourcePointerFromFileIndexAndPosition
+ 	"Test valid input ranges"
+ 
+ 	| sf |
+ 	sf := ExpandedSourceFileArray new.
+ 	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 0] raise: Error.
+ 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 0] raise: Error.
+ 	self shouldnt: [sf sourcePointerFromFileIndex: 2 andPosition: 0] raise: Error.
+ 	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 3] raise: Error.
+ 	self should: [sf sourcePointerFromFileIndex: 1 andPosition: -1] raise: Error.
+ 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF] raise: Error.
+ 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r2000000] raise: Error.
+ 	self should: [sf sourcePointerFromFileIndex: 3 andPosition: 0] raise: Error.
+ 	self should: [sf sourcePointerFromFileIndex: 4 andPosition: 0] raise: Error.
+ 	
+ 	self assert: 16r1000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 0).
+ 	self assert: 16r1000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r13).
+ 	self assert: 16r1FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16rFFFFFF).
+ 	self assert: 16r2000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 0).
+ 	self assert: 16r2000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r13).
+ 	self assert: 16r2FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16rFFFFFF).
+ 	self assert: 16r3000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000000).
+ 	self assert: 16r3000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000013).
+ 	self assert: 16r3FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF).
+ 	self assert: 16r4000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000000).
+ 	self assert: 16r4000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000013).
+ 	self assert: 16r4FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1FFFFFF)
+ !

Item was changed:
+ SystemOrganization addCategory: #'Tests-Exceptions'!
+ SystemOrganization addCategory: #'Tests-Files'!
+ SystemOrganization addCategory: #'Tests-Compiler'!
+ SystemOrganization addCategory: #'Tests-Digital Signatures'!
+ SystemOrganization addCategory: #'Tests-Object Events'!
+ SystemOrganization addCategory: #'Tests-System-Support'!
  SystemOrganization addCategory: #'Tests-Bugs'!
  SystemOrganization addCategory: #'Tests-ObjectsAsMethods'!
  SystemOrganization addCategory: #'Tests-PrimCallController'!
  SystemOrganization addCategory: #'Tests-Release'!
  SystemOrganization addCategory: #'Tests-Utilities'!
  SystemOrganization addCategory: #'Tests-VM'!
  SystemOrganization addCategory: #'Tests-Hex'!
+ SystemOrganization addCategory: #'Tests-Monticello'!
+ SystemOrganization addCategory: #'Tests-Localization'!
+ SystemOrganization addCategory: #'Tests-FilePackage'!
+ SystemOrganization addCategory: #'Tests-Finalization'!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>allCategories (in category 'private') -----
+ allCategories
+ 	^ Array with: model extensionsCategory with: self mockCategoryName.!

Item was added:
+ ClassTestCase subclass: #FileStreamTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Files'!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesPAtoPM (in category 'tests') -----
+ testDecompilerInClassesPAtoPM
+ 	self decompileClassesSelect: [:cn| cn first = $P and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>definedClasses (in category 'private') -----
+ definedClasses
+ 	^ MCSnapshotResource current definitions 
+ 		select: [:def | def isClassDefinition] 
+ 		thenCollect: [:def | def className].!

Item was added:
+ ----- Method: CompilerExceptionsTest>>select (in category 'emulating') -----
+ select
+ 	!

Item was added:
+ ----- Method: MCStWriterTest>>expectedClassMethodDefinition (in category 'data') -----
+ expectedClassMethodDefinition
+ 	^ '
+ !!MCMockClassA class methodsFor: ''as yet unclassified'' stamp: ''ab 7/7/2003 23:21''!!
+ one
+ 
+ 	^ 1!! !!
+ '!

Item was added:
+ ----- Method: MyResumableTestError>>isResumable (in category 'exceptionDescription') -----
+ isResumable
+ 
+ 	^true!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testTextPane (in category 'testing') -----
+ testTextPane
+ 	self shouldnt: [self textMorph] raise: Exception.!

Item was added:
+ ----- Method: MCVersionTest>>testPostOrder (in category 'tests') -----
+ testPostOrder
+ 	self 
+ 		assert: #allDependenciesDo: 
+ 		orders: #(a ((b (d e)) c)) 
+ 		as: #(d e b c)!

Item was added:
+ ----- Method: MCClassDefinitionTest>>testCreation (in category 'as yet unclassified') -----
+ testCreation
+ 	| d |
+ 	d :=  self mockClassA asClassDefinition.
+ 	self assert: d className = #MCMockClassA.
+ 	self assert: d superclassName = #MCMock.
+ 	self assert: d type = #normal.
+ 	self assert: d category = self mockCategoryName.
+ 	self assert: d instVarNames asArray = #('ivar').
+ 	self assert: d classVarNames asArray = #('CVar').
+ 	self assert: d classInstVarNames asArray = #().
+ 	self assert: d comment isString.
+ 	self assert: d comment = self classAComment.
+ 	self assert: d commentStamp = self mockClassA organization commentStamp!

Item was added:
+ ----- Method: ExceptionTests>>testNonResumablePass (in category 'testing-outer') -----
+ testNonResumablePass
+ 
+ 	self should: [
+ 		[Error signal. 4] 
+ 			on: Error 
+ 			do: [:ex | ex pass. ex return: 5]
+ 		] raise: Error
+ !

Item was added:
+ ----- Method: MCRepositoryTest>>addVersion: (in category 'actions') -----
+ addVersion: aVersion
+ 	self subclassResponsibility !

Item was added:
+ ----- Method: ExceptionTester>>runBasicTests (in category 'suites') -----
+ runBasicTests
+ 
+ 	self basicTestSelectors
+ 		do:
+ 			[:eachTestSelector |
+ 			self runTest: eachTestSelector]!

Item was added:
+ ----- Method: EventManagerTest>>getFalse: (in category 'private') -----
+ getFalse: anArg
+ 
+ 	^false!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testEmptyLcs1 (in category 'tests') -----
+ testEmptyLcs1
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a b c) and: #().
+ 	self assert: patch size = 3.
+ 	self assert: (patch allSatisfy: [ :each | each key = #remove ])!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleEnsureTestWithNotification (in category 'testing-ExceptionTester') -----
+ testSimpleEnsureTestWithNotification
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithNotification ) !

Item was added:
+ ----- Method: ObjectFinalizerTests>>finalize: (in category 'finalization handling') -----
+ finalize: anObject
+ 	log addLast: anObject asString, ' ', 'finalized'.!

Item was added:
+ ----- Method: ExceptionTester>>simpleResumeTestResults (in category 'signaledException results') -----
+ simpleResumeTestResults
+ 
+ 	"see if we can resume twice"
+ 
+ 	^OrderedCollection new
+ 			add: self doSomethingString;
+ 			add: self doYetAnotherThingString;
+ 			add: self doSomethingElseString;
+ 			add: self doYetAnotherThingString;
+ 			add: self doSomethingElseString;
+ 			yourself!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testMethodSelected (in category 'testing') -----
+ testMethodSelected
+ 	self clickOnListItem: self mockCategoryName.
+ 	self clickOnListItem: 'MCMockClassA'.
+ 	self clickOnListItem: 'boolean'.
+ 	self clickOnListItem: 'falsehood'.
+ 	
+ 	self assertAListMatches: self allCategories.
+ 	self assertAListMatches: self definedClasses.
+ 	self assertAListMatches: self classAProtocols.
+ 	self assertAListMatches: self classABooleanMethods.
+ 	self assertTextIs: self falsehoodMethodSource.!

Item was added:
+ MCTestCase subclass: #MCAncestryTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesUNtoUZ (in category 'tests') -----
+ testDecompilerInClassesUNtoUZ
+ 	self decompileClassesSelect: [:cn| cn first = $U and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCStReaderTest>>commentWithStyle (in category 'as yet unclassified') -----
+ commentWithStyle
+ 	^ '!!AEDesc commentStamp: ''<historical>'' prior: 0!!
+ I represent an Apple Event Descriptor.  I am a low-level representation of Apple Event (and hence Applescript) information.  For further Information, see Apple''s Inside Macintosh: Interapplication Communications, at
+ 
+ 	http://developer.apple.com/techpubs/mac/IAC/IAC-2.html.
+ 
+ Essentially, I represent a record comprising a one-word "string" (treating the word as fourbyte characters) representing a data type, followed by a pointer to a pointer (a handle) to the data I represent.  Care must be taken to assure that the Handle data is disposed after use, or memory leaks result.  At this time, I make no effort to do this automatically through finalization.!!
+ ]style[(218 54 384)f1,f1Rhttp://developer.apple.com/techpubs/mac/IAC/IAC-2.html;,f1!!
+ '!

Item was added:
+ ----- Method: ExceptionTester>>simpleReturnTestResults (in category 'signaledException results') -----
+ simpleReturnTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doYetAnotherThingString;
+ 		yourself!

Item was added:
+ ----- Method: MCRepositoryTest>>assertMissing: (in category 'asserting') -----
+ assertMissing: aVersionInfo
+ 	self assert: (repository versionWithInfo: aVersionInfo) isNil!

Item was added:
+ ----- Method: MCChangeNotificationTest>>tearDown (in category 'running') -----
+ tearDown
+ 	workingCopy unregister!

Item was added:
+ ----- Method: EventManagerTest>>testNoValueSupplier (in category 'running-broadcast query') -----
+ testNoValueSupplier
+ 
+ 	succeeded := eventSource 
+ 		triggerEvent: #needsValue
+ 		ifNotHandled: [true].
+ 	self should: [succeeded]!

Item was added:
+ ----- Method: ClosureCompilerTest>>testSourceRangeAccessForBlueBookInjectInto (in category 'tests') -----
+ testSourceRangeAccessForBlueBookInjectInto
+ 	"Test debugger source range selection for inject:into: for a version compiled with closures"
+ 	"self new testSourceRangeAccessForBlueBookInjectInto"
+ 	| source method |
+ 	source := (Collection sourceCodeAt: #inject:into:) asString.
+ 	method := (Parser new
+ 						encoderClass: EncoderForV3;
+ 						parse: source
+ 						class: Collection)
+ 					generate: (Collection compiledMethodAt: #inject:into:) trailer.
+ 	self supportTestSourceRangeAccessForInjectInto: method source: source!

Item was added:
+ ----- Method: MCTestCase>>mockVersionWithAncestor: (in category 'mocks') -----
+ mockVersionWithAncestor: aMCVersion 
+ 	^ MCVersion
+ 		package: self mockPackage
+ 		info: (self mockVersionInfoWithAncestor: aMCVersion info)
+ 		snapshot: self mockSnapshot!

Item was added:
+ MCRepositoryTest subclass: #MCDirectoryRepositoryTest
+ 	instanceVariableNames: 'directory'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: ExceptionTests>>testResumableFallOffTheEndHandler (in category 'testing-ExceptionTester') -----
+ testResumableFallOffTheEndHandler
+ 	self assertSuccess: (ExceptionTester new runTest: #resumableFallOffTheEndHandler ) !

Item was added:
+ ----- Method: MCAncestryTest>>versionForName:in: (in category 'building') -----
+ versionForName: name in: tree
+ 	(tree name = name) ifTrue: [^ tree].
+ 	
+ 	tree ancestors do: [:ea | (self versionForName: name in: ea) ifNotNil: [:v | ^ v]].
+ 	
+ 	^ nil!

Item was added:
+ ----- Method: ExceptionTester>>runAllTests (in category 'suites') -----
+ runAllTests
+ 	"ExceptionTester new runAllTests"
+ 
+ 	self
+ 		runBasicTests;
+ 		runBasicANSISignaledExceptionTests!

Item was added:
+ ----- Method: ClosureCompilerTest>>supportTestSourceRangeAccessForInjectInto:source:selectionSequence: (in category 'tests') -----
+ supportTestSourceRangeAccessForInjectInto: method source: source selectionSequence: selections
+ 	"Test debugger source range selection for inject:into:"
+ 	| evaluationCount sourceMap debugTokenSequence debugCount |
+ 	DebuggerMethodMap voidMapCache.
+ 	evaluationCount := 0.
+ 	sourceMap := method debuggerMap abstractSourceMap.
+ 	debugTokenSequence := selections collect: [:string| Scanner new scanTokens: string].
+ 	debugCount := 0.
+ 	thisContext
+ 		runSimulated: [(1 to: 2)
+ 						withArgs:
+ 							{	0.
+ 								[:sum :each|
+ 								 evaluationCount := evaluationCount + 1.
+ 								 sum + each]}
+ 						executeMethod: method]
+ 		contextAtEachStep:
+ 			[:ctxt| | range debugTokens |
+ 			(ctxt method == method
+ 			and: ["Exclude the send of #blockCopy: or #closureCopy:copiedValues: and braceWith:with:
+ 				    to create the block, and the #new: and #at:'s for the indirect temp vector.
+ 				   This for compilation without closure bytecodes. (Note that at:put:'s correspond to stores)"
+ 				(ctxt willSend
+ 					and: [(#(closureCopy:copiedValues: blockCopy: new: at: braceWith:with:) includes: ctxt selectorToSendOrSelf) not])
+ 				"Exclude the store of the argument into the home context (for BlueBook blocks)
+ 				 and the store of an indirection vector into an initial temp"
+ 				or: [(ctxt willStore
+ 					and: [(ctxt isBlock and: [ctxt pc = ctxt startpc]) not
+ 					and: [(ctxt isBlock not
+ 						and: [(method usesClosureBytecodes and: [ctxt abstractPC = 2])]) not]])
+ 				or: [ctxt willReturn]]]) ifTrue:
+ 				[debugTokens := debugTokenSequence at: (debugCount := debugCount + 1) ifAbsent: [#(bogusToken)].
+ 				 self assert: (sourceMap includesKey: ctxt abstractPC).
+ 				 range := sourceMap at: ctxt abstractPC ifAbsent: [(1 to: 0)].
+ 				 self assert: (Scanner new scanTokens: (source copyFrom: range first to: range last)) = debugTokens]].
+ 	self assert: evaluationCount = 2!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryRootExistence (in category 'as yet unclassified') -----
+ testFileDirectoryRootExistence
+ 	"Hoping that you have 'C:' of course..."
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	self assert: (FileDirectory root fileOrDirectoryExists: 'C:').!

Item was added:
+ ----- Method: MCStWriterTest>>testClassMethodDefinition (in category 'testing') -----
+ testClassMethodDefinition
+ 	writer visitMethodDefinition: (MethodReference class: self mockClassA class selector: #one) 									asMethodDefinition.
+ 	self assertContentsOf: stream match: self expectedClassMethodDefinition.
+ 	stream reset.
+ 	self assert: stream nextChunk isAllSeparators.
+ 	self assertChunkIsWellFormed: stream nextChunk.
+ 	self assertMethodChunkIsWellFormed: stream nextChunk.
+ 	self assert: stream nextChunk isAllSeparators !

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesANtoAZ (in category 'tests') -----
+ testDecompilerInClassesANtoAZ
+ 	self decompileClassesSelect: [:cn| cn first = $A and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: ExceptionTester>>simpleRetryTest (in category 'signaledException tests') -----
+ simpleRetryTest
+ 
+ 	| theMeaningOfLife |
+ 	theMeaningOfLife := nil.
+ 	[self doSomething.
+ 	theMeaningOfLife == nil
+ 		ifTrue: [MyTestError signal]
+ 		ifFalse: [self doSomethingElse]]
+ 			on: MyTestError
+ 			do:
+ 				[:ex |
+ 				theMeaningOfLife := 42.
+ 				self doYetAnotherThing.
+ 				ex retry]!

Item was added:
+ ----- Method: EventManagerTest>>heardEvent (in category 'private') -----
+ heardEvent
+ 
+ 	succeeded := true!

Item was added:
+ ----- Method: EventManagerTest>>getTrue: (in category 'private') -----
+ getTrue: anArg
+ 
+ 	^true!

Item was added:
+ ----- Method: ExceptionTester>>doublePassOuterTest (in category 'signaledException tests') -----
+ doublePassOuterTest
+ 	"uses #resume"
+ 
+ 	[[[self doSomething.
+ 	MyTestNotification signal.
+ 	self doSomethingExceptional]
+ 		on: MyTestNotification
+ 		do: [:ex | ex pass.
+ 			self doSomethingExceptional]]
+ 			on: MyTestNotification
+ 			do: [:ex | ex outer.
+ 				self doSomethingElse]]
+ 				on: MyTestNotification
+ 				do: [:ex | self doYetAnotherThing. ex resume]!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>morphsOfClass: (in category 'morphic') -----
+ morphsOfClass: aMorphClass
+ 	| morphs |
+ 	morphs := OrderedCollection new.
+ 	morph allMorphsDo: [:m | (m isKindOf: aMorphClass) ifTrue: [morphs add: m]].
+ 	^ morphs!

Item was added:
+ ----- Method: ClosureTests>>testToDoInsideTempNotInlined (in category 'testing-todo') -----
+ testToDoInsideTempNotInlined
+ 	| block |
+ 	block := [ :index | 
+ 		| temp | 
+ 		temp := index. 
+ 		collection add: [ temp ] ].
+ 	1 to: 5 do: block.
+ 	self assertValues: #(1 2 3 4 5)!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesNNtoNZ (in category 'tests') -----
+ testDecompilerInClassesNNtoNZ
+ 	self decompileClassesSelect: [:cn| cn first = $N and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCTestCase>>mockVersionInfoWithAncestor: (in category 'mocks') -----
+ mockVersionInfoWithAncestor: aVersionInfo 
+ 	^ MCVersionInfo
+ 		name: aVersionInfo name, '-child'
+ 		id: UUID new
+ 		message: self mockMessageString
+ 		date: Date today
+ 		time: Time now
+ 		author: Utilities authorInitials 
+ 		ancestors: {aVersionInfo}
+ !

Item was added:
+ ----- 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 added:
+ ----- Method: FileDirectoryTest>>testExists (in category 'existence tests') -----
+ testExists
+ 
+ 	self should: [FileDirectory default exists]
+ 		description: 'Should know default directory exists.'.
+ 	self should: [self myAssuredDirectory exists]
+ 		description: 'Should know created directory exists.'.
+ 
+ 	self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName.
+ 	self shouldnt: [(self myDirectory containingDirectory directoryNamed: self myLocalDirectoryName) exists]
+ 		description: 'Should know that recently deleted directory no longer exists.'.!

Item was added:
+ ----- Method: MCInitializationTest class>>isAbstract (in category 'as yet unclassified') -----
+ isAbstract
+ 	^ (Smalltalk hasClassNamed: #MczInstaller) not
+ 		!

Item was added:
+ ----- Method: FileDirectoryTest>>myAssuredDirectory (in category 'resources') -----
+ myAssuredDirectory
+ 
+ 	^self myDirectory assureExistence!

Item was added:
+ ----- Method: ClosureTests>>testWhileModificationAfter (in category 'testing-while') -----
+ testWhileModificationAfter
+ 	| index |
+ 	index := 0.
+ 	[ index < 5 ] whileTrue: [
+ 		collection add: [ index ].
+ 		index := index + 1 ].
+ 	self assertValues: #(5 5 5 5 5)!

Item was added:
+ ----- Method: MCClassDefinitionTest>>testComparison (in category 'as yet unclassified') -----
+ testComparison
+ 	| d1 d2 d3 d4 |
+ 	d1 := self mockClass: 'A' super: 'X'.
+ 	d2 := self mockClass: 'A' super: 'Y'.
+ 	d3 := self mockClass: 'B' super: 'X'.
+ 	d4 := self mockClass: 'B' super: 'X'.
+ 	
+ 	self assert: (d1 isRevisionOf: d2).
+ 	self deny: (d1 isSameRevisionAs: d2).
+ 
+ 	self assert: (d3 isRevisionOf: d4).
+ 	self assert: (d3 isSameRevisionAs: d4).
+ 	
+ 	self deny: (d1 isRevisionOf: d3).
+ 	self deny: (d4 isRevisionOf: d2).!

Item was added:
+ ----- Method: MCTestCase>>mockVersionWithDependencies (in category 'mocks') -----
+ mockVersionWithDependencies
+ 	^ MCVersion 
+ 		package: self mockPackage
+ 		info: self mockVersionInfo
+ 		snapshot: self mockSnapshot
+ 		dependencies: self mockDependencies!

Item was added:
+ TestCase subclass: #ArrayLiteralTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!

Item was added:
+ MCTestCase subclass: #MCRepositoryTest
+ 	instanceVariableNames: 'repository ancestors'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ MCTestCase subclass: #MCScannerTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCInitializationTest>>testWorkingCopy (in category 'as yet unclassified') -----
+ testWorkingCopy
+ 	MczInstaller storeVersionInfo: self mockVersion.
+ 	MCWorkingCopy initialize.
+ 	MCWorkingCopy allManagers
+ 						detect: [:man | man package name = self mockPackage name]
+ 						ifNone: [self assert: false]!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesGNtoGZ (in category 'tests') -----
+ testDecompilerInClassesGNtoGZ
+ 	self decompileClassesSelect: [:cn| cn first = $G and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>classABooleanMethods (in category 'private') -----
+ classABooleanMethods
+ 	^ #(falsehood moreTruth truth)!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testIfSequence2 (in category 'tests') -----
+ testIfSequence2
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a b c d) and: #(c d b a).
+ 	self assert: patch size = 6.	"lcs is cd"
+ 	self assert: (patch count: [ :each | each key = #match ]) = 2.
+ 	self assert: (patch count: [ :each | each key = #insert ]) = 2.
+ 	self assert: (patch count: [ :each | each key = #remove ]) = 2.
+ 	patch do: [ :each | 
+ 		each key = #match 
+ 			ifTrue: [ self assert: ('cd' includes: each value first) ]
+ 			ifFalse: [ self assert: ('ab' includes: each value first) ] ]!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testMergeIntoUnmodifiedImage (in category 'tests') -----
+ testMergeIntoUnmodifiedImage
+ 	| base revA |
+ 
+ 	base := self snapshot.
+ 	self change: #a toReturn: 'a1'.
+ 	revA := self snapshot.
+ 	
+ 	self load: base.
+ 
+ 	self merge: revA.
+ 
+ 	self assert: (workingCopy ancestors size = 1)
+ 	!

Item was added:
+ ----- Method: MirrorPrimitiveTests>>testMirrorClass (in category 'tests') -----
+ testMirrorClass
+ 	| stackpBefore stackpAfter |
+ 	stackpBefore := thisContext stackPtr.
+ 	self assert: (thisContext objectClass: Array new) = Array.
+ 	self assert: (thisContext objectClass: 1) = 1 class.
+ 	self assert: (thisContext objectClass: ProtoObject new) = ProtoObject.
+ 	stackpAfter := thisContext stackPtr.
+ 	self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"!

Item was added:
+ ----- Method: MCStWriterTest>>testClassDefinitionB (in category 'testing') -----
+ testClassDefinitionB
+ 	writer visitClassDefinition: (self mockClassB asClassDefinition).
+ 	self assertContentsOf: stream match: self expectedClassDefinitionB.
+ 	!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testSameSequence (in category 'tests') -----
+ testSameSequence
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a b c) and: #(a b c).
+ 	self assert: patch size = 3.	
+ 	self assert: (patch allSatisfy: [ :each | each key = #match ])!

Item was added:
+ ----- Method: MCWorkingCopyTest>>basicMerge: (in category 'actions') -----
+ basicMerge: aVersion
+ 	aVersion merge!

Item was added:
+ ----- Method: MCSerializationTest>>assertClass:providesServices: (in category 'asserting') -----
+ assertClass: readerClass providesServices: labels
+ 	| services suffix |
+ 	suffix := readerClass extension.
+ 	self assert: (FileList isReaderNamedRegistered: readerClass name).
+ 	services := readerClass fileReaderServicesForFile: 'foo' suffix: suffix.
+ 	self assert: ((services collect: [:service | service buttonLabel]) includesAllOf: labels)!

Item was added:
+ ----- Method: ClosureCompilerTest>>testBlockNumbering (in category 'tests') -----
+ testBlockNumbering
+ 	"Test that the compiler and CompiledMethod agree on the block numbering of a substantial doit."
+ 	"self new testBlockNumbering"
+ 	| methodNode method tempRefs |
+ 	methodNode :=
+ 		Parser new
+ 			encoderClass: EncoderForV3PlusClosures;
+ 			parse: 'foo
+ 					| numCopiedValuesCounts |
+ 					numCopiedValuesCounts := Dictionary new.
+ 					0 to: 32 do: [:i| numCopiedValuesCounts at: i put: 0].
+ 					Transcript clear.
+ 					Smalltalk allClasses remove: GeniePlugin; do:
+ 						[:c|
+ 						{c. c class} do:
+ 							[:b|
+ 							Transcript nextPut: b name first; endEntry.
+ 							b selectorsAndMethodsDo:
+ 								[:s :m| | pn |
+ 								m isQuick not ifTrue:
+ 									[pn := b parserClass new
+ 												encoderClass: EncoderForV3PlusClosures;
+ 												parse: (b sourceCodeAt: s)
+ 												class: b.
+ 									 pn generate.
+ 									 [pn accept: nil]
+ 										on: MessageNotUnderstood
+ 										do: [:ex| | msg numCopied |
+ 											msg := ex message.
+ 											(msg selector == #visitBlockNode:
+ 											 and: [(msg argument instVarNamed: ''optimized'') not]) ifTrue:
+ 												[numCopied := (msg argument computeCopiedValues: pn) size.
+ 												 numCopiedValuesCounts
+ 													at: numCopied
+ 													put: (numCopiedValuesCounts at: numCopied) + 1].
+ 											msg setSelector: #==.
+ 											ex resume: nil]]]]].
+ 					numCopiedValuesCounts'
+ 			class: Object.
+ 	method := methodNode generate.
+ 	tempRefs := methodNode encoder blockExtentsToTempsMap.
+ 	self assert: tempRefs keys asSet = method startpcsToBlockExtents values asSet!

Item was added:
+ ----- Method: MCTestCase>>mockClassA (in category 'mocks') -----
+ mockClassA
+ 	^ Smalltalk at: #MCMockClassA!

Item was added:
+ ----- Method: FileDirectoryTest>>tearDown (in category 'resources') -----
+ tearDown
+ 
+ 	[ self deleteDirectory ] on: Error do: [ :ex | ]!

Item was added:
+ TestCase subclass: #CompilerExceptionsTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!

Item was added:
+ ----- Method: MCTestCase>>mockVersionInfo (in category 'mocks') -----
+ mockVersionInfo
+ 	^ self treeFrom: #(d ((b ((a))) (c)))!

Item was added:
+ ----- Method: MCTestCase>>mockSnapshot (in category 'mocks') -----
+ mockSnapshot
+ 	^ MCSnapshotResource current snapshot!

Item was added:
+ ----- Method: ObjectFinalizerTests>>testFinalization (in category 'tests') -----
+ testFinalization
+ 	"self run: #testFinalization"
+ 	
+ 	| repetitions |
+ 	repetitions := 100.
+ 	1 to: repetitions
+ 		do: [:i | 
+ 			log addLast: 'o' , i asString , ' created'.
+ 			Object new
+ 				toFinalizeSend: #finalize:
+ 				to: self
+ 				with: 'o' , i asString].
+ 	Smalltalk garbageCollect.
+ 	self finalizationRegistry finalizeValues.
+ 	1 to: repetitions
+ 		do: [:i | 
+ 			self assert: (log includes: 'o' , i asString , ' created').
+ 			self assert: (log includes: 'o' , i asString , ' finalized')]!

Item was added:
+ MCTestCase subclass: #MCSerializationTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: StandardSystemFontsTest>>assert:familyName:pointSize: (in category 'utilities') -----
+ assert: selector familyName: aString pointSize: anInteger
+ 	| font |
+ 	font := Preferences perform: selector.
+ 	self assert: aString equals: font familyName.
+ 	self assert: anInteger equals: font pointSize!

Item was added:
+ ----- Method: MCTestCase>>mockClass:super: (in category 'mocks') -----
+ mockClass: className super: superclassName
+ 	^ MCClassDefinition
+ 		name:  className
+ 		superclassName:  superclassName
+ 		category: self mockCategoryName
+ 		instVarNames: #()
+ 		classVarNames: #()
+ 		poolDictionaryNames: #()
+ 		classInstVarNames: #()
+ 		type: #normal
+ 		comment: (self commentForClass: className)
+ 		commentStamp: (self commentStampForClass: className)!

Item was added:
+ ----- Method: MCTestCase>>commentStampForClass: (in category 'mocks') -----
+ commentStampForClass: name
+ 	^ 'tester-', name,  ' 1/1/2000 00:00'!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryDirectoryEntry (in category 'as yet unclassified') -----
+ testFileDirectoryDirectoryEntry
+ 	"Hoping that you have 'C:' of course..."
+ 	| fd |
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	fd := FileDirectory on: 'C:'.
+ 	self assert: fd directoryEntry notNil.!

Item was added:
+ ----- Method: ExceptionTester>>simpleEnsureTestWithUparrowResults (in category 'results') -----
+ simpleEnsureTestWithUparrowResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ "		add: self doSomethingElseString;"
+ 		add: self doYetAnotherThingString;
+ 		yourself!

Item was added:
+ ----- Method: MCVersionTest>>assert:orders:as:unresolved: (in category 'asserting') -----
+ assert: aSelector orders: sexpr as: expected unresolved: unresolved
+ 	| missing |
+ 	missing := OrderedCollection new.
+ 	version := self versionFromTree: sexpr.
+ 	version 
+ 		perform: aSelector 
+ 		with: [:ea | visited add: ea info name]
+ 		with: [:ea | missing add: ea name].
+ 	self assert: visited asArray = expected.
+ 	self assert: missing asArray = unresolved.!

Item was added:
+ ----- Method: MCStReaderTest>>commentWithoutStyle (in category 'as yet unclassified') -----
+ commentWithoutStyle
+ 	^ '
+ CharacterScanner subclass: #CanvasCharacterScanner
+ 	instanceVariableNames: ''canvas fillBlt foregroundColor runX lineY ''
+ 	classVariableNames: ''''
+ 	poolDictionaries: ''''
+ 	category: ''Morphic-Support''!!
+ 
+ !!CanvasCharacterScanner commentStamp: ''<historical>'' prior: 0!!
+ A displaying scanner which draws its output to a Morphic canvas.!!
+ 
+ !!CanvasCharacterScanner methodsFor: ''stop conditions'' stamp: ''ar 12/15/2001 23:27''!!
+ setStopConditions
+ 	"Set the font and the stop conditions for the current run."
+ 
+ 	self setFont.
+ 	stopConditions
+ 		at: Space asciiValue + 1
+ 		put: (alignment = Justified ifTrue: [#paddedSpace])!! !!'!

Item was added:
+ ----- Method: MCRepositoryTest>>versionWithSnapshot:name: (in category 'building') -----
+ versionWithSnapshot: aSnapshot name: aString
+ 	| info |
+ 	info := self mockVersionInfo: aString. 
+ 	^ MCVersion 
+ 		package: (MCPackage new name: aString)
+ 		info: info
+ 		snapshot: aSnapshot!

Item was added:
+ ----- 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 added:
+ ----- Method: ExceptionTester>>suiteLog (in category 'accessing') -----
+ suiteLog
+ 
+ 	suiteLog == nil
+ 		ifTrue: [suiteLog := OrderedCollection new].
+ 	^suiteLog!

Item was added:
+ ----- Method: MCClassDefinitionTest>>classAComment (in category 'as yet unclassified') -----
+ classAComment
+ 	^ self class classAComment!

Item was added:
+ ----- Method: MCWorkingCopyTest>>description (in category 'accessing') -----
+ description
+ 	^ self class name!

Item was added:
+ ----- Method: MCMczInstallerTest>>assertVersionInfoPresent (in category 'as yet unclassified') -----
+ assertVersionInfoPresent
+ 	| dict info |
+ 	dict := MczInstaller versionInfo at: self mockPackage name.
+ 	info := expected info.
+ 	self assertDict: dict matchesInfo: info.!

Item was added:
+ MCTestCase subclass: #MCClassDefinitionTest
+ 	instanceVariableNames: 'previousChangeSet'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCMergingTest>>testSimultaneousRemove (in category 'tests') -----
+ testSimultaneousRemove
+ 	self assertMerge: #(a1)
+ 				with: #(a1)
+ 				base: #(a1 b1)
+ 				
+ 				gives: #(a1)
+ 				conflicts: #()!

Item was added:
+ ----- Method: MCDictionaryRepositoryTest>>addVersion: (in category 'as yet unclassified') -----
+ addVersion: aVersion
+ 	dict at: aVersion info put: aVersion!

Item was added:
+ ----- Method: MCWorkingCopyTest>>tearDown (in category 'running') -----
+ tearDown
+ 	workingCopy unregister.
+ 	self restoreMocks.
+ 	self clearPackageCache.
+ 	Utilities setAuthorInitials: savedInitials.!

Item was added:
+ ----- Method: MCMergingTest>>testLocalRemoveRemoteModify (in category 'tests') -----
+ testLocalRemoveRemoteModify
+ 	self assertMerge: #(b1)
+ 				with: #(a1 b1)
+ 				base: #(a2 b1)
+ 				
+ 				gives: #(a1 b1)
+ 				conflicts: #((a1 removed)).
+ 
+ 	self assertMerge: #(b1)
+ 				with: #(a2 b1)
+ 				base: #(a1 b1)
+ 				
+ 				gives: #(a2 b1)
+ 				conflicts: #((a2 removed)).!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testIfSequence6 (in category 'tests') -----
+ testIfSequence6
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a b c d) and: #(d a b c).
+ 	self assert: patch size = 5.	"lcs is abc"
+ 	self assert: (patch count: [ :each | each key = #match ]) = 3.
+ 	self assert: (patch count: [ :each | each key = #insert ]) = 1.
+ 	self assert: (patch count: [ :each | each key = #remove ]) = 1.
+ 	patch do: [ :each | 
+ 		each key = #match 
+ 			ifTrue: [ self assert: ('abc' includes: each value first) ]
+ 			ifFalse: [ self assert: each value first = $d ] ]!

Item was added:
+ ----- Method: MCMergingTest>>testSubtractiveConflictlessMerge (in category 'tests') -----
+ testSubtractiveConflictlessMerge
+ 	self assertMerge: #(a1 b1)
+ 				with: #()
+ 				base: #(a1)
+ 				
+ 				gives: #(b1)
+ 				conflicts: #()!

Item was added:
+ ----- Method: ClosureCompilerTest>>supportTestSourceRangeAccessForDecompiledInjectInto:source: (in category 'tests') -----
+ supportTestSourceRangeAccessForDecompiledInjectInto: method source: source
+ 	"Test debugger source range selection for inject:into:"
+ 	^self
+ 		supportTestSourceRangeAccessForInjectInto: method
+ 		source: source
+ 		selectionSequence: #(	':= t1'
+ 								'do: [:t4 | t3 := t2 value: t3 value: t4]'
+ 								'value: t3 value: t4'
+ 								':= t2 value: t3 value: t4'
+ 								']'
+ 								'value: t3 value: t4'
+ 								':= t2 value: t3 value: t4'
+ 								']'
+ 								'^t3')!

Item was added:
+ ----- Method: FileDirectoryTest>>myDirectory (in category 'resources') -----
+ myDirectory
+ 
+ 	^FileDirectory default directoryNamed: self myLocalDirectoryName!

Item was added:
+ ----- Method: MCWorkingCopyTest>>merge: (in category 'actions') -----
+ merge: aVersion
+ 	[[self basicMerge: aVersion]
+ 		on: MCMergeResolutionRequest do: [:n | n resume: true]]
+ 			on: MCNoChangesException do: [:n | ]!

Item was added:
+ ----- Method: ExceptionTester>>doYetAnotherThing (in category 'pseudo actions') -----
+ doYetAnotherThing
+ 
+ 	self log: self doYetAnotherThingString!

Item was added:
+ TestCase subclass: #MirrorPrimitiveTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!

Item was added:
+ ----- Method: MethodHighlightingTests>>asXML (in category 'tests') -----
+ asXML
+ 	"self new asXML"
+ 	"Convert the master index into external XML representation"
+ 	
+ 	^String streamContents:[:s| | writer |
+ 		writer := self xmlWriter on: s.
+ 		writer xmlDeclaration: '1.0'.
+ 		writer startTag: 'recording'; endTag.
+ 			writer tag: 'creator' pcData: creator.
+ 			writer tag: 'timestamp' pcData: timeStamp.
+ 			writer tag: 'duration' pcData: duration.
+ 			writer startTag: 'tracks'; endTag.
+ 				tracks do:[:tdata|
+ 					writer startTag: 'track'; attribute: 'type' value: tdata value; endTag.
+ 					writer pcData: tdata key.
+ 					writer endTag: 'track'.
+ 				].
+ 			writer endTag: 'tracks'.
+ 		writer endTag: 'recording'.
+ 	].
+ !

Item was added:
+ ----- Method: TextDiffBuilderTest>>patchSequenceFor:and: (in category 'private') -----
+ patchSequenceFor: x and: y
+ 
+ 	^(TextDiffBuilder
+ 		from: (self convertToString: x)
+ 		to:  (self convertToString: y)) buildPatchSequence!

Item was added:
+ ----- Method: MirrorPrimitiveTests>>testMirrorInstVarAt (in category 'tests') -----
+ testMirrorInstVarAt
+ 	| stackpBefore stackpAfter array point |
+ 	stackpBefore := thisContext stackPtr.
+ 	array := { 1. 2. 3 }.
+ 	point := Point x: 1 y: 2.
+ 	self assert: (thisContext object: array instVarAt: 1) = 1.
+ 	self assert: (thisContext object: point instVarAt: 2) = 2.
+ 	thisContext object: array instVarAt: 2 put: #two.
+ 	self assert: array = #(1 #two 3).
+ 	thisContext object: point instVarAt: 1 put: 1/2.
+ 	self assert: point = (Point x: 1 / 2 y: 2).
+ 	stackpAfter := thisContext stackPtr.
+ 	self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments"
+ 	self should: [thisContext object: array instVarAt: 4] raise: Error.
+ 	self should: [thisContext object: point instVarAt: 3] raise: Error!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>protocolsForClass: (in category 'private') -----
+ protocolsForClass: aClass
+ 	| protocols |
+ 	protocols := aClass organization categories.
+ 	protocols size > 1 ifTrue: [protocols := protocols copyWith: '-- all --'].
+ 	^ protocols.!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testDoubleRepeatedMerge (in category 'tests') -----
+ testDoubleRepeatedMerge
+ 	| base motherA1 motherA2 motherB1 motherB2 inst |
+ 
+ 	base := self snapshot.
+ 	self change: #a toReturn: 'a1'.
+ 	motherA1 :=  self snapshot.
+ 	self change: #c toReturn: 'c1'.
+ 	motherA2 :=  self snapshot.	
+ 	
+ 	self load: base.
+ 	self change: #b toReturn: 'b1'.
+ 	motherB1 :=  self snapshot.
+ 	self change: #d toReturn: 'd1'.
+ 	motherB2 :=  self snapshot.
+ 	
+ 	self load: base.
+ 	self merge: motherA1.
+ 	self merge: motherB1.
+ 	self change: #a toReturn: 'a2'.
+ 	self change: #b toReturn: 'b2'.
+ 	self snapshot.
+ 
+ 	self shouldnt: [self merge: motherA2] raise: Error.
+ 	self shouldnt: [self merge: motherB2] raise: Error.
+ 	
+ 	inst := self mockInstanceA.
+ 	self assert: inst a = 'a2'.
+ 	self assert: inst b = 'b2'.
+ 	self assert: inst c = 'c1'.
+ 	self assert: inst d = 'd1'.
+ 	!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>assertButtonOn: (in category 'asserting') -----
+ assertButtonOn: aString
+ 	self assert: (self findButtonWithLabel: aString) getModelState.
+ 	!

Item was added:
+ ----- Method: MCTestCase>>mockOverrideMethodCategory (in category 'mocks') -----
+ mockOverrideMethodCategory
+ 	^ self mockExtensionMethodCategory, '-override'!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testRepeatedMerge (in category 'tests') -----
+ testRepeatedMerge
+ 	| base mother1 mother2 inst |
+ 
+ 	base :=  self snapshot.
+ 	self change: #one toReturn: 2.
+ 	mother1 :=  self snapshot.
+ 	self change: #two toReturn: 3.
+ 	mother2 :=  self snapshot.	
+ 	
+ 	self load: base.
+ 	self change: #truth toReturn: false.
+ 	self snapshot.
+ 
+ 	inst := self mockInstanceA.
+ 	self assert: inst one = 1.
+ 	self assert: inst two = 2.	
+ 
+ 	self merge: mother1.
+ 	self assert: inst one = 2.
+ 	self assert: inst two = 2.	
+ 	
+ 	self change: #one toReturn: 7.
+ 	self assert: inst one = 7.
+ 	self assert: inst two = 2.
+ 	
+ 	self shouldnt: [self merge: mother2] raise: Error.
+ 	self assert: inst one = 7.
+ 	self assert: inst two = 3.!

Item was added:
+ ----- Method: StandardSourceFileArrayTest>>testChangesFileAddressRange (in category 'testing') -----
+ testChangesFileAddressRange
+ 	"Test file position to source pointer address translation for the changes file"
+ 	
+ 	| sf a |
+ 	sf := StandardSourceFileArray new.
+ 	(0 to: 16r1FFFFFF by: 811) do: [:e | | a2 i p |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		i := sf fileIndexFromSourcePointer: a.
+ 		self assert: i == 2.
+ 		p := sf filePositionFromSourcePointer: a.
+ 		self assert: p = e.
+ 		a2 := sf sourcePointerFromFileIndex: 2 andPosition: p.
+ 		self assert: a2 = a].
+ 	(0 to: 16rFFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16r2000000 and: 16r2FFFFFF)].
+ 	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16r4000000 and: 16r4FFFFFF)]
+ 
+ 
+ !

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>classAComment (in category 'private') -----
+ classAComment
+ 	^ self mockClassA organization classComment.!

Item was added:
+ ----- Method: ProcessTerminateBug>>testUnwindFromActiveProcess (in category 'tests') -----
+ testUnwindFromActiveProcess
+ 	| sema process |
+ 	sema := Semaphore forMutualExclusion.
+ 	self assert:(sema isSignaled).
+ 	process := [
+ 		sema critical:[
+ 			self deny: sema isSignaled.
+ 			Processor activeProcess terminate.
+ 		]
+ 	] forkAt: Processor userInterruptPriority.
+ 	self assert: sema isSignaled.!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesMAtoMM (in category 'tests') -----
+ testDecompilerInClassesMAtoMM
+ 	self decompileClassesSelect: [:cn| cn first = $M and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: EventManagerTest>>testNoArgumentEvent (in category 'running-dependent action') -----
+ testNoArgumentEvent
+ 
+ 	eventSource when: #anEvent send: #heardEvent to: self.
+ 	eventSource triggerEvent: #anEvent.
+ 	self should: [succeeded]!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testMergeIntoImageWithNoChanges (in category 'tests') -----
+ testMergeIntoImageWithNoChanges
+ 	| base revB revA1 |
+ 
+ 	self change: #a toReturn: 'a'.
+ 	base := self snapshot.
+ 	self change: #b toReturn: 'b'.
+ 	revB := self snapshot.
+ 	
+ 	self load: base.
+ 	self change: #a toReturn: 'a1'.
+ 	revA1 := self snapshot.
+ 
+ 	self change: #a toReturn: 'a'.
+ 	self snapshot.
+ 	self merge: revB.
+ 
+ 	self assert: (workingCopy ancestors size = 2)
+ 	!

Item was added:
+ ----- Method: MCSortingTest>>sortKeyFor: (in category 'building') -----
+ sortKeyFor: aDefinition
+ 	^ String streamContents:
+ 		[:s |
+ 		aDefinition description
+ 			do: [:ea | s nextPutAll: ea asString]
+ 			separatedBy: [s nextPut: $.]]!

Item was added:
+ ----- Method: MCMethodDefinitionTest>>testCannotLoad (in category 'testing') -----
+ testCannotLoad
+ 	| definition |
+ 	definition := self mockMethod: #kjahs87 class: 'NoSuchClass' source: 'kjahs87 ^self' meta: false.
+ 	self should: [definition load] raise: Error.
+ 	self assert: (navigation allImplementorsOf: #kjahs87) isEmpty!

Item was added:
+ ----- Method: MCSortingTest>>classNamed: (in category 'building') -----
+ classNamed: aSymbol
+ 	^ MCClassDefinition
+ 		name: aSymbol
+ 		superclassName: #Object
+ 		category: ''
+ 		instVarNames: #()
+ 		comment: ''!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesZAtoZM (in category 'tests') -----
+ testDecompilerInClassesZAtoZM
+ 	self decompileClassesSelect: [:cn| cn first = $Z and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCStWriterTest>>setUp (in category 'testing') -----
+ setUp
+ 	stream := RWBinaryOrTextStream on: String new.
+ 	writer := MCStWriter on: stream.
+ !

Item was added:
+ ----- 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 added:
+ ----- Method: MCSnapshotBrowserTest>>testMethodIsCleared (in category 'testing') -----
+ testMethodIsCleared
+ 	self clickOnListItem: self mockCategoryName.
+ 	self clickOnListItem: 'MCMockClassA'.
+ 	self clickOnListItem: 'boolean'.
+ 	self clickOnListItem: 'falsehood'.
+ 	self clickOnListItem: '-- all --'.
+ 	
+ 	self denyAListHasSelection: 'falsehood'.!

Item was added:
+ ----- Method: MCMethodDefinitionTest>>testComparison (in category 'testing') -----
+ testComparison
+ 	|d1 d2 d3 d4 d5 |
+ 	d1 := self mockMethod: #one class: 'A' source: '1' meta: false.
+ 	d2 := self mockMethod: #one class: 'A' source: '2' meta: false.
+ 	d3 := self mockMethod: #one class: 'A' source: '1' meta: true.
+ 	d4 := self mockMethod: #two class: 'A' source: '1' meta: false.
+ 	d5 := self mockMethod: #two class: 'A' source: '1' meta: false.
+ 	
+ 	self assert: (d1 isRevisionOf: d2).
+ 	self deny: (d1 isSameRevisionAs: d2).
+ 	
+ 	self deny: (d1 isRevisionOf: d3).
+ 	self deny: (d1 isRevisionOf: d4).
+ 	
+ 	self assert: (d4 isSameRevisionAs: d5).!

Item was added:
+ MCTestCase subclass: #MCChangeNotificationTest
+ 	instanceVariableNames: 'workingCopy'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ TestCase subclass: #ObjectFinalizerTests
+ 	instanceVariableNames: 'log'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Finalization'!

Item was added:
+ ----- Method: MCOrganizationTest>>testReorderingWithNoCategoriesInVersion (in category 'as yet unclassified') -----
+ testReorderingWithNoCategoriesInVersion
+ 	|dec cats newCats |
+ 	dec := MCOrganizationDefinition categories: #().
+ 	cats := #(X Y B Z C A Q).
+ 	newCats := dec reorderCategories: cats original: #().
+ 	self assert: newCats asArray = cats.!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleEnsureTestWithUparrow (in category 'testing-ExceptionTester') -----
+ testSimpleEnsureTestWithUparrow
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithUparrow ) !

Item was added:
+ ----- Method: ExceptionTester>>doubleResumeTest (in category 'tests') -----
+ doubleResumeTest
+ 
+        [self doSomething.
+        MyResumableTestError signal.
+        self doSomethingElse.
+        MyResumableTestError signal.
+        self doYetAnotherThing]
+                on: MyResumableTestError
+                do: [:ex | ex resume].!

Item was added:
+ ----- Method: MCAncestryTest>>twoPersonTree (in category 'building') -----
+ twoPersonTree
+ 	^ self treeFrom:
+ 		#(c1
+ 			((a4
+ 				((a1)
+ 				(b3
+ 					((b2
+ 						((a1)))))))
+ 			(b5
+ 				((b2
+ 					((a1)))))))!

Item was added:
+ ----- Method: MCRepositoryTest>>assertVersionInfos: (in category 'asserting') -----
+ assertVersionInfos: aCollection
+ 	self assert: repository allVersionInfos asSet = aCollection asSet!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesFAtoFM (in category 'tests') -----
+ testDecompilerInClassesFAtoFM
+ 	self decompileClassesSelect: [:cn| cn first = $F and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: ExceptionTester>>logTest: (in category 'logging') -----
+ logTest: aSelector
+ 
+ 	self suiteLog add: aSelector!

Item was added:
+ ----- Method: MCClassDefinitionTest>>creationMessage (in category 'as yet unclassified') -----
+ creationMessage
+ 	^ MessageSend
+ 		receiver: MCClassDefinition
+ 		selector: #name:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp:!

Item was added:
+ ----- Method: StandardSourceFileArrayTest>>testAddressRange (in category 'testing') -----
+ testAddressRange
+ 	"Test source pointer to file position address translation across the full address range"
+ 	
+ 	| sf |
+ 	sf := StandardSourceFileArray new.
+ 	(16r1000000 to: 16r4FFFFFF by: 811) do: [:e | | i a p |
+ 		i := sf fileIndexFromSourcePointer: e.
+ 		p := sf filePositionFromSourcePointer: e.
+ 		a := sf sourcePointerFromFileIndex: i andPosition: p.
+ 		self assert: a = e]
+ !

Item was added:
+ ----- Method: ExceptionTester>>doubleOuterPassTest (in category 'signaledException tests') -----
+ doubleOuterPassTest
+ 	"uses #resume"
+ 
+ 	[[[self doSomething.
+ 	MyTestNotification signal.
+ 	self doSomethingExceptional]
+ 		on: MyTestNotification
+ 		do: [:ex | ex outer.
+ 			self doSomethingElse]]
+ 			on: MyTestNotification
+ 			do: [:ex | ex pass.
+ 				self doSomethingExceptional]]
+ 				on: MyTestNotification
+ 				do: [:ex | self doYetAnotherThing. ex resume]!

Item was added:
+ MCTestCase subclass: #MCFileInTest
+ 	instanceVariableNames: 'stream expected diff'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ MCTestCase subclass: #MCWorkingCopyTest
+ 	instanceVariableNames: 'savedInitials workingCopy repositoryGroup versions versions2'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesSAtoSM (in category 'tests') -----
+ testDecompilerInClassesSAtoSM
+ 	self decompileClassesSelect: [:cn| cn first = $S and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>listMorphs (in category 'morphic') -----
+ listMorphs
+ 	^ self morphsOfClass: PluggableListMorph!

Item was added:
+ TestCase subclass: #ExceptionTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Exceptions'!

Item was added:
+ ----- Method: EventManagerTest>>testReturnValueWithNoListeners (in category 'running-dependent value') -----
+ testReturnValueWithNoListeners
+ 
+ 	| value |
+ 	value := eventSource triggerEvent: #needsValue.
+ 	self should: [value == nil]!

Item was added:
+ ----- Method: MCRepositoryTest>>testLoadMissingNode (in category 'tests') -----
+ testLoadMissingNode
+ 	| node |
+ 	node := MCVersionInfo new.
+ 	self assertMissing: node!

Item was added:
+ ----- Method: MCMergingTest>>handleConflict: (in category 'emulating') -----
+ handleConflict: aConflict	
+ 	|l r|
+ 	l := #removed.
+ 	r := #removed.
+ 	aConflict localDefinition ifNotNil: [:d | l := d token].
+ 	aConflict remoteDefinition ifNotNil: [:d | r := d token].	
+ 	conflicts := conflicts copyWith: (Array with: r with: l).
+ 	(l = #removed or: [r = #removed])
+ 		ifTrue: [aConflict chooseRemote]
+ 		ifFalse:
+ 			[l > r
+ 				ifTrue: [aConflict chooseLocal]
+ 				ifFalse: [aConflict chooseRemote]]
+ 		!

Item was added:
+ ----- Method: MCStWriterTest>>expectedClassDefinitionB (in category 'data') -----
+ expectedClassDefinitionB
+  ^ '
+ MCMock subclass: #MCMockClassB
+ 	instanceVariableNames: ''ivarb''
+ 	classVariableNames: ''CVar''
+ 	poolDictionaries: ''MCMockAPoolDictionary''
+ 	category: ''Monticello-Mocks''!!
+ 
+ MCMockClassB class
+ 	instanceVariableNames: ''ciVar''!!
+ 
+ !!MCMockClassB commentStamp: '''' prior: 0!!
+ This comment has a bang!!!! Bang!!!! Bang!!!!!!
+ '!

Item was added:
+ ----- Method: CompilerExceptionsTest>>selectionInterval (in category 'emulating') -----
+ selectionInterval
+ 	^ 1 to: 0!

Item was added:
+ ----- Method: MCScannerTest>>test3 (in category 'tests') -----
+ test3
+ 	self assert: (MCScanner scan: '(a #b c)' readStream) = #(a #b c)!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>assertAListMatches: (in category 'asserting') -----
+ assertAListMatches: strings
+ 	| listMorphs |
+ 	listMorphs := self listMorphs.
+ 	listMorphs 
+ 		detect: [:m | | list |
+ 			list := m getList. (list size = strings size) and: [list includesAllOf: strings]]
+ 		ifNone: [self assert: false].!

Item was added:
+ ----- Method: ClosureCompilerTest>>supportTestSourceRangeAccessForInjectInto:source: (in category 'tests') -----
+ supportTestSourceRangeAccessForInjectInto: method source: source
+ 	"Test debugger source range selection for inject:into:"
+ 	^self
+ 		supportTestSourceRangeAccessForInjectInto: method
+ 		source: source
+ 		selectionSequence: #(	':= thisValue'
+ 								'do: [:each | nextValue := binaryBlock value: nextValue value: each]'
+ 								'value: nextValue value: each'
+ 								':= binaryBlock value: nextValue value: each'
+ 								'nextValue := binaryBlock value: nextValue value: each'
+ 								'value: nextValue value: each'
+ 								':= binaryBlock value: nextValue value: each'
+ 								'nextValue := binaryBlock value: nextValue value: each'
+ 								'^nextValue')!

Item was added:
+ MCTestCase subclass: #MCMczInstallerTest
+ 	instanceVariableNames: 'expected diff'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: ArrayLiteralTest>>testReservedIdentifiers (in category 'tests') -----
+ testReservedIdentifiers
+ 	self class compile: 'array ^ #(nil true false)'.
+ 	self assert: self array = {nil. true. false}.!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testProtocolIsCleared (in category 'testing') -----
+ testProtocolIsCleared
+ 	self clickOnListItem: self mockCategoryName.
+ 	self clickOnListItem: 'MCMockASubclass'.
+ 	self clickOnListItem: 'as yet unclassified'.
+ 	self clickOnListItem: 'MCMockClassA'.
+ 	
+ 	self denyAListHasSelection: 'as yet unclassified'.!

Item was added:
+ ----- Method: MCMethodDefinitionTest>>testRevertOldMethod (in category 'testing') -----
+ testRevertOldMethod
+ 	| definition changeRecord |
+ 	Object compile: 'yourself ^ self' classified: MCMockPackageInfo new methodCategoryPrefix.
+ 	definition := (MethodReference class: Object selector: #yourself) asMethodDefinition.
+ 	changeRecord := definition scanForPreviousVersion.
+ 	self assert: changeRecord notNil.
+ 	self assert: changeRecord category = 'accessing'.
+ 	changeRecord fileIn.!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesLAtoLM (in category 'tests') -----
+ testDecompilerInClassesLAtoLM
+ 	self decompileClassesSelect: [:cn| cn first = $L and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: ExceptionTester>>doSomethingElse (in category 'pseudo actions') -----
+ doSomethingElse
+ 
+ 	self log: self doSomethingElseString!

Item was added:
+ ----- Method: MCMczInstallerTest>>tearDown (in category 'as yet unclassified') -----
+ tearDown
+ 	expected snapshot updatePackage: self mockPackage.
+ 	self deleteFile.!

Item was added:
+ ----- Method: MCSortingTest>>sortDefinitions: (in category 'actions') -----
+ sortDefinitions: aCollection
+ 	^ aCollection asSortedCollection asArray!

Item was added:
+ ----- Method: MCTestCase>>treeFrom: (in category 'mocks') -----
+ treeFrom: anArray
+ 	| name id |
+ 	name := anArray first.
+ 	id := '00000000-0000-0000-0000-0000000000', (name asString size = 1 ifTrue: [name asString, '0'] ifFalse: [name asString]).
+ 	^ MCVersionInfo
+ 		name: name
+ 		id: (UUID fromString: id)
+ 		message: ''
+ 		date: nil
+ 		time: nil
+ 		author: ''
+ 		ancestors: (anArray size > 1 ifTrue: [(anArray second collect: [:ea | self treeFrom: ea])] ifFalse: [#()])!

Item was added:
+ ----- 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 added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesXNtoXZ (in category 'tests') -----
+ testDecompilerInClassesXNtoXZ
+ 	self decompileClassesSelect: [:cn| cn first = $X and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MethodHighlightingTests>>testMethodHighlighting (in category 'tests') -----
+ testMethodHighlighting
+ 	| map before after method retpc |
+ 	"Test the highlighting of the asXML method.  Test the highlighting of the return
+ 	 statement which should include the whole block supplied to streamContents:."
+ 	"DebuggerMethodMap voidMapCache"
+ 	"DebuggerMethodMap forMethod: MethodHighlightingTests >> #asXML"
+ 	method := MethodHighlightingTests >> #asXML.
+ 	map := DebuggerMethodMap forMethod: method.
+ 	retpc := method endPC.
+ 	before := map rangeForPC: retpc contextIsActiveContext: false.
+ 	map instVarNamed: 'abstractSourceRanges' put: nil.
+ 	after := map rangeForPC: retpc contextIsActiveContext: false.
+ 	self assert: before size > 500.
+ 	self assert: before = after!

Item was added:
+ ----- 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 added:
+ ----- Method: MCFileInTest>>alterInitialState (in category 'testing') -----
+ alterInitialState
+ 	self mockClassA touchCVar!

Item was added:
+ MCTestCase subclass: #MCMergingTest
+ 	instanceVariableNames: 'conflictBlock conflicts'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCAncestryTest>>assertCommonAncestorOf:and:in:in: (in category 'asserting') -----
+ assertCommonAncestorOf: leftName and: rightName in: options in: tree
+ 	| left right ancestor |
+ 	left := self versionForName: leftName in: tree.
+ 	right := self versionForName: rightName in: tree.
+ 	
+ 	ancestor := left commonAncestorWith: right.
+ 	
+ 	self assert: (options includes: ancestor name)!

Item was added:
+ ----- Method: MCOrganizationTest>>testReordering (in category 'as yet unclassified') -----
+ testReordering
+ 	|dec cats newCats |
+ 	dec := MCOrganizationDefinition categories: #(A B C).
+ 	cats := #(X Y B Z C A Q).
+ 	newCats := dec reorderCategories: cats original: #(B C A).
+ 	self assert: newCats asArray = #(X Y A B C Z Q).!

Item was added:
+ ----- Method: MCMczInstallerTest>>testInstallFromStream (in category 'as yet unclassified') -----
+ testInstallFromStream
+ 	| stream |
+ 	stream := RWBinaryOrTextStream on: String new.
+ 	MCMczWriter fileOut: expected on: stream.
+ 	MczInstaller installStream: stream reset.
+ 	self assertNoChange.
+ 	self assertVersionInfoPresent.
+ 	!

Item was added:
+ ----- Method: TextDiffBuilderTest>>convertToString: (in category 'private') -----
+ convertToString: array
+ 
+ 	^String streamContents: [ :stream |
+ 		array do: [ :each |
+ 			stream nextPutAll: each asString; cr ] ]!

Item was added:
+ ----- Method: MCMczInstallerTest>>assertDict:matchesInfo: (in category 'as yet unclassified') -----
+ assertDict: dict matchesInfo: info
+ 	#(name id message date time author)
+ 		do: [:sel |  (info perform: sel) ifNotNil: [:i | dict at: sel ifPresent: [:d | self assert: i = d]]].
+ 	info ancestors 
+ 			with: (dict at: #ancestors) 
+ 			do: [:i :d | self assertDict: d matchesInfo: i]!

Item was added:
+ ----- Method: ClosureCompilerTest>>closureCases (in category 'source') -----
+ closureCases
+ 	^#(
+ '| n |
+ n := 1.
+ ^n + n'
+ 
+ '| i |
+ i := 0.
+ [i := i + 1.
+  i <= 10] whileTrue.
+ ^i'
+ 
+ '[:c :s| | mn |
+ mn := Compiler new
+ 		compile: (c sourceCodeAt: s)
+ 		in: c
+ 		notifying: nil
+ 		ifFail: [self halt].
+ mn generate: #(0 0 0 0).
+ {mn blockExtentsToTempsMap.
+   mn encoder schematicTempNames}]
+ 			value: AbstractInstructionTests
+ 			value: #runBinaryConditionalJumps:'
+ 
+ 'inject: thisValue into: binaryBlock
+ 	| nextValue |
+ 	nextValue := thisValue.
+ 	self do: [:each | nextValue := binaryBlock value: nextValue value: each].
+ 	^nextValue'
+ 
+ 'runBinaryConditionalJumps: assertPrintBar
+ 	"CogIA32CompilerTests new runBinaryConditionalJumps: false"
+ 	| mask reg1 reg2 reg3 |
+ 	mask := 1 << self processor bitsInWord - 1.
+ 	self concreteCompilerClass dataRegistersWithAccessorsDo:
+ 		[:n :get :set|
+ 		n = 0 ifTrue: [reg1 := get].
+ 		n = 1 ifTrue: [reg2 := set].
+ 		n = 2 ifTrue: [reg3 := set]].
+ 	#(	(JumpAbove > unsigned)			(JumpBelowOrEqual <= unsigned)
+ 		(JumpBelow < unsigned)			(JumpAboveOrEqual >= unsigned)
+ 		(JumpGreater > signed)			(JumpLessOrEqual <= signed)
+ 		(JumpLess < signed)				(JumpGreaterOrEqual >= signed)
+ 		(JumpZero = signed)				(JumpNonZero ~= signed)) do:
+ 		[:triple|
+ 		[:opName :relation :signednessOrResult| | opcode jumpNotTaken jumpTaken nop memory bogus |
+ 		self resetGen.
+ 		opcode := CogRTLOpcodes classPool at: opName.
+ 		self gen: CmpRR operand: 2 operand: 1.
+ 		jumpTaken := self gen: opcode.
+ 		self gen: MoveCqR operand: 0 operand: 0.
+ 		jumpNotTaken := self gen: Jump.
+ 		jumpTaken jmpTarget: (self gen: MoveCqR operand: 1 operand: 0).
+ 		jumpNotTaken jmpTarget: (nop := self gen: Nop).
+ 		memory := self generateInstructions.
+ 		bogus := false.
+ 		self pairs: (-2 to: 2)  do:
+ 			[:a :b| | taken |
+ 			self processor
+ 				reset;
+ 				perform: reg2 with: a signedIntToLong;
+ 				perform: reg3 with: b signedIntToLong.
+ 			[self processor singleStepIn: memory.
+ 			 self processor pc ~= nop address] whileTrue.
+ 			taken := (self processor perform: reg1) = 1.
+ 			assertPrintBar
+ 				ifTrue:
+ 					[self assert: taken = (signednessOrResult == #unsigned
+ 											ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)]
+ 											ifFalse: [a perform: relation with: b])]
+ 				ifFalse:
+ 					[Transcript
+ 						nextPutAll: reg2; nextPut: $(; print: a; nextPutAll: '') ''; nextPutAll: relation; space;
+ 						nextPutAll: reg3; nextPut: $(; print: b; nextPutAll: '') = '';
+ 						print: taken; cr; flush.
+ 					 taken = (signednessOrResult == #unsigned
+ 											ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)]
+ 											ifFalse: [a perform: relation with: b]) ifFalse:
+ 						[bogus := true]]].
+ 			 bogus ifTrue:
+ 				[self processor printRegistersOn: Transcript.
+ 				 Transcript show: (self processor disassembleInstructionAt: jumpTaken address In: memory); cr]]
+ 					valueWithArguments: triple]'
+ 
+ 'mapFromBlockStartsIn: aMethod toTempVarsFrom: schematicTempNamesString constructor: aDecompilerConstructor
+ 	| map |
+ 	map := aMethod
+ 				mapFromBlockKeys: aMethod startpcsToBlockExtents keys asSortedCollection
+ 				toSchematicTemps: schematicTempNamesString.
+ 	map keysAndValuesDo:
+ 		[:startpc :tempNameTupleVector| | subMap tempVector numTemps |
+ 		subMap := Dictionary new.
+ 		"Find how many temp slots there are (direct & indirect temp vectors)
+ 		 and for each indirect temp vector find how big it is."
+ 		tempNameTupleVector do:
+ 			[:tuple|
+ 			tuple last isArray
+ 				ifTrue:
+ 					[subMap at: tuple last first put: tuple last last.
+ 					 numTemps := tuple last first]
+ 				ifFalse:
+ 					[numTemps := tuple last]].
+ 		"create the temp vector for this scope level."
+ 		tempVector := Array new: numTemps.
+ 		"fill it in with any indirect temp vectors"
+ 		subMap keysAndValuesDo:
+ 			[:index :size|
+ 			tempVector at: index put: (Array new: size)].
+ 		"fill it in with temp nodes."
+ 		tempNameTupleVector do:
+ 			[:tuple| | itv |
+ 			tuple last isArray
+ 				ifTrue:
+ 					[itv := tempVector at: tuple last first.
+ 					 itv at: tuple last last
+ 						put: (aDecompilerConstructor
+ 								codeTemp: tuple last last - 1
+ 								named: tuple first)]
+ 				ifFalse:
+ 					[tempVector
+ 						at: tuple last
+ 						put: (aDecompilerConstructor
+ 								codeTemp: tuple last - 1
+ 								named: tuple first)]].
+ 		"replace any indirect temp vectors with proper RemoteTempVectorNodes"
+ 		subMap keysAndValuesDo:
+ 			[:index :size|
+ 			tempVector
+ 				at: index
+ 				put: (aDecompilerConstructor
+ 						codeRemoteTemp: index
+ 						remoteTemps: (tempVector at: index))].
+ 		"and update the entry in the map"
+ 		map at: startpc put: tempVector].
+ 	^map'
+ 
+  'gnuifyFrom: inFileStream to: outFileStream
+ 
+ "convert interp.c to use GNU features"
+ 
+ 	| inData beforeInterpret inInterpret inInterpretVars beforePrimitiveResponse inPrimitiveResponse |
+ 
+ 	inData := inFileStream upToEnd withSqueakLineEndings.
+ 	inFileStream close.
+ 
+ 	"print a header"
+ 	outFileStream
+ 		nextPutAll: ''/* This file has been post-processed for GNU C */'';
+ 		cr; cr; cr.
+ 
+ 	beforeInterpret := true.    "whether we are before the beginning of interpret()"
+ 	inInterpret := false.     "whether we are in the middle of interpret"
+ 	inInterpretVars := false.    "whether we are in the variables of interpret"
+ 	beforePrimitiveResponse := true.  "whether we are before the beginning of primitiveResponse()"
+ 	inPrimitiveResponse := false.   "whether we are inside of primitiveResponse"
+ 	''Gnuifying''
+ 		displayProgressAt: Sensor cursorPoint
+ 		from: 1 to: (inData occurrencesOf: Character cr)
+ 		during:
+ 			[:bar | | lineNumber |
+ 			lineNumber := 0.
+ 			inData linesDo:
+ 				[ :inLine | | outLine extraOutLine caseLabel |
+ 				bar value: (lineNumber := lineNumber + 1).
+ 				outLine := inLine. 	"print out one line for each input line; by default, print out the line that was input, but some rules modify it"
+ 				extraOutLine := nil.   "occasionally print a second output line..."
+ 				beforeInterpret ifTrue: [
+ 					inLine = ''#include "sq.h"'' ifTrue: [
+ 						outLine := ''#include "sqGnu.h"'' ].
+ 					inLine = ''interpret(void) {'' ifTrue: [
+ 						"reached the beginning of interpret"
+ 						beforeInterpret := false.
+ 						inInterpret := true.
+ 						inInterpretVars := true ] ]
+ 				ifFalse: [
+ 				inInterpretVars ifTrue: [
+ 					(inLine findString: ''register struct foo * foo = &fum;'') > 0 ifTrue: [
+ 						outLine := ''register struct foo * foo FOO_REG = &fum;'' ].
+ 					(inLine findString: '' localIP;'') > 0 ifTrue: [
+ 						outLine := ''    char* localIP IP_REG;'' ].
+ 					(inLine findString: '' localFP;'') > 0 ifTrue: [
+ 						outLine := ''    char* localFP FP_REG;'' ].
+ 					(inLine findString: '' localSP;'') > 0 ifTrue: [
+ 						outLine := ''    char* localSP SP_REG;'' ].
+ 					(inLine findString: '' currentBytecode;'') > 0 ifTrue: [
+ 						outLine := ''    sqInt currentBytecode CB_REG;'' ].
+ 					inLine isEmpty ifTrue: [
+ 						"reached end of variables"
+ 						inInterpretVars := false.
+ 						outLine := ''    JUMP_TABLE;''.
+ 						extraOutLine := inLine ] ]
+ 				ifFalse: [
+ 				inInterpret ifTrue: [
+ 					"working inside interpret(); translate the switch statement"
+ 					(inLine beginsWith: ''		case '') ifTrue: [
+ 						caseLabel := (inLine findTokens: ''	 :'') second.
+ 						outLine := ''		CASE('', caseLabel, '')'' ].
+ 					inLine = ''			break;'' ifTrue: [
+ 						outLine := ''			BREAK;'' ].
+ 					inLine = ''}'' ifTrue: [
+ 						"all finished with interpret()"
+ 						inInterpret := false ] ]
+ 				ifFalse: [
+ 				beforePrimitiveResponse ifTrue: [
+ 					(inLine beginsWith: ''primitiveResponse('') ifTrue: [
+ 						"into primitiveResponse we go"
+ 						beforePrimitiveResponse := false.
+ 						inPrimitiveResponse := true.
+ 						extraOutLine := ''    PRIM_TABLE;'' ] ]
+ 				ifFalse: [
+ 				inPrimitiveResponse ifTrue: [
+ 					inLine = ''	switch (primitiveIndex) {'' ifTrue: [
+ 						extraOutLine := outLine.
+ 						outLine := ''	PRIM_DISPATCH;'' ].
+ 					inLine = ''	switch (GIV(primitiveIndex)) {'' ifTrue: [
+ 						extraOutLine := outLine.
+ 						outLine := ''	PRIM_DISPATCH;'' ].
+ 					(inLine beginsWith: ''	case '') ifTrue: [
+ 						caseLabel := (inLine findTokens: ''	 :'') second.
+ 						outLine := ''	CASE('', caseLabel, '')'' ].
+ 					inLine = ''}'' ifTrue: [
+ 						inPrimitiveResponse := false ] ]
+ 				] ] ] ].
+ 
+ 				outFileStream nextPutAll: outLine; cr.
+ 				extraOutLine ifNotNil: [
+ 					outFileStream nextPutAll: extraOutLine; cr ]]].
+ 
+ 	outFileStream close' )!

Item was added:
+ ----- Method: ExceptionTests>>testSimplePass (in category 'testing-ExceptionTester') -----
+ testSimplePass
+ 	self assertSuccess: (ExceptionTester new runTest: #simplePassTest ) !

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>textMorph (in category 'morphic') -----
+ textMorph
+ 	^ (self morphsOfClass: TextMorph) last!

Item was added:
+ ----- 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 added:
+ ----- Method: ExceptionTester>>simpleResignalAsTest (in category 'signaledException tests') -----
+ simpleResignalAsTest
+ 	"ExceptionTester new simpleResignalAsTest"
+ 
+ 	[self doSomething.
+ 	MyTestNotification signal.
+ 	self doSomethingElse]
+ 		on: MyTestNotification
+ 		do:
+ 			[:ex | ex resignalAs: MyTestError new]!

Item was added:
+ ----- Method: ExceptionTester>>resumableFallOffTheEndHandler (in category 'tests') -----
+ resumableFallOffTheEndHandler
+ 
+ 	[self doSomething.
+ 	MyTestNotification signal.
+ 	self doSomethingElse]
+ 		on: MyTestNotification
+ 		do: [:ex | self doSomethingExceptional].
+ 	self doYetAnotherThing!

Item was added:
+ ----- Method: ClosureTests>>testMethodArgument (in category 'testing') -----
+ testMethodArgument
+ 	| temp block |
+ 	temp := 0.
+ 	block := [ [ temp ] ].
+ 	temp := 1.
+ 	block := block value.
+ 	temp := 2.
+ 	self assert: block value = 2!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesQNtoQZ (in category 'tests') -----
+ testDecompilerInClassesQNtoQZ
+ 	self decompileClassesSelect: [:cn| cn first = $Q and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testIfPatchIsMinimal (in category 'tests') -----
+ testIfPatchIsMinimal
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a a a b) and: #(a b a a).
+ 	self assert: patch size = 5.	"lcs is aaa"
+ 	self assert: (patch count: [ :each | each key = #match ]) = 3.
+ 	self assert: (patch count: [ :each | each key = #insert ]) = 1.
+ 	self assert: (patch count: [ :each | each key = #remove ]) = 1.
+ 	patch do: [ :each | 
+ 		each key = #match 
+ 			ifTrue: [ self assert: each value first = $a ]
+ 			ifFalse: [ self assert: each value first = $b ] ]!

Item was added:
+ ----- Method: ExceptionTester>>signalFromHandlerActionTestResults (in category 'results') -----
+ signalFromHandlerActionTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doYetAnotherThingString;
+ 		add: 'Unhandled Exception';
+ 		yourself!

Item was added:
+ ----- Method: ExceptionTester>>simpleResignalAsTestResults (in category 'signaledException results') -----
+ simpleResignalAsTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: 'Unhandled Exception';
+ 		yourself!

Item was added:
+ ----- Method: StandardSourceFileArrayTest>>testFileIndexFromSourcePointer (in category 'testing') -----
+ testFileIndexFromSourcePointer
+ 	"Test derivation of file index for sources or changes file from source pointers"
+ 
+ 	| sf |
+ 	sf := StandardSourceFileArray new.
+ 	"sources file mapping"
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000000).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000013).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1FFFFFF).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3000000).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3000013).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3FFFFFF).
+ 	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)].
+ 	(16r3000000 to: 16r3FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)].
+ 	"changes file mapping"
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2000000).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2000013).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2FFFFFF).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000000).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000013).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4FFFFFF).
+ 	(16r2000000 to: 16r2FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)].
+ 	(16r4000000 to: 16r4FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)].
+ 	"the following numeric ranges are unused but currently produces results as follows"
+ 	self assert: 0 = (sf fileIndexFromSourcePointer: 16r0000000).
+ 	self assert: 0 = (sf fileIndexFromSourcePointer: 16r0000013).
+ 	self assert: 0 = (sf fileIndexFromSourcePointer: 16r0FFFFFF)
+ 
+ 
+ !

Item was added:
+ ----- Method: CompilerExceptionsTest>>griffle (in category 'as yet unclassified') -----
+ griffle | goo |!

Item was added:
+ ----- Method: ExceptionTester>>methodWithError (in category 'pseudo actions') -----
+ methodWithError
+ 
+ 	MyTestError signal: self testString!

Item was added:
+ ----- Method: MCChangeNotificationTest>>modifiedEventFor:ofClass: (in category 'events') -----
+ modifiedEventFor: aSelector ofClass: aClass
+ 	| method |
+ 	method := aClass compiledMethodAt: aSelector.
+ 	^ ModifiedEvent 
+ 				methodChangedFrom: method
+ 				to: method
+ 				selector: aSelector
+ 				inClass: aClass.
+ !

Item was added:
+ ----- Method: MCMethodDefinitionTest>>override (in category 'mocks') -----
+ override ^ 1!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryNamed (in category 'as yet unclassified') -----
+ testFileDirectoryNamed
+ 	"Hoping that you have 'C:' of course..."
+ 	| fd |
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	fd := FileDirectory root directoryNamed: 'C:'.
+ 	self assert: fd pathName = 'C:'.!

Item was added:
+ ----- Method: MCVersionTest>>testWithAllUnresolved (in category 'tests') -----
+ testWithAllUnresolved
+ 	self 
+ 		assert: #withAllDependenciesDo:ifUnresolved: 
+ 		orders: #(a ((b (d e)) (c missing)))
+ 		as: #(d e b a)
+ 		unresolved: #(c)!

Item was added:
+ ----- Method: ClosureCompilerTest>>testMethodAndNodeTempNames (in category 'tests') -----
+ testMethodAndNodeTempNames
+ 	"self new testMethodAndNodeTempNames"
+ 	"Test that BytecodeAgnosticMethodNode>>blockExtentsToTempRefs answers the same
+ 	 structure as CompiledMethod>>blockExtentsToTempRefs when the method has been
+ 	 copied with the appropriate temps.  This tests whether doit methods are debuggable
+ 	 since they carry their own temps."
+ 	self closureCases do:
+ 		[:source| | mn om m mbe obe |
+ 		mn := source first isLetter
+ 					ifTrue:
+ 						[self class compilerClass new
+ 							compile: source
+ 							in: self class
+ 							notifying: nil
+ 							ifFail: [self error: 'compilation error']]
+ 					ifFalse:
+ 						[self class compilerClass new
+ 							compileNoPattern: source
+ 							in: self class
+ 							context: nil
+ 							notifying: nil
+ 							ifFail: [self error: 'compilation error']].
+ 		m := (om := mn generate) copyWithTempsFromMethodNode: mn.
+ 		self assert: m holdsTempNames.
+ 		self assert: m endPC = om endPC.
+ 		mbe := m blockExtentsToTempsMap.
+ 		obe := mn blockExtentsToTempsMap.
+ 		self assert: mbe keys asSet = obe keys asSet.
+ 		(mbe keys intersection: obe keys) do:
+ 			[:interval|
+ 			self assert: (mbe at: interval) = (obe at: interval)]]!

Item was added:
+ ----- Method: MCVersionTest>>testWithAll (in category 'tests') -----
+ testWithAll
+ 	self 
+ 		assert: #withAllDependenciesDo: 
+ 		orders: #(a ((b (d e)) c)) 
+ 		as: #(d e b c a)!

Item was added:
+ ----- Method: MCVersionTest>>testAllAvailablePostOrder (in category 'tests') -----
+ testAllAvailablePostOrder
+ 	self 
+ 		assert: #allAvailableDependenciesDo: 
+ 		orders: #(a ((b (d e)) c)) 
+ 		as: #(d e b c)!

Item was added:
+ ----- Method: MCStWriterTest>>expectedMethodDefinition (in category 'data') -----
+ expectedMethodDefinition
+ 	^ '
+ !!MCMockClassA methodsFor: ''numeric'' stamp: ''cwp 8/2/2003 17:26''!!
+ one
+ 	^ 1!! !!
+ '!

Item was added:
+ ----- Method: MCMczInstallerTest>>fileName (in category 'as yet unclassified') -----
+ fileName
+ 	^ 'InstallerTest.mcz'!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testSameSequenceWithRepetitions (in category 'tests') -----
+ testSameSequenceWithRepetitions
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a a b a) and: #(a a b a).
+ 	self assert: patch size = 4.	
+ 	self assert: (patch allSatisfy: [ :each | each key = #match ])!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesJNtoJZ (in category 'tests') -----
+ testDecompilerInClassesJNtoJZ
+ 	self decompileClassesSelect: [:cn| cn first = $J and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>setUp (in category 'running') -----
+ setUp
+ 	model := MCSnapshotBrowser forSnapshot: MCSnapshotResource current snapshot.
+ 	morph := model buildWindow.!

Item was added:
+ ----- Method: ClosureTests>>testBlockTemp (in category 'testing') -----
+ testBlockTemp
+ 	| block block1 block2 |
+ 	block := [ :arg | [ arg ] ].
+ 	block1 := block value: 1.
+ 	block2 := block value: 2.
+ 	self assert: block1 value = 1.
+ 	self assert: block2 value = 2!

Item was added:
+ TestCase subclass: #ScannerTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!

Item was added:
+ ----- Method: ExceptionTester>>iterationsBeforeTimeout: (in category 'accessing') -----
+ iterationsBeforeTimeout: anInteger
+ 
+ 	iterationsBeforeTimeout := anInteger!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesWNtoWZ (in category 'tests') -----
+ testDecompilerInClassesWNtoWZ
+ 	self decompileClassesSelect: [:cn| cn first = $W and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCRepositoryTest>>testStoreAndLoad (in category 'tests') -----
+ testStoreAndLoad
+ 	| node node2 |
+ 	node := self saveSnapshot1.
+ 	node2 := self saveSnapshot2.
+ 	self assert: (self snapshotAt: node) = self snapshot1.
+ 	self assert: (self snapshotAt: node2) = self snapshot2.!

Item was added:
+ TestCase subclass: #TextDiffBuilderTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-FilePackage'!

Item was added:
+ ----- Method: ClosureCompilerTest>>testDecompiledDoitMethodTempNames (in category 'tests') -----
+ testDecompiledDoitMethodTempNames
+ 	"self new testDecompiledDoitMethodTempNames"
+ 	"Test that a decompiled doit that has been copied with temps decompiles to the input"
+ 	| removeComments |
+ 	removeComments := [:n| n comment: nil].
+ 	self closureCases do:
+ 		[:source| | mns m mps mnps |
+ 		"Need to compare an ungenerated tree with the generated method's methodNode
+ 		 because generating code alters the tree when it introduces remote temp vectors."
+ 		mns := #(first last) collect:
+ 					[:ignored|
+ 					source first isLetter
+ 						ifTrue:
+ 							[self class compilerClass new
+ 								compile: source
+ 								in: self class
+ 								notifying: nil
+ 								ifFail: [self error: 'compilation error']]
+ 						ifFalse:
+ 							[self class compilerClass new
+ 								compileNoPattern: source
+ 								in: self class
+ 								context: nil
+ 								notifying: nil
+ 								ifFail: [self error: 'compilation error']]].
+ 		m := (mns last generateWithTempNames).
+ 		removeComments value: mns first.
+ 		mns first nodesDo: removeComments.
+ 		self assert: (mnps := mns first printString) = (mps := m methodNode printString)]!

Item was added:
+ ----- Method: MCSerializationTest>>assertDependenciesMatchWith: (in category 'asserting') -----
+ assertDependenciesMatchWith: writerClass
+ 	| stream readerClass expected actual |
+ 	readerClass := writerClass readerClass.
+ 	expected := self mockVersionWithDependencies.
+ 	stream := RWBinaryOrTextStream on: String new.
+ 	writerClass fileOut: expected on: stream.
+ 	actual := (readerClass on: stream reset) dependencies.
+ 	self assert: actual = expected dependencies.!

Item was added:
+ ----- Method: MCStReaderTest>>testMethodWithStyle (in category 'as yet unclassified') -----
+ testMethodWithStyle
+ 	| reader |
+ 	reader := MCStReader on: self methodWithStyle readStream.
+ 	self assert: reader definitions first isMethodDefinition.!

Item was added:
+ ----- Method: ClosureCompilerTest class>>methodWithCopiedTemps (in category 'code examples') -----
+ methodWithCopiedTemps
+ 	| a b c r |
+ 	a := 1.
+ 	b := 2.
+ 	c := 4.
+ 	r := [a + b + c] value.
+ 	b := nil.
+ 	r
+ 
+ 	"Parser new
+ 		parse: (self class sourceCodeAt: #methodWithCopiedTemps)
+ 		class: self class"
+ 
+ 	"(Parser new
+ 		encoderClass: EncoderForV3;
+ 		parse: (self class sourceCodeAt: #methodWithCopiedTemps)
+ 		class: self class) generateUsingClosures: #(0 0 0 0)"!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleRetry (in category 'testing-ExceptionTester') -----
+ testSimpleRetry
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleRetryTest ) !

Item was added:
+ ----- Method: ClosureCompilerTest>>testTempNameAccessForInjectInto (in category 'tests') -----
+ testTempNameAccessForInjectInto
+ 	"self new testTempNameAccessForInjectInto"
+ 	| methodNode method evaluationCount block debuggerMap |
+ 	methodNode := Parser new
+ 						encoderClass: EncoderForV3PlusClosures;
+ 						parse: (Collection sourceCodeAt: #inject:into:)
+ 						class: Collection.
+ 	method := methodNode generate.
+ 	debuggerMap := DebuggerMethodMap forMethod: method methodNode: methodNode.
+ 	evaluationCount := 0.
+ 	block := [:prev :each| | theContext tempNames |
+ 			evaluationCount := evaluationCount + 1.
+ 			theContext := thisContext sender.
+ 			tempNames := debuggerMap tempNamesForContext: theContext.
+ 			self assert: (tempNames hasEqualElements: tempNames).
+ 			#('thisValue' 'each' 'binaryBlock' 'nextValue')
+ 				with: { 0. each. block. prev}
+ 				do: [:tempName :value|
+ 					self assert: (debuggerMap namedTempAt: (tempNames indexOf: tempName) in: theContext) == value.
+ 					tempName ~= 'each' ifTrue:
+ 						[self assert: (debuggerMap namedTempAt: (tempNames indexOf: tempName) in: theContext home) == value]]].
+ 	(1 to: 10) withArgs: { 0. block } executeMethod: method.
+ 	self assert: evaluationCount = 10!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesCNtoCZ (in category 'tests') -----
+ testDecompilerInClassesCNtoCZ
+ 	self decompileClassesSelect: [:cn| cn first = $C and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: ExpandedSourceFileArrayTest>>testSourcesFileAddressRange (in category 'testing') -----
+ testSourcesFileAddressRange
+ 	"Test file position to source pointer address translation for the sources file"
+ 	
+ 	| sf i p a a2 |
+ 	sf := ExpandedSourceFileArray new.
+ 	(0 to: 16r1FFFFFFF by: 4093) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		i := sf fileIndexFromSourcePointer: a.
+ 		self assert: i == 1.
+ 		p := sf filePositionFromSourcePointer: a.
+ 		self assert: p = e.
+ 		a2 := sf sourcePointerFromFileIndex: 1 andPosition: p.
+ 		self assert: a2 = a].
+ 	(0 to: 16rFFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16r1000000 and: 16r1FFFFFF)].
+ 	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16r3000000 and: 16r3FFFFFF)].
+ 
+ 	(16r2000000 to: 16r2FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16r5000000 and: 16r5FFFFFF)].
+ 	(16r3000000 to: 16r3FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16r7000000 and: 16r7FFFFFF)].
+ 	(16r4000000 to: 16r4FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16r9000000 and: 16r9FFFFFF)].
+ 	(16r5000000 to: 16r5FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16rB000000 and: 16rBFFFFFF)].
+ 	(16r6000000 to: 16r6FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16rD000000 and: 16rDFFFFFF)].
+ 	(16r7000000 to: 16r7FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16rF000000 and: 16rFFFFFFF)]
+ !

Item was added:
+ ----- Method: ExceptionTester>>simpleTimeoutWithZeroDurationTest (in category 'tests') -----
+ simpleTimeoutWithZeroDurationTest
+ 
+ 	[ self doSomething ]
+ 		valueWithin: 0 seconds onTimeout:
+ 			[ self doSomethingElse ].
+ 	!

Item was added:
+ ----- 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 added:
+ ----- Method: ExceptionTester>>methodWithNotification (in category 'pseudo actions') -----
+ methodWithNotification
+ 
+ 	MyTestNotification signal: self testString!

Item was added:
+ ----- Method: MirrorPrimitiveTests>>testMirrorEqEq (in category 'tests') -----
+ testMirrorEqEq
+ 	| stackpBefore stackpAfter |
+ 	stackpBefore := thisContext stackPtr.
+ 	self assert: (thisContext object: Array new eqeq: Array new) == false.
+ 	self assert: (thisContext object: Array eqeq: Array) == true.
+ 	stackpAfter := thisContext stackPtr.
+ 	self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"!

Item was added:
+ ----- Method: MCTestCase>>mockDependencies (in category 'mocks') -----
+ mockDependencies
+ 	^ Array with: (MCVersionDependency package: self mockEmptyPackage info: (self mockVersionInfo: 'x'))!

Item was added:
+ ----- Method: MCOrganizationTest>>testReorderingWithRemovals (in category 'as yet unclassified') -----
+ testReorderingWithRemovals
+ 	|dec cats newCats |
+ 	dec := MCOrganizationDefinition categories: #(A B C).
+ 	cats := #(X Y B Z C A Q).
+ 	newCats := dec reorderCategories: cats original: #(Y B C A Q).
+ 	self assert: newCats asArray = #(X A B C Z).!

Item was added:
+ ----- Method: MCDependencySorterTest>>testCycle (in category 'tests') -----
+ testCycle
+ 	self assertItems: #(
+ 		(a (x) (y))
+ 		(b (y) (x)))
+ 	orderAs: #()
+ 	withRequired: #()
+ 	toLoad: #(a b)	!

Item was added:
+ ----- 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 added:
+ ----- Method: MCRepositoryTest class>>isAbstract (in category 'as yet unclassified') -----
+ isAbstract
+ 	^ self = MCRepositoryTest!

Item was added:
+ ----- Method: MCMethodDefinitionTest>>ownPackage (in category 'running') -----
+ ownPackage
+ 	^ MCWorkingCopy forPackage: (MCPackage named: 'Monticello')!

Item was added:
+ ----- Method: MCClassDefinitionTest class>>classACommentStamp (in category 'as yet unclassified') -----
+ classACommentStamp
+ 	^  'cwp 8/10/2003 16:43'!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>buttonMorphs (in category 'morphic') -----
+ buttonMorphs
+ 	^ self morphsOfClass: PluggableButtonMorph!

Item was added:
+ ----- Method: EventManagerTest>>addArg1:addArg2: (in category 'private') -----
+ addArg1: arg1
+ addArg2: arg2
+ 
+ 	eventListener
+ 		add: arg1;
+ 		add: arg2!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>classAProtocols (in category 'private') -----
+ classAProtocols
+ 	^ self protocolsForClass: self mockClassA.!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testSimpleMerge (in category 'tests') -----
+ testSimpleMerge
+ 	| mother base inst |
+ 	inst := self mockInstanceA.
+ 	base :=  self snapshot.
+ 	self change: #one toReturn: 2.
+ 	mother :=  self snapshot.
+ 	self load: base.
+ 	self change: #two toReturn: 3.
+ 	self snapshot.
+ 	self assert: inst one = 1.
+ 	self assert: inst two = 3.
+ 	
+ 	self merge: mother.
+ 	self assert: inst one = 2.
+ 	self assert: inst two = 3.!

Item was added:
+ ----- Method: ExceptionTests>>testDoublePassOuter (in category 'testing-ExceptionTester') -----
+ testDoublePassOuter
+ 	self assertSuccess: (ExceptionTester new runTest: #doublePassOuterTest ) !

Item was added:
+ MCTestCase subclass: #MCSnapshotTest
+ 	instanceVariableNames: 'snapshot'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testClassSideClassSelected (in category 'testing') -----
+ testClassSideClassSelected
+ 	self clickOnButton: 'class'.
+ 	self selectMockClassA.
+ 	
+ 	self assertAListMatches: self allCategories.
+ 	self assertAListMatches: self definedClasses.
+ 	self assertAListMatches: self classAClassProtocols.
+ 	self denyAListIncludesAnyOf: self allMethods.
+ 	self assertTextIs: self classADefinitionString.!

Item was added:
+ ----- Method: ExceptionTester>>log (in category 'accessing') -----
+ log
+ 
+ 	log == nil
+ 		ifTrue: [log := OrderedCollection new].
+ 	^log!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testIfSequence1 (in category 'tests') -----
+ testIfSequence1
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a b c d) and: #(d c b a).
+ 	self assert: patch size = 7.	"lcs is any one letter sequence"
+ 	self assert: (patch count: [ :each | each key = #match ]) = 1.
+ 	self assert: (patch count: [ :each | each key = #insert ]) = 3.
+ 	self assert: (patch count: [ :each | each key = #remove ]) = 3.
+ 	patch do: [ :each | 
+ 		each key = #match 
+ 			ifTrue: [ self assert: each value first = $d ]
+ 			ifFalse: [ self assert: ('abc' includes: each value first) ] ]!

Item was added:
+ ----- Method: ExceptionTests>>testDoubleOuterPass (in category 'testing-ExceptionTester') -----
+ testDoubleOuterPass
+ 	self assertSuccess: (ExceptionTester new runTest: #doubleOuterPassTest ) !

Item was added:
+ ----- Method: MCStWriterTest>>testClassDefinitionA (in category 'testing') -----
+ testClassDefinitionA
+ 	writer visitClassDefinition: (self mockClassA asClassDefinition).
+ 	self assertContentsOf: stream match: self expectedClassDefinitionA.
+ 	stream reset.
+ 	2 timesRepeat: [self assertChunkIsWellFormed: stream nextChunk]!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>clickOnButton: (in category 'simulating') -----
+ clickOnButton: aString
+ 	(self findButtonWithLabel: aString) performAction.!

Item was added:
+ ----- Method: MCMethodDefinitionTest>>testRevertOverrideMethod (in category 'testing') -----
+ testRevertOverrideMethod
+ 	| definition |
+ 	self class compile: 'override ^ 2' classified: self mockOverrideMethodCategory.
+ 	definition := (MethodReference class: self class selector: #override) asMethodDefinition.
+ 	self assert: definition isOverrideMethod.
+ 	self assert: self override = 2.
+ 	definition unload.
+ 	self assert: self override = 1.
+ 	self assert: (MethodReference class: self class selector: #override) category = 'mocks'.
+ 	!

Item was added:
+ ----- Method: MCMethodDefinitionTest>>setUp (in category 'running') -----
+ setUp
+ 	navigation := (Smalltalk hasClassNamed: #SystemNavigation)
+ 		ifTrue: [(Smalltalk at: #SystemNavigation) new]
+ 		ifFalse: [Smalltalk].
+ 	isModified := self ownPackage modified.!

Item was added:
+ ----- Method: MirrorPrimitiveTests>>testMirrorPerform (in category 'tests') -----
+ testMirrorPerform
+ 	| stackpBefore stackpAfter anInterval |
+ 	stackpBefore := thisContext stackPtr.
+ 	anInterval := 1 to: 2.
+ 	self assert: (thisContext object: anInterval perform:# species withArguments: #() inClass: Interval) == Array.
+ 	self assert: (thisContext object: anInterval perform:# species withArguments: #() inClass: Interval superclass) == Interval.
+ 	self should: [thisContext object: anInterval perform:# species withArguments: #() inClass: Point]
+ 		raise: Error.
+ 	self should: [thisContext object: anInterval perform:# species withArguments: OrderedCollection new inClass: Interval]
+ 		raise: Error.
+ 	stackpAfter := thisContext stackPtr.
+ 	self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"!

Item was added:
+ ----- Method: MCTestCase>>assertVersion:matches: (in category 'asserting') -----
+ assertVersion: actual matches: expected
+ 	self assertPackage: actual package matches: expected package.	
+ 	self assertVersionInfo: actual info matches: expected info.
+ 	self assertSnapshot: actual snapshot matches: expected snapshot.!

Item was added:
+ ----- Method: FileDirectoryTest>>testDirectoryExists (in category 'existence tests') -----
+ testDirectoryExists
+ 
+ 	self assert: self myAssuredDirectory exists.
+ 	self should: [self myDirectory containingDirectory 
+ 					directoryExists: self myLocalDirectoryName].
+ 
+ 	self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName.
+ 	self shouldnt: [self myDirectory containingDirectory 
+ 						directoryExists: self myLocalDirectoryName]!

Item was added:
+ TestCase subclass: #DosFileDirectoryTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Files'!

Item was added:
+ ----- Method: MCWorkingCopyTest>>packageName (in category 'private') -----
+ packageName
+ 	^ self mockPackage name!

Item was added:
+ ----- Method: DecompilerTests>>checkDecompileMethod: (in category 'utilities') -----
+ checkDecompileMethod: oldMethod
+ 	
+ 	| cls selector oldMethodNode methodNode newMethod oldCodeString newCodeString |
+ 	cls := oldMethod methodClass.
+ 	selector := oldMethod selector.
+ 	oldMethodNode := cls decompilerClass new
+ 						decompile: selector
+ 						in: cls
+ 						method: oldMethod.
+ 	[oldMethodNode properties includesKey: #warning] whileTrue:
+ 		[oldMethodNode properties removeKey: #warning].
+ 	oldCodeString := oldMethodNode decompileString.
+ 	methodNode := [cls compilerClass new
+ 						compile: oldCodeString
+ 						in: cls
+ 						notifying: nil
+ 						ifFail: []]
+ 						on: SyntaxErrorNotification
+ 						do: [:ex|
+ 							ex errorMessage = 'Cannot store into' ifTrue:
+ 								[ex return: #badStore].
+ 							ex pass].
+ 	"Ignore cannot store into block arg errors; they're not our issue."
+ 	methodNode ~~ #badStore ifTrue:
+ 		[newMethod := methodNode generate.
+ 		 newCodeString := (cls decompilerClass new
+ 							decompile: selector
+ 							in: cls
+ 							method: newMethod) decompileString.
+ 		 "(StringHolder new textContents:
+ 			(TextDiffBuilder buildDisplayPatchFrom: oldCodeString to: newCodeString))
+ 				openLabel: 'Decompilation Differences for ', cls name,'>>',selector"
+ 		 "(StringHolder new textContents:
+ 			(TextDiffBuilder buildDisplayPatchFrom: oldMethod abstractSymbolic to: newMethod abstractSymbolic))
+ 				openLabel: 'Bytecode Differences for ', cls name,'>>',selector"
+ 		 self assert: oldCodeString = newCodeString
+ 			description: cls name asString, ' ', selector asString
+ 			resumable: true]!

Item was added:
+ ----- Method: ClosureCompilerTest class>>methodWithOptimizedBlocksA (in category 'code examples') -----
+ methodWithOptimizedBlocksA
+ 	| s c |
+ 	s := self isNil
+ 			ifTrue: [| a | a := 'isNil'. a]
+ 			ifFalse: [| a | a := 'notNil'. a].
+ 	c := String new: s size.
+ 	1 to: s size do:
+ 		[:i| c at: i put: (s at: i)].
+ 	^c
+ 
+ 	"Parser new
+ 		parse: (self class sourceCodeAt: #methodWithOptimizedBlocksA)
+ 		class: self class"!

Item was added:
+ ----- Method: ExceptionTester>>nonResumableFallOffTheEndHandler (in category 'tests') -----
+ nonResumableFallOffTheEndHandler
+ 	
+ 	[self doSomething.
+ 	MyTestError signal.
+ 	self doSomethingElse]
+ 		on: MyTestError
+ 		do: [:ex | self doSomethingExceptional].
+ 	self doYetAnotherThing!

Item was added:
+ ----- Method: ExceptionTests>>testDoubleResume (in category 'testing-ExceptionTester') -----
+ testDoubleResume
+ 	self assertSuccess: (ExceptionTester new runTest: #doubleResumeTest ) !

Item was added:
+ ----- Method: MCMergingTest>>testSimultaneousModification (in category 'tests') -----
+ testSimultaneousModification
+ 	self assertMerge: #(a2)
+ 				with: #(a3)
+ 				base: #(a1)
+ 				
+ 				gives: #(a3)
+ 				conflicts: #((a3 a2)).!

Item was added:
+ ----- Method: ClosureCompilerTest>>testDebuggerTempAccess (in category 'tests') -----
+ testDebuggerTempAccess
+ 	self doTestDebuggerTempAccessWith: 1 with: 2!

Item was added:
+ ----- Method: LocaleTest>>testLocaleChanged (in category 'testing') -----
+ testLocaleChanged
+ 	"self debug: #testLocaleChanged"
+ 	"LanguageEnvironment >> startUp is called from Prject >> localeChanged"
+ 	Project current updateLocaleDependents.
+ 	self assert: (ActiveHand instVarNamed: 'keyboardInterpreter') isNil.
+ 	self assert: (Clipboard default instVarNamed: 'interpreter') isNil.
+ 	Locale switchToID: (LocaleID isoLanguage: 'ja').
+ 	self assert: Preferences useFormsInPaintBox.
+ 	Locale switchToID: (LocaleID isoLanguage: 'en').
+ 	self assert: Preferences useFormsInPaintBox not.
+ !

Item was added:
+ ----- Method: MCTestCase>>mockPackage (in category 'mocks') -----
+ mockPackage
+ 	^ MCSnapshotResource mockPackage!

Item was added:
+ ----- Method: MCWorkingCopyTest>>load: (in category 'actions') -----
+ load: aVersion
+ 	aVersion load!

Item was added:
+ ----- Method: ExceptionTester>>simpleIsNestedTest (in category 'signaledException tests') -----
+ simpleIsNestedTest
+ 	"uses resignalAs:"
+ 
+ 	[self doSomething.
+ 	MyTestError signal.
+ 	self doSomethingElse]
+ 		on: MyTestError
+ 		do:
+ 			[:ex |
+ 			ex isNested "expecting to detect handler in #runTest:"
+ 				ifTrue:
+ 					[self doYetAnotherThing.
+ 					ex resignalAs: MyTestNotification new]]!

Item was added:
+ ----- Method: MCFileInTest>>assertInitializersCalled (in category 'testing') -----
+ assertInitializersCalled
+ 	| cvar |
+ 	cvar := self mockClassA cVar.
+ 	self assert: cvar = #initialized!

Item was added:
+ ----- Method: ExceptionTester>>simpleNoTimeoutTestResults (in category 'results') -----
+ simpleNoTimeoutTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		yourself!

Item was added:
+ ----- Method: ExpandedSourceFileArrayTest>>testAddressRange (in category 'testing') -----
+ testAddressRange
+ 	"Test source pointer to file position address translation across a wide address range"
+ 	
+ 	| sf i p a |
+ 	sf := ExpandedSourceFileArray new.
+ 	(16r1000000 to: 16r10000000 by: 4093) do: [:e |
+ 		i := sf fileIndexFromSourcePointer: e.
+ 		p := sf filePositionFromSourcePointer: e.
+ 		a := sf sourcePointerFromFileIndex: i andPosition: p.
+ 		self assert: a = e]
+ !

Item was added:
+ ----- Method: ExpandedSourceFileArrayTest>>testFilePositionFromSourcePointer (in category 'testing') -----
+ testFilePositionFromSourcePointer
+ 	"Test derivation of file position for sources or changes file from source pointers"
+ 
+ 	| sf |
+ 	sf := ExpandedSourceFileArray new.
+ 	"sources file"
+ 	self assert: 0 = (sf filePositionFromSourcePointer: 16r1000000).
+ 	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r1000013).
+ 	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r1FFFFFF).
+ 	self assert: 16r1000000 = (sf filePositionFromSourcePointer: 16r3000000).
+ 	self assert: 16r1000013 = (sf filePositionFromSourcePointer: 16r3000013).
+ 	self assert: 16r1FFFFFF = (sf filePositionFromSourcePointer: 16r3FFFFFF).
+ 	"changes file"
+ 	self assert: 0 = (sf filePositionFromSourcePointer: 16r2000000).
+ 	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r2000013).
+ 	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r2FFFFFF).
+ 	self assert: 16r1000000 = (sf filePositionFromSourcePointer: 16r4000000).
+ 	self assert: 16r1000013 = (sf filePositionFromSourcePointer: 16r4000013).
+ 	self assert: 16r1FFFFFF = (sf filePositionFromSourcePointer: 16r4FFFFFF).
+ 	"the following numeric ranges are unused but currently produces results as follows"
+ 	self assert: 0 = (sf filePositionFromSourcePointer: 16r0000000).
+ 	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r0000013).
+ 	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r0FFFFFF)
+ !

Item was added:
+ ----- Method: MCDependencySorterTest>>testCascadingUnresolved (in category 'tests') -----
+ testCascadingUnresolved
+ 	self assertItems: #(
+ 		(a (x) (z))
+ 		(b () (x))
+ 		(c () ()))
+ 	orderAs: #(c)
+ 	withRequired: #(z)
+ 	toLoad: #(a b)	!

Item was added:
+ ----- Method: MCStWriterTest>>testMethodDefinitionWithBangs (in category 'testing') -----
+ testMethodDefinitionWithBangs
+ 	writer visitMethodDefinition: (MethodReference 
+ 									class: self class 
+ 									selector: #methodWithBangs) asMethodDefinition.
+ 	self assertContentsOf: stream match: self expectedMethodDefinitionWithBangs.
+ 	stream reset.
+ 	self assert: stream nextChunk isAllSeparators.
+ 	self assertChunkIsWellFormed: stream nextChunk.
+ 	self assertMethodChunkIsWellFormed: stream nextChunk.
+ 	self assert: stream nextChunk isAllSeparators !

Item was added:
+ ----- Method: ExceptionTester>>doubleResumeTestResults (in category 'results') -----
+ doubleResumeTestResults
+ 
+        ^OrderedCollection new
+                add: self doSomethingString;
+                add: self doSomethingElseString;
+                add: self doYetAnotherThingString;
+                yourself!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>denyAListHasSelection: (in category 'asserting') -----
+ denyAListHasSelection: aString
+ 	| found |
+ 	found := true.
+ 	self listMorphs 
+ 			detect: [:m | m selection = aString]
+ 			ifNone: [found := false].
+ 	self deny: found.!

Item was added:
+ MCTestCase subclass: #MCInitializationTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: ExceptionTester>>simpleReturnTest (in category 'signaledException tests') -----
+ simpleReturnTest
+ 
+ 	| it |
+ 	it :=
+ 		[self doSomething.
+ 		MyTestError signal.
+ 		self doSomethingElse]
+ 			on: MyTestError
+ 			do: [:ex | ex return: 3].
+ 	it = 3 ifTrue: [self doYetAnotherThing]!

Item was added:
+ ----- Method: MCDirectoryRepositoryTest>>tearDown (in category 'as yet unclassified') -----
+ tearDown
+ 	self directory recursiveDelete!

Item was added:
+ ----- Method: MCChangeNotificationTest>>testExtMethodModified (in category 'tests') -----
+ testExtMethodModified
+ 	| event mref |
+ 	workingCopy modified: false.
+ 	mref := workingCopy packageInfo extensionMethods first.
+ 	event := self modifiedEventFor: mref methodSymbol ofClass: mref actualClass.
+ 	MCWorkingCopy methodModified: event.
+ 	self assert: workingCopy modified!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesIAtoIM (in category 'tests') -----
+ testDecompilerInClassesIAtoIM
+ 	self decompileClassesSelect: [:cn| cn first = $I and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: ClosureCompilerTest>>testInlineBlockCollectionSD1 (in category 'tests') -----
+ testInlineBlockCollectionSD1
+ 	| a1 b1 a2 b2 |
+ 	b1 := OrderedCollection new.
+ 	1 to: 3 do:
+ 		[:i |
+ 		a1 := i.
+ 		b1 add: [a1]].
+ 	b1 := b1 asArray collect: [:b | b value].
+ 	b2 := OrderedCollection new.
+ 	1 to: 3 do:
+ 		[:i |
+ 		a2 := i.
+ 		b2 add: [a2]] yourself. "defeat optimization"
+ 	b2 := b2 asArray collect: [:b | b value].
+ 	self assert: b1 = b2!

Item was added:
+ ----- Method: EventManagerTest>>getFalse (in category 'private') -----
+ getFalse
+ 
+ 	^false!

Item was added:
+ ----- 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 added:
+ TestCase subclass: #ClosureCompilerTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'CmpRR CogRTLOpcodes Jump MoveCqR Nop'
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesVAtoVM (in category 'tests') -----
+ testDecompilerInClassesVAtoVM
+ 	self decompileClassesSelect: [:cn| cn first = $V and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testIfSequence5 (in category 'tests') -----
+ testIfSequence5
+ 
+ 	| patch matches nonMatches |
+ 	patch := self patchSequenceFor: #(a b c d) and: #(c d a b).
+ 	self assert: patch size = 6.	"lcs is ab or cd"
+ 	matches := (patch select: [ :each | each key = #match ])
+ 		collect: [ :each | each value first ] as: String.
+ 	self assert: (#('ab' 'cd') includes: matches).
+ 	self assert: (patch count: [ :each | each key = #insert ]) = 2.
+ 	self assert: (patch count: [ :each | each key = #remove ]) = 2.
+ 	nonMatches := #('ab' 'cd') detect: [ :each | each ~= matches ].
+ 	patch do: [ :each | 
+ 		each key = #match 
+ 			ifTrue: [ self assert: (matches includes: each value first) ]
+ 			ifFalse: [ self assert: (nonMatches includes: each value first) ] ]!

Item was added:
+ ----- Method: MCTestCase class>>isAbstract (in category 'as yet unclassified') -----
+ isAbstract
+ 	^ self = MCTestCase!

Item was added:
+ ----- Method: ProcessTerminateBug>>testSchedulerTermination (in category 'tests') -----
+ testSchedulerTermination
+    | process sema gotHere sema2 |
+    gotHere := false.
+    sema := Semaphore new.
+    sema2 := Semaphore new.
+    process := [
+        sema signal.
+        sema2 wait.
+        "will be suspended here"
+        gotHere := true. "e.g., we must *never* get here"
+    ] forkAt: Processor activeProcess priority.
+    sema wait. "until process gets scheduled"
+    process terminate.
+    sema2 signal.
+    Processor yield. "will give process a chance to continue and
+ horribly screw up"
+    self assert: gotHere not.
+ !

Item was added:
+ ----- Method: ExceptionTester>>doubleOuterPassTestResults (in category 'signaledException results') -----
+ doubleOuterPassTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doYetAnotherThingString;
+ 		add: self doSomethingElseString;
+ 		yourself!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>allProtocols (in category 'private') -----
+ allProtocols
+ 	^ MCSnapshotResource current definitions
+ 		select: [:def | def isMethodDefinition]
+ 		thenCollect: [:def | def category]		!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testFourColumns (in category 'testing') -----
+ testFourColumns
+ 	self assert: self listMorphs size = 4.!

Item was added:
+ ----- Method: MCChangeNotificationTest>>testCoreMethodModified (in category 'tests') -----
+ testCoreMethodModified
+ 	| event |
+ 	workingCopy modified: false.
+ 	event := self modifiedEventFor: #one ofClass: self mockClassA.
+ 	MCWorkingCopy methodModified: event.
+ 	self assert: workingCopy modified!

Item was added:
+ ----- Method: MCScannerTest>>assertScans: (in category 'asserting') -----
+ assertScans: anArray
+ 	self assert: (MCScanner scan: anArray printString readStream) = anArray!

Item was added:
+ ----- Method: ClosureTests>>setUp (in category 'running') -----
+ setUp
+ 	super setUp.
+ 	collection := OrderedCollection new!

Item was added:
+ MCTestCase subclass: #MCStReaderTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: FileStreamTest>>testNextLine (in category 'as yet unclassified') -----
+ testNextLine
+ 	| filename lines text |
+ 	filename := 'filestream.tst'.
+ 	lines := #('line 1' ' and line 2' '' 'fourth').
+ 	text := lines first , String cr , lines second , String crlf , lines third , String lf , lines fourth.
+ 	
+ 	[ | file |
+ 	(StandardFileStream forceNewFileNamed: filename)
+ 		nextPutAll: text;
+ 		close.
+ 		
+ 	file := StandardFileStream readOnlyFileNamed: filename.
+ 	lines do: [:e |
+ 		self assert: file nextLine = e].
+ 	self assert: file nextLine = nil.
+ 	file close]
+ 		ensure: [FileDirectory default deleteFileNamed: filename ifAbsent: [] ]!

Item was added:
+ ----- Method: MCRepositoryTest>>addVersionWithSnapshot:name: (in category 'actions') -----
+ addVersionWithSnapshot: aSnapshot name: aString
+ 	| version |
+ 	version := self versionWithSnapshot: aSnapshot name: aString.
+ 	self addVersion: version.
+ 	^ version info!

Item was added:
+ ----- Method: ExceptionTests>>testNonResumableFallOffTheEndHandler (in category 'testing-ExceptionTester') -----
+ testNonResumableFallOffTheEndHandler
+ 	self assertSuccess: (ExceptionTester new runTest: #nonResumableFallOffTheEndHandler ) !

Item was added:
+ ----- Method: ClosureCompilerTest>>doTestDebuggerTempAccessWith:with: (in category 'tests') -----
+ doTestDebuggerTempAccessWith: one with: two
+ 	"Test debugger access for temps"
+ 	| outerContext local1 remote1 |
+ 	outerContext := thisContext.
+ 	local1 := 3.
+ 	remote1 := 1/2.
+ 	self assert: (Compiler new evaluate: 'one' in: thisContext to: self) == one.
+ 	self assert: (Compiler new evaluate: 'two' in: thisContext to: self) == two.
+ 	self assert: (Compiler new evaluate: 'local1' in: thisContext to: self) == local1.
+ 	self assert: (Compiler new evaluate: 'remote1' in: thisContext to: self) == remote1.
+ 	Compiler new evaluate: 'local1 := -3.0' in: thisContext to: self.
+ 	self assert: local1 = -3.0.
+ 	(1 to: 2) do:
+ 		[:i| | local2 r1 r2 r3 r4 |
+ 		local2 := i * 3.
+ 		remote1 := local2 / 7.
+ 		self assert: thisContext ~~ outerContext.
+ 		self assert: (r1 := Compiler new evaluate: 'one' in: thisContext to: self) == one.
+ 		self assert: (r2 := Compiler new evaluate: 'two' in: thisContext to: self) == two.
+ 		self assert: (r3 := Compiler new evaluate: 'i' in: thisContext to: self) == i.
+ 		self assert: (r4 := Compiler new evaluate: 'local2' in: thisContext to: self) == local2.
+ 		self assert: (r4 := Compiler new evaluate: 'remote1' in: thisContext to: self) == remote1.
+ 		self assert: (r4 := Compiler new evaluate: 'remote1' in: outerContext to: self) == remote1.
+ 		Compiler new evaluate: 'local2 := 15' in: thisContext to: self.
+ 		self assert: local2 = 15.
+ 		Compiler new evaluate: 'local1 := 25' in: thisContext to: self.
+ 		self assert: local1 = 25.
+ 		{ r1. r2. r3. r4 } "placate the compiler"].
+ 	self assert: local1 = 25.
+ 	self assert: remote1 = (6/7)!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesBAtoBM (in category 'tests') -----
+ testDecompilerInClassesBAtoBM
+ 	self decompileClassesSelect: [:cn| cn first = $B and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCAncestryTest>>assertCommonAncestorOf:and:is:in: (in category 'asserting') -----
+ assertCommonAncestorOf: leftName and: rightName is: ancestorName in: tree
+ 	self assertCommonAncestorOf: leftName and: rightName in: (Array with: ancestorName) in: tree!

Item was added:
+ ----- Method: MCMczInstallerTest>>deleteFile (in category 'as yet unclassified') -----
+ deleteFile
+ 	(FileDirectory default fileExists: self fileName)
+ 		ifTrue: [FileDirectory default deleteFileNamed: self fileName]!

Item was added:
+ ----- Method: MCSnapshotTest>>testInstanceReuse (in category 'tests') -----
+ testInstanceReuse
+ 	| x m n y |
+ 	x := (MCPackage new name: self mockCategoryName) snapshot.
+ 	Smalltalk garbageCollect.
+ 	n := MCDefinition allSubInstances size.
+ 	y := (MCPackage new name: self mockCategoryName) snapshot.
+ 	Smalltalk garbageCollect.
+ 	m := MCDefinition allSubInstances size.
+ 	self assert: m = n!

Item was added:
+ TestCase subclass: #LocaleTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Localization'!
+ 
+ !LocaleTest commentStamp: 'tak 8/3/2005 18:24' prior: 0!
+ LocaleTest buildSuite run!

Item was added:
+ TestCase subclass: #StandardSourceFileArrayTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Files'!
+ 
+ !StandardSourceFileArrayTest commentStamp: 'dtl 12/13/2009 23:42' prior: 0!
+ This test documents the source pointer address conversion methods for StandardSourceFileArray.
+ 
+ The available address space for source pointers in CompiledMethod is 16r1000000 through 16r4FFFFFF. StandardSourceFileArray maps positions in the sources file to address range 16r1000000 through 16r1FFFFFF and 16r3000000 through 16r3FFFFFF, and positions in the changes file to address range 16r2000000 through 16r2FFFFFF and 16r4000000 through 16r4FFFFFF. This permits a maximum file size of 16r2000000 (32MB) for both the sources file and the changes file. 
+ !

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesOAtoOM (in category 'tests') -----
+ testDecompilerInClassesOAtoOM
+ 	self decompileClassesSelect: [:cn| cn first = $O and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCSnapshotResource>>definitions (in category 'as yet unclassified') -----
+ definitions
+ 	^ snapshot definitions!

Item was added:
+ ----- Method: MCDictionaryRepositoryTest>>dictionary (in category 'as yet unclassified') -----
+ dictionary
+ 	^ dict ifNil: [dict := Dictionary new]!

Item was added:
+ ----- Method: ExceptionTests>>testTimeoutWithZeroDuration (in category 'testing') -----
+ testTimeoutWithZeroDuration
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleTimeoutWithZeroDurationTest ) !

Item was added:
+ ----- Method: ExceptionTester>>simpleRetryTestResults (in category 'signaledException results') -----
+ simpleRetryTestResults
+ 
+ 	^OrderedCollection new
+ 			add: self doSomethingString;
+ 			add: self doYetAnotherThingString;
+ 			add: self doSomethingString;
+ 			add: self doSomethingElseString;
+ 			yourself!

Item was added:
+ ----- Method: MCRepositoryTest>>testIncludesName (in category 'tests') -----
+ testIncludesName
+ 	self deny: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev1').
+ 	self saveSnapshot1.
+ 	self assert: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev1').
+ 	self deny: (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev2').
+ 	self saveSnapshot2.
+ 	self assert:  (repository includesVersionNamed: 'MonticelloTest-xxx.1-rev2').!

Item was added:
+ ----- Method: CompilerTest>>testScaledDecimalLiterals (in category 'literals') -----
+ testScaledDecimalLiterals
+ 	"Equal ScaledDecimal with different scales should use different slots
+ 	This is related to http://bugs.squeak.org/view.php?id=6797"
+ 	
+ 	"This correctly works when evaluated separately"
+ 	self deny: (Compiler evaluate: '0.5s1') scale = (Compiler evaluate: '0.5s2') scale.
+ 	
+ 	"But not when evaluated together if literal reduction is too agressive"
+ 	self deny: (Compiler evaluate: '0.5s1 scale =  0.5s2 scale').!

Item was added:
+ ----- Method: MCDependencySorterTest>>itemWithSpec: (in category 'building') -----
+ itemWithSpec: anArray
+ 	^ MCMockDependentItem new
+ 		name: anArray first;
+ 		provides: anArray second;
+ 		requires: anArray third!

Item was added:
+ ----- Method: ClosureCompilerTest>>supportTestSourceRangeAccessForDecompiledNoBytecodeInjectInto:source: (in category 'tests') -----
+ supportTestSourceRangeAccessForDecompiledNoBytecodeInjectInto: method source: source
+ 	"Test debugger source range selection for inject:into:"
+ 	^self
+ 		supportTestSourceRangeAccessForInjectInto: method
+ 		source: source
+ 		selectionSequence: #(	'at: 1 put: t1'
+ 								'do: [:t4 | t3 at: 1 put: (t2 value: (t3 at: 1) value: t4)]'
+ 								'value: (t3 at: 1) value: t4'
+ 								'at: 1 put: (t2 value: (t3 at: 1) value: t4)'
+ 								']'
+ 								'value: (t3 at: 1) value: t4'
+ 								'at: 1 put: (t2 value: (t3 at: 1) value: t4)'
+ 								']'
+ 								'^t3 at: 1')!

Item was added:
+ ----- Method: MCTestCase>>mockExtensionMethodCategory (in category 'mocks') -----
+ mockExtensionMethodCategory
+ 	^ MCMockPackageInfo new methodCategoryPrefix.!

Item was added:
+ ----- Method: ExceptionTester>>resumableFallOffTheEndHandlerResults (in category 'results') -----
+ resumableFallOffTheEndHandlerResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doSomethingExceptionalString;
+ 		add: self doYetAnotherThingString;
+ 		yourself!

Item was added:
+ ----- Method: ExceptionTester>>runBasicANSISignaledExceptionTests (in category 'suites') -----
+ runBasicANSISignaledExceptionTests
+ 
+ 	self basicANSISignaledExceptionTestSelectors
+ 		do:
+ 			[:eachTestSelector |
+ 			self runTest: eachTestSelector]!

Item was added:
+ ----- Method: ExpandedSourceFileArrayTest>>testFileIndexFromSourcePointer (in category 'testing') -----
+ testFileIndexFromSourcePointer
+ 	"Test derivation of file index for sources or changes file from source pointers"
+ 
+ 	| sf |
+ 	sf := ExpandedSourceFileArray new.
+ 	"sources file mapping"
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000000).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000013).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1FFFFFF).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3000000).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3000013).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3FFFFFF).
+ 
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r5000000).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r5000013).
+ 	self assert: 1 = (sf fileIndexFromSourcePointer: 16r5FFFFFF).
+ 
+ 	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)].
+ 	(16r3000000 to: 16r3FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)].
+ 	"changes file mapping"
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2000000).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2000013).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2FFFFFF).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000000).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000013).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4FFFFFF).
+ 
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r6000000).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r6000013).
+ 	self assert: 2 = (sf fileIndexFromSourcePointer: 16r6FFFFFF).
+ 
+ 	(16r2000000 to: 16r2FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)].
+ 	(16r4000000 to: 16r4FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)].
+ 
+ 	"the following numeric ranges are unused but currently produces results as follows"
+ 	self assert: 0 = (sf fileIndexFromSourcePointer: 16r0000000).
+ 	self assert: 0 = (sf fileIndexFromSourcePointer: 16r0000013).
+ 	self assert: 0 = (sf fileIndexFromSourcePointer: 16r0FFFFFF)
+ 
+ !

Item was added:
+ ----- Method: ClosureTests>>testToDoOutsideTemp (in category 'testing-todo') -----
+ testToDoOutsideTemp
+ 	| temp |
+ 	1 to: 5 do: [ :index | 
+ 		temp := index. 
+ 		collection add: [ temp ] ].
+ 	self assertValues: #(5 5 5 5 5)!

Item was added:
+ TestCase subclass: #ExpandedSourceFileArrayTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Files'!
+ 
+ !ExpandedSourceFileArrayTest commentStamp: 'dtl 12/22/2009 23:10' prior: 0!
+ This test documents the source pointer address conversion methods for ExpandedSourceFileArray.
+ 
+ The available address space for source pointers in a traditional CompiledMethod is 16r1000000 through 16r4FFFFFF. StandardSourceFileArray maps positions in the sources file to address range 16r1000000 through 16r1FFFFFF and 16r3000000 through 16r3FFFFFF, and positions in the changes file to address range 16r2000000 through 16r2FFFFFF and 16r4000000 through 16r4FFFFFF. This permits a maximum file size of 16r2000000 (32MB) for both the sources file and the changes file. 
+ 
+ ExpandedSourceFileArray extends the source pointer address space using bit 25 of the source pointer to identify the external sources and changes files, with the remaining high order bits treated as address extension. This limits the number of external file references to two (the traditional sources and changes files). If additional external file references are needed in the future, some higher order bits in the source pointer address space should be allocated for that purpose.
+ 
+ The use of bit 25 of the source pointer for file references permits backward compatibility with StandardSourceFileArray, with essentially unlimited address space expansion for the sources and changes files.
+ !

Item was added:
+ ----- Method: MCDictionaryRepositoryTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ 	repository :=  MCDictionaryRepository new dictionary: self dictionary!

Item was added:
+ ----- Method: MCClassDefinitionTest class>>classAComment (in category 'as yet unclassified') -----
+ classAComment
+ 	^ 'This is a mock class. The Monticello tests manipulated it to simulate a developer modifying code in the image.'!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesHAtoHM (in category 'tests') -----
+ testDecompilerInClassesHAtoHM
+ 	self decompileClassesSelect: [:cn| cn first = $H and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCSerializationTest>>testMcdSerialization (in category 'testing') -----
+ testMcdSerialization
+ 	| stream expected actual |
+ 	expected := self mockDiffyVersion.
+ 	stream := RWBinaryOrTextStream on: String new.
+ 	MCMcdWriter fileOut: expected on: stream.
+ 	actual := MCMcdReader versionFromStream: stream reset.
+ 	self assertVersion: actual matches: expected.!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>allMethods (in category 'private') -----
+ allMethods
+ 	^ MCSnapshotResource current definitions
+ 		select: [:def | def isMethodDefinition]
+ 		thenCollect: [:def | def selector]		!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesTNtoTZ (in category 'tests') -----
+ testDecompilerInClassesTNtoTZ
+ 	self decompileClassesSelect: [:cn| cn first = $T and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCAncestryTest>>tree (in category 'building') -----
+ tree
+ 	^ self treeFrom:
+ 		#(c1
+ 			((e2
+ 				((e1
+ 					((a1
+ 						(('00')))))))
+ 			(a2
+ 				((a1
+ 					(('00')))))
+ 			(b3
+ 				((b2
+ 					((b1
+ 						((b0
+ 							(('00')))))))
+ 				(a1
+ 					(('00')))))
+ 			(d1)))!

Item was added:
+ ----- Method: MCFileInTest>>assertFileOutFrom:canBeFiledInWith: (in category 'testing') -----
+ assertFileOutFrom: writerClass canBeFiledInWith: aBlock
+ 	(writerClass on: stream) writeSnapshot: self mockSnapshot.
+ 	self alterInitialState.
+ 	self assertSuccessfulLoadWith: aBlock.
+ 	self mockPackage unload.
+ 	self assertSuccessfulLoadWith: aBlock.
+ !

Item was added:
+ ----- Method: EventManagerTest>>setUp (in category 'running') -----
+ setUp
+ 
+ 	super setUp.
+ 	eventSource := EventManager new.
+ 	eventListener := Bag new.
+ 	succeeded := false!

Item was added:
+ ----- Method: MCStWriterTest>>expectedClassDefinitionA (in category 'data') -----
+ expectedClassDefinitionA
+  ^ '
+ MCMock subclass: #MCMockClassA
+ 	instanceVariableNames: ''ivar''
+ 	classVariableNames: ''CVar''
+ 	poolDictionaries: ''''
+ 	category: ''Monticello-Mocks''!!
+ 
+ !!MCMockClassA commentStamp: ''cwp 8/10/2003 16:43'' prior: 0!!
+ This is a mock class. The Monticello tests manipulated it to simulate a developer modifying code in the image.!!
+ '!

Item was added:
+ TestResource subclass: #MCSnapshotResource
+ 	instanceVariableNames: 'snapshot'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCScannerTest>>test2 (in category 'tests') -----
+ test2
+ 	self assertScans: 'it''s alive'!

Item was added:
+ ----- Method: MCTestCase>>mockVersionName (in category 'mocks') -----
+ mockVersionName
+ 	^ 'MonticelloTest-xxx.1'!

Item was added:
+ ClosureCompilerTest subclass: #MethodHighlightingTests
+ 	instanceVariableNames: 'creator timeStamp duration tracks'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleOuter (in category 'testing-ExceptionTester') -----
+ testSimpleOuter
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleOuterTest ) !

Item was added:
+ ----- Method: MCChangeNotificationTest>>foreignMethod (in category 'private') -----
+ foreignMethod
+ 	"see testForeignMethodModified"!

Item was added:
+ ----- Method: MCStWriterTest>>methodWithBangs (in category 'testing') -----
+ methodWithBangs
+ 	^ '
+ 	^ ReadStream on: 
+ ''MCRevisionInfo packageName: ''MonticelloCompatibilityTest''!!!!
+ MCOrganizationDeclaration categories: 
+   #(
+   ''Monticello-Mocks'')!!!!
+ 
+ MCClassDeclaration
+   name: #MCMockClassD
+   superclassName: #Object
+   category: #''Monticello-Mocks''
+   instVarNames: #()
+   comment: ''''!!!!
+ 
+ MCMethodDeclaration className: #MCMockClassD selector: #one category: #''as yet unclassified'' timeStamp: ''cwp 7/8/2003 21:21'' source: 
+ ''one
+ 	^ 1''!!!!
+ ''
+ '
+ !

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesMNtoMZ (in category 'tests') -----
+ testDecompilerInClassesMNtoMZ
+ 	self decompileClassesSelect: [:cn| cn first = $M and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCWorkingCopyTest>>clearPackageCache (in category 'running') -----
+ clearPackageCache
+ 	| dir |
+ 	dir := MCCacheRepository default directory.
+ 	(dir fileNamesMatching: 'MonticelloMocks*') do: [:ea | dir deleteFileNamed: ea].
+ 	(dir fileNamesMatching: 'MonticelloTest*') do: [:ea | dir deleteFileNamed: ea].
+ 	(dir fileNamesMatching: 'rev*') do: [:ea | dir deleteFileNamed: ea].
+ 	(dir fileNamesMatching: 'foo-*') do: [:ea | dir deleteFileNamed: ea].
+ 	(dir fileNamesMatching: 'foo2-*') do: [:ea | dir deleteFileNamed: ea].!

Item was added:
+ ----- Method: ExceptionTester>>simpleEnsureTestResults (in category 'results') -----
+ simpleEnsureTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doSomethingElseString;
+ 		add: self doYetAnotherThingString;
+ 		yourself!

Item was added:
+ ----- Method: MCDirectoryRepositoryTest>>directory (in category 'as yet unclassified') -----
+ directory
+ 	directory ifNil:
+ 		[directory := FileDirectory default directoryNamed: 'mctest'.
+ 		directory assureExistence].
+ 	^ directory!

Item was added:
+ ----- Method: MCRepositoryTest>>saveSnapshot2 (in category 'actions') -----
+ saveSnapshot2
+ 	^ self saveSnapshot: self snapshot2 named: 'rev2'!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesZNtoZZ (in category 'tests') -----
+ testDecompilerInClassesZNtoZZ
+ 	self decompileClassesSelect: [:cn| cn first = $Z and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCDependencySorterTest>>testSimpleUnresolved (in category 'tests') -----
+ testSimpleUnresolved
+ 	self assertItems: #(
+ 		(a () (z)))
+ 	orderAs: #()
+ 	withRequired: #(z)
+ 	toLoad: #(a)
+ 		!

Item was added:
+ ----- Method: MCTestCase>>restoreMocks (in category 'compiling') -----
+ restoreMocks
+ 	self mockSnapshot updatePackage: self mockPackage!

Item was added:
+ ----- Method: FileDirectoryTest>>testAttemptExistenceCheckWhenFile (in category 'existence tests') -----
+ testAttemptExistenceCheckWhenFile
+ 	"How should a FileDirectory instance respond with an existent file name?"
+ 	
+ 	| directory filename |
+ 	
+ 	filename := 'aTestFile'.
+ 	FileDirectory default forceNewFileNamed: filename.
+ 	directory := FileDirectory default directoryNamed: filename.
+ 	self shouldnt: [directory exists] description: 'Files are not directories.'.
+ 	
+ 	"clean up disk"
+ 	FileDirectory default deleteFileNamed: filename ifAbsent: [ ]!

Item was added:
+ ----- Method: MCAncestryTest>>assertNamesOf:are: (in category 'asserting') -----
+ assertNamesOf: versionInfoCollection are: nameArray
+ 	| names |
+ 	names := versionInfoCollection collect: [:ea | ea name].
+ 	
+ 	self assert: names asArray = nameArray!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryNonExistence (in category 'as yet unclassified') -----
+ testFileDirectoryNonExistence
+ 
+ 	| inexistentFileName |
+ 	
+ 	"Hoping that you have 'C:' of course..."
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	
+ 	inexistentFileName := DosFileDirectory default nextNameFor: 'DosFileDirectoryTest' extension: 'temp'.
+ 	
+ 	"This test can fail if another process creates a file with the same name as inexistentFileName
+ 	(the probability of that is very very remote)"
+ 
+ 	self deny: (DosFileDirectory default fileOrDirectoryExists: inexistentFileName)!

Item was added:
+ ----- Method: ClosureCompilerTest>>testInlineBlockCollectionLR3 (in category 'tests') -----
+ testInlineBlockCollectionLR3
+ 	| col |
+ 	col := OrderedCollection new.
+ 	1 to: 11 do: [ :each | | i | i := each. col add: [ i ]. i := i + 1 ].
+ 	self assert: (col collect: [ :each | each value ]) asArray = (2 to: 12) asArray!

Item was added:
+ ----- Method: MCStWriterTest>>testInitializerDefinition (in category 'testing') -----
+ testInitializerDefinition
+ 	|chunk lastChunk|
+ 	writer writeSnapshot: self mockSnapshot.
+ 	stream reset.
+ 	[stream atEnd] whileFalse:
+ 		[chunk := stream nextChunk.
+ 		chunk isAllSeparators ifFalse: [lastChunk := chunk]].
+ 	self assertContentsOf: lastChunk readStream match: self expectedInitializerA!

Item was added:
+ ----- Method: ExceptionTester>>runTest: (in category 'testing') -----
+ runTest: aSelector
+ 
+ 	| actualResult expectedResult |
+ 	[ self 
+ 		logTest: aSelector;
+ 		clearLog;
+ 		perform: aSelector ]
+ 			on: MyTestError do: 
+ 				[ :ex | self log: 'Unhandled Exception'.
+ 					ex return: nil ].
+ 
+ 	actualResult	:= self log.
+ 	expectedResult := self perform: (aSelector, #Results) asSymbol.
+ 
+ 	actualResult = expectedResult
+ 		ifTrue: [self logTestResult: 'succeeded']
+ 		ifFalse: [self logTestResult: 'failed' ].
+ !

Item was added:
+ ----- Method: MCClassDefinitionTest>>tearDown (in category 'as yet unclassified') -----
+ tearDown
+ 	Smalltalk at: 'MCMockClassC' ifPresent: [:c | c removeFromSystem]!

Item was added:
+ ----- Method: MCMergingTest>>testComplexConflictlessMerge (in category 'tests') -----
+ testComplexConflictlessMerge
+ 	self 
+ 		assertMerge: #(a1 b1 d1)
+ 				with: #(a2 c1)
+ 				base: #(a1 c1 d1)
+ 				
+ 				gives: #(a2 b1)
+ 				conflicts: #()!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesFNtoFZ (in category 'tests') -----
+ testDecompilerInClassesFNtoFZ
+ 	self decompileClassesSelect: [:cn| cn first = $F and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'as yet unclassified') -----
+ testLoadAndUnload
+ 	| d c |
+ 	d :=  self mockClass: 'MCMockClassC' super: 'Object'.
+ 	d load.
+ 	self assert: (Smalltalk hasClassNamed: 'MCMockClassC').
+ 	c := (Smalltalk classNamed: 'MCMockClassC').
+ 	self assert: (c isKindOf: Class).
+ 	self assert: c superclass = Object.
+ 	self assert: c instVarNames isEmpty.
+ 	self assert: c classVarNames isEmpty.
+ 	self assert: c sharedPools isEmpty.
+ 	self assert: c category = self mockCategoryName.
+ 	self assert: c organization classComment = (self commentForClass: 'MCMockClassC').
+ 	self assert: c organization commentStamp = (self commentStampForClass: 'MCMockClassC').
+ 	d unload.
+ 	self deny: (Smalltalk hasClassNamed: 'MCMockClassC').!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesSNtoSZ (in category 'tests') -----
+ testDecompilerInClassesSNtoSZ
+ 	self decompileClassesSelect: [:cn| cn first = $S and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCStReaderTest>>testCommentWithStyle (in category 'as yet unclassified') -----
+ testCommentWithStyle
+ 	| reader |
+ 	reader := MCStReader on: self commentWithStyle readStream.
+ 	reader definitions!

Item was added:
+ ----- Method: MCRepositoryTest>>snapshotAt: (in category 'accessing') -----
+ snapshotAt: aVersionInfo
+ 	^ (repository versionWithInfo: aVersionInfo) snapshot!

Item was added:
+ ----- Method: ExceptionTests>>testResumablePass (in category 'testing-outer') -----
+ testResumablePass
+ 
+ 	| result |
+ 	result := [Notification signal. 4] 
+ 		on: Notification 
+ 		do: [:ex | ex pass. ex return: 5].
+ 	self assert: result == 4
+ !

Item was added:
+ ----- Method: MCSortingTest>>testConsistentSorting (in category 'tests') -----
+ testConsistentSorting
+ 	| definitions shuffledAndSorted|
+ 	definitions :=
+ 		{self methodNamed: #a class: #A meta: false.
+ 		self methodNamed: #a class: #A meta: true.
+ 		self methodNamed: #a class: #B meta: false.
+ 		self methodNamed: #b class: #A meta: false.
+ 		self methodNamed: #b class: #B meta: false.
+ 		self classNamed: #A.
+ 		self classNamed: #B}.
+ 	shuffledAndSorted :=
+ 		(1 to: 100) collect: [:ea | self sortDefinitions: definitions shuffled].
+ 	self assert: shuffledAndSorted asSet size = 1.
+ !

Item was added:
+ ClassTestCase subclass: #SecureHashAlgorithmTest
+ 	instanceVariableNames: 'hash'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Digital Signatures'!
+ 
+ !SecureHashAlgorithmTest commentStamp: '<historical>' prior: 0!
+ This is the unit test for the class SecureHashAlgorithm. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: 
+ 	- http://www.c2.com/cgi/wiki?UnitTest
+ 	- http://minnow.cc.gatech.edu/squeak/1547
+ 	- the sunit class category!

Item was added:
+ ----- Method: ExceptionTests>>testNoTimeout (in category 'testing') -----
+ testNoTimeout
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleNoTimeoutTest ) !

Item was added:
+ TestCase subclass: #SystemVersionTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-System-Support'!
+ 
+ !SystemVersionTest commentStamp: 'tlk 11/14/2004 10:47' prior: 0!
+ I am an sunit test for SystemVersion.  Originally created to test SqueakMapSystemVersionFix change set.
+ I have no test fixtures.!

Item was added:
+ MCTestCase subclass: #MCStWriterTest
+ 	instanceVariableNames: 'stream writer'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCScannerTest>>test6 (in category 'tests') -----
+ test6
+ 	self should: [MCScanner scan: '(a b' readStream] raise: Error!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesLNtoLZ (in category 'tests') -----
+ testDecompilerInClassesLNtoLZ
+ 	self decompileClassesSelect: [:cn| cn first = $L and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MacFileDirectoryTest>>testMacFileDirectory (in category 'test') -----
+ testMacFileDirectory
+ 	"(self run: #testMacFileDirectory)"
+ 	
+ 	"This fails before the the fix if the Squeak directory is on the root
+ 	directory like: 'HardDisk:Squeak'
+ 	But should work both before and after the fix of John if there is several
+ 	directories in the hieracry: HardDisk:User:Squeak"
+ 	"If somebody can find a way to make the test failed all the time when the fix is not 
+ 	present we should replace it"
+ 
+ 	self assert: (FileDirectory default fullName) = (FileDirectory default fullNameFor: (FileDirectory default fullName))!

Item was added:
+ ----- Method: MCMczInstallerTest>>fileStream (in category 'as yet unclassified') -----
+ fileStream
+ 	^ FileStream forceNewFileNamed: self fileName.!

Item was added:
+ ----- Method: ClosureCompilerTest>>testInjectIntoDecompiledDebugs (in category 'tests') -----
+ testInjectIntoDecompiledDebugs
+ 	"Test various debugs of the decompiled form debug correctly."
+ 	"self new testInjectIntoDecompiledDebugs"
+ 	| source |
+ 	source := (Collection sourceCodeAt: #inject:into:) asString.
+ 	{ Encoder.
+ 	   EncoderForV3PlusClosures. EncoderForLongFormV3PlusClosures } do:
+ 		[:encoderClass| | method |
+ 		method := (Parser new
+ 							encoderClass: encoderClass;
+ 							parse: source
+ 							class: Collection)
+ 						generate.
+ 		self supportTestSourceRangeAccessForDecompiledInjectInto: method source: method decompileString]!

Item was added:
+ TestCase subclass: #ClosureTests
+ 	instanceVariableNames: 'collection'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!

Item was added:
+ ----- Method: MCDictionaryRepositoryTest>>deleteNode: (in category 'as yet unclassified') -----
+ deleteNode: aNode
+ 	dict removeKey: aNode!

Item was added:
+ ----- Method: ExceptionTester>>simpleRetryUsingTestResults (in category 'signaledException results') -----
+ simpleRetryUsingTestResults
+ 
+ 	^OrderedCollection new
+ 			add: self doSomethingString;
+ 			add: self doYetAnotherThingString;
+ 			yourself!

Item was added:
+ ----- Method: SmalltalkImageTest>>testImageName (in category 'testing') -----
+ testImageName
+ 	"Non regression test for http://bugs.squeak.org/view.php?id=7351"
+ 	| shortImgName fullImgName fullChgName |
+ 	shortImgName := 'Squeak3.10.2-7179-basic'.
+ 	fullImgName := SmalltalkImage current fullNameForImageNamed: shortImgName.
+ 	fullChgName := SmalltalkImage current fullNameForChangesNamed: shortImgName.
+ 	FileDirectory splitName: fullImgName to: [:path :name |
+ 		self assert: path = SmalltalkImage current imagePath.
+ 		self assert: name = 'Squeak3.10.2-7179-basic.image'.].
+ 	FileDirectory splitName: fullChgName to: [:path :name |
+ 		self assert: path = SmalltalkImage current imagePath.
+ 		self assert: name = 'Squeak3.10.2-7179-basic.changes'.].!

Item was added:
+ ----- Method: MCFileInTest>>assertSuccessfulLoadWith: (in category 'testing') -----
+ assertSuccessfulLoadWith: aBlock
+ 	stream reset.
+ 	aBlock value.
+ 	self assertNoChange.
+ 	self assertInitializersCalled.!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testOptimizedLoad (in category 'tests') -----
+ testOptimizedLoad
+ 	| inst base diffy |
+ 	inst := self mockInstanceA.
+ 	base := self snapshot.
+ 	self change: #one toReturn: 2.
+ 	self assert: inst one = 2.
+ 	diffy := self snapshot asDiffAgainst: base.
+ 	self deny: diffy canOptimizeLoading.
+ 	self load: base.
+ 	self assert: inst one = 1.
+ 	self assert: diffy canOptimizeLoading.
+ 	self load: diffy.
+ 	self assert: inst one = 2.
+ !

Item was added:
+ ----- Method: LocaleTest>>testFontFullName (in category 'testing') -----
+ testFontFullName
+ 	"self debug: #testFontFullName"
+ 	| env dir |
+ 	env := (Locale isoLanguage: 'ja') languageEnvironment.
+ 	dir := FileDirectory on: SecurityManager default untrustedUserDirectory.
+ 	[dir recursiveDelete]
+ 		on: Error
+ 		do: [:e | e].
+ 	env fontFullName.
+ 	self assert: dir exists!

Item was added:
+ TestCase subclass: #CompilerTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!
+ 
+ !CompilerTest commentStamp: 'nice 12/3/2007 22:15' prior: 0!
+ CompilerTest is a holder for SUnit test of Compiler!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>clickOnListItem: (in category 'simulating') -----
+ clickOnListItem: aString
+ 	| listMorph |
+ 	listMorph := self findListContaining: aString.
+ 	listMorph changeModelSelection: (listMorph getList indexOf: aString).!

Item was added:
+ ----- Method: MCStWriterTest>>expectedInitializerA (in category 'testing') -----
+ expectedInitializerA
+ 	^ 'MCMockClassA initialize'!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleEnsureTestWithError (in category 'testing-ExceptionTester') -----
+ testSimpleEnsureTestWithError
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithError ) !

Item was added:
+ ----- Method: ExceptionTester>>simplePassTestResults (in category 'signaledException results') -----
+ simplePassTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doYetAnotherThingString;
+ 		add: 'Unhandled Exception';
+ 		yourself!

Item was added:
+ ----- Method: MCRepositoryTest>>snapshot2 (in category 'building') -----
+ snapshot2
+ 	^ (MCSnapshot fromDefinitions: (Array with: (MCOrganizationDefinition categories: #('x'))))!

Item was added:
+ ----- Method: MCSnapshotResource class>>takeSnapshot (in category 'as yet unclassified') -----
+ takeSnapshot
+ 	^ self mockPackage snapshot!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryExists (in category 'as yet unclassified') -----
+ testFileDirectoryExists
+ 	"Hoping that you have 'C:' of course..."
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	self assert: (FileDirectory root directoryExists: 'C:').!

Item was added:
+ ----- Method: ClosureCompilerTest>>testSourceRangeAccessForClosureLongFormBytecodeInjectInto (in category 'tests') -----
+ testSourceRangeAccessForClosureLongFormBytecodeInjectInto
+ 	"Test debugger source range selection for inject:into: for a version compiled with closures"
+ 	"self new testSourceRangeAccessForClosureLongFormBytecodeInjectInto"
+ 	| source method |
+ 	source := (Collection sourceCodeAt: #inject:into:) asString.
+ 	method := (Parser new
+ 						encoderClass: EncoderForLongFormV3PlusClosures;
+ 						parse: source
+ 						class: Collection)
+ 					generate: (Collection compiledMethodAt: #inject:into:) trailer.
+ 	self supportTestSourceRangeAccessForInjectInto: method source: source!

Item was added:
+ ----- Method: MCTestCase>>mockToken: (in category 'mocks') -----
+ mockToken: aSymbol
+ 	^ MCMockDefinition token: aSymbol!

Item was added:
+ MCTestCase subclass: #MCVersionTest
+ 	instanceVariableNames: 'version visited'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCMergingTest>>testAdditiveConflictlessMerge (in category 'tests') -----
+ testAdditiveConflictlessMerge
+ 	self
+ 		assertMerge: #(a1 b1)
+ 				with: #(a1 c1)
+ 				base: #(a1)
+ 			
+ 				gives: #(a1 b1 c1)
+ 				conflicts: #()!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleResume (in category 'testing-ExceptionTester') -----
+ testSimpleResume
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleResumeTest ) !

Item was added:
+ ----- Method: ExceptionTester>>simpleResumeTest (in category 'signaledException tests') -----
+ simpleResumeTest
+ 	"see if we can resume twice"
+ 	
+ 	[ | it |
+ 	self doSomething.
+ 	it := MyResumableTestError signal.
+ 	it = 3 ifTrue: [self doSomethingElse].
+ 	it := MyResumableTestError signal.
+ 	it = 3 ifTrue: [self doSomethingElse].
+ 	]
+ 		on: MyResumableTestError
+ 		do:
+ 			[:ex |
+ 			self doYetAnotherThing.
+ 			ex resume: 3]!

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

Item was added:
+ ----- Method: MCMergingTest>>testLocalModifyRemoteRemove (in category 'tests') -----
+ testLocalModifyRemoteRemove
+ 	self assertMerge: #(a2 b1)
+ 				with: #(b1)
+ 				base: #(a1 b1)
+ 				
+ 				gives: #(b1)
+ 				conflicts: #((removed a2)).
+ 				
+ 	self assertMerge: #(a1 b1)
+ 				with: #(b1)
+ 				base: #(a2 b1)
+ 				
+ 				gives: #(b1)
+ 				conflicts: #((removed a1)).!

Item was added:
+ ----- Method: CompilerExceptionsTest>>selectFrom:to: (in category 'emulating') -----
+ selectFrom: start to: end 
+ 	!

Item was added:
+ ----- Method: CompilerExceptionsTest>>testUndeclaredVariable (in category 'tests') -----
+ testUndeclaredVariable
+ 	self 
+ 		should: 
+ 			[self class 
+ 				compile: 'griffle ^ goo'
+ 				notifying: self]
+ 		raise: UndeclaredVariable!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>denyAListIncludesAnyOf: (in category 'asserting') -----
+ denyAListIncludesAnyOf: anArrayOfStrings
+ 	| found |
+ 	found := true.
+ 	self listMorphs 
+ 			detect: [:m | m getList includesAnyOf: anArrayOfStrings]
+ 			ifNone: [found := false].
+ 	self deny: found.!

Item was added:
+ ----- Method: MCPackageTest>>tearDown (in category 'running') -----
+ tearDown
+ 	self mockSnapshot install!

Item was added:
+ ----- Method: MCMergingTest>>testMultiPackageMerge (in category 'tests') -----
+ testMultiPackageMerge
+ 	| merger |
+ 	conflicts := #().
+ 	merger := MCThreeWayMerger new.
+ 	merger addBaseSnapshot: (self snapshotWithElements: #(a1 b1)).
+ 	merger applyPatch: ((self snapshotWithElements: #()) patchRelativeToBase: (self snapshotWithElements: #(a1))).
+ 	merger applyPatch: ((self snapshotWithElements: #(a2 b1)) patchRelativeToBase: (self snapshotWithElements: #(b1))).
+ 	merger conflicts do: [:ea | self handleConflict: ea].
+ 	self assert: merger mergedSnapshot definitions hasElements: #(a2 b1).
+ 	self assert: conflicts isEmpty!

Item was added:
+ ----- Method: ClosureCompilerTest>>testInlineBlockCollectionEM1 (in category 'tests') -----
+ testInlineBlockCollectionEM1
+ 	| a1 b1 i1 a2 b2 i2 we wb |
+ 	b1 := OrderedCollection new.
+ 	i1 := 1.
+ 	[a1 := i1.
+ 	 i1 <= 3] whileTrue:
+ 		[b1 add: [a1].
+ 		i1 := i1 + 1].
+ 	b1 := b1 asArray collect: [:b | b value].
+ 	b2 := OrderedCollection new.
+ 	i2 := 1.
+ 	we := [a2 := i2. i2 <= 3].
+ 	wb := [b2 add: [a2]. i2 := i2 + 1].
+ 	we whileTrue: wb. "defeat optimization"
+ 	b2 := b2 asArray collect: [:b | b value].
+ 	self assert: b1 = b2!

Item was added:
+ ----- Method: FileDirectoryTest>>deleteDirectory (in category 'create/delete tests') -----
+ deleteDirectory
+ 	
+ 	(self myDirectory exists) ifTrue:
+ 		[self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName]!

Item was added:
+ TestCase subclass: #MCDependencySorterTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: ExceptionTester>>doSomethingExceptional (in category 'pseudo actions') -----
+ doSomethingExceptional
+ 
+ 	self log: self doSomethingExceptionalString!

Item was added:
+ ----- Method: MCMczInstallerTest>>testInstallFromFile (in category 'as yet unclassified') -----
+ testInstallFromFile
+ 	MCMczWriter fileOut: expected on: self fileStream.
+ 	MczInstaller installFileNamed: self fileName.
+ 	self assertNoChange.!

Item was added:
+ MCTestCase subclass: #MCPackageTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ Notification subclass: #MyTestNotification
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Exceptions'!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testNoSelection (in category 'testing') -----
+ testNoSelection
+ 	self assertAListMatches: self allCategories.
+ 	self denyAListIncludesAnyOf: self definedClasses.
+ 	self denyAListIncludesAnyOf: self allProtocols.
+ 	self denyAListIncludesAnyOf: self allMethods.
+ 	"and if there I need to see the packages scripts (or none)"
+ 	self assertTextIs: '(package defines no scripts)'.!

Item was added:
+ ----- Method: ExceptionTester>>simpleOuterTestResults (in category 'signaledException results') -----
+ simpleOuterTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doYetAnotherThingString;
+ 		add: self doSomethingElseString;
+ 		yourself!

Item was added:
+ ----- Method: MCFileInTest>>testStWriter (in category 'testing') -----
+ testStWriter
+ 	self
+ 		assertFileOutFrom: MCStWriter
+ 		canBeFiledInWith: [stream fileIn].
+ !

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>assertTextIs: (in category 'asserting') -----
+ assertTextIs: aString
+ 	self assert: self textMorph contents = aString.!

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

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesYAtoYM (in category 'tests') -----
+ testDecompilerInClassesYAtoYM
+ 	self decompileClassesSelect: [:cn| cn first = $Y and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCPackageTest>>testUnload (in category 'tests') -----
+ testUnload
+ 	| mock |
+ 	self mockPackage unload.
+ 	self deny: (Smalltalk hasClassNamed: #MCMockClassA).
+ 	self deny: (MCSnapshotTest includesSelector: #mockClassExtension).
+ 
+ 	mock := (Smalltalk at: #MCMock).
+ 	self assert: (mock subclasses detect: [:c | c name = #MCMockClassA] ifNone: []) isNil!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testEmptyLcs3 (in category 'tests') -----
+ testEmptyLcs3
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a b c) and: #(d e f g).
+ 	self assert: patch size = 7.	
+ 	patch do: [ :each |
+ 		each key = #remove ifTrue: [ self assert: ('abc' includes: each value first) ].
+ 		each key = #insert ifTrue: [ self assert: ('defg' includes: each value first) ] ]!

Item was added:
+ ----- Method: ExceptionTester>>basicTestSelectors (in category 'accessing') -----
+ basicTestSelectors
+ 	^ #(#simpleEnsureTest #simpleEnsureTestWithNotification #simpleEnsureTestWithUparrow #simpleEnsureTestWithError #signalFromHandlerActionTest #resumableFallOffTheEndHandler #nonResumableFallOffTheEndHandler #doubleResumeTest #simpleTimeoutWithZeroDurationTest #simpleTimeoutTest simpleNoTimeoutTest)!

Item was added:
+ ----- Method: MCMethodDefinitionTest>>tearDown (in category 'running') -----
+ tearDown
+ 	self restoreMocks.
+ 	(MCWorkingCopy forPackage: (MCPackage named: 'FooBarBaz')) unregister.
+ 	self class compile: 'override ^ 1' classified: 'mocks'.
+ 	self ownPackage modified: isModified!

Item was added:
+ ----- Method: MCMczInstallerTest class>>suite (in category 'as yet unclassified') -----
+ suite
+ 	^ (Smalltalk hasClassNamed: #MczInstaller)
+ 		ifTrue: [super suite]
+ 		ifFalse: [TestSuite new name: self name asString]!

Item was added:
+ ----- Method: ExceptionTester>>simpleIsNestedTestResults (in category 'signaledException results') -----
+ simpleIsNestedTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doYetAnotherThingString;
+ 		add: self doSomethingElseString;
+ 		yourself!

Item was added:
+ ----- Method: MCChangeNotificationTest>>testForeignMethodModified (in category 'tests') -----
+ testForeignMethodModified
+ 	| event |
+ 	workingCopy modified: false.
+ 	event := self modifiedEventFor: #foreignMethod ofClass: self class.
+ 	MCWorkingCopy methodModified: event.
+ 	self deny: workingCopy modified!

Item was added:
+ ----- Method: MCSnapshotBrowserTest class>>resources (in category 'as yet unclassified') -----
+ resources
+ 	^ Array with: MCSnapshotResource!

Item was added:
+ ----- Method: ExceptionTester>>doSomething (in category 'pseudo actions') -----
+ doSomething
+ 
+ 	self log: self doSomethingString!

Item was added:
+ ----- Method: MCMethodDefinitionTest>>testLoadAndUnload (in category 'testing') -----
+ testLoadAndUnload
+ 	|definition|
+ 	definition := self mockMethod: #one class: 'MCMockClassA' source: 'one ^2' meta: false.
+ 	self assert: self mockInstanceA one = 1.
+ 	definition load.
+ 	self assert: self mockInstanceA one = 2.
+ 	definition unload.
+ 	self deny: (self mockInstanceA respondsTo: #one)!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesEAtoEM (in category 'tests') -----
+ testDecompilerInClassesEAtoEM
+ 	self decompileClassesSelect: [:cn| cn first = $E and: [cn second asUppercase <= $M]]!

Item was added:
+ MCTestCase subclass: #MCSnapshotBrowserTest
+ 	instanceVariableNames: 'model morph'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCWorkingCopyTest>>setUp (in category 'running') -----
+ setUp
+ 	| repos1 repos2 |
+ 	self clearPackageCache.
+ 	repositoryGroup := MCRepositoryGroup new.
+ 	workingCopy := MCWorkingCopy forPackage: self mockPackage.
+ 	versions := Dictionary new.
+ 	versions2 := Dictionary new.
+ 	repos1 := MCDictionaryRepository new dictionary: versions.
+ 	repos2 := MCDictionaryRepository new dictionary: versions2.
+ 	repositoryGroup addRepository: repos1.
+ 	repositoryGroup addRepository: repos2.
+ 	MCRepositoryGroup default removeRepository: repos1; removeRepository: repos2.
+ 	workingCopy repositoryGroup: repositoryGroup.
+ 	savedInitials := Utilities authorInitials.
+ 	Utilities setAuthorInitials: 'abc'.!

Item was added:
+ ----- Method: ExceptionTester>>nonResumableFallOffTheEndHandlerResults (in category 'results') -----
+ nonResumableFallOffTheEndHandlerResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doSomethingExceptionalString;
+ 		add: self doYetAnotherThingString;
+ 		yourself!

Item was added:
+ LongTestCase subclass: #DecompilerTests
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!
+ 
+ !DecompilerTests commentStamp: 'sd 9/26/2004 13:24' prior: 0!
+ Apparently the decompiler does not really work totally.
+ Here are a bunch of methods that can help improving the decompiler:
+ 	- blockingClasses return class for which it is impossible to decompile methods 
+ 	- failures are problems that lead to a DNU
+ 	- decompilerDiscrepancies are the results of running decompileTestHelper..as you see the pattern 	
+ 	is quite present.!

Item was added:
+ ----- Method: MCTestCase>>assertPackage:matches: (in category 'asserting') -----
+ assertPackage: actual matches: expected
+ 	self assert: actual = expected
+ !

Item was added:
+ MCTestCase subclass: #MCPatchTest
+ 	instanceVariableNames: 'patch'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesRAtoRM (in category 'tests') -----
+ testDecompilerInClassesRAtoRM
+ 	self decompileClassesSelect: [:cn| cn first = $R and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCStWriterTest>>assertMethodChunkIsWellFormed: (in category 'asserting') -----
+ assertMethodChunkIsWellFormed: chunk
+ 	self class parserClass new
+ 		parse: chunk readStream 
+ 		class: UndefinedObject 
+ 		noPattern: false
+ 		context: nil
+ 		notifying: nil
+ 		ifFail: [self assert: false]!

Item was added:
+ ----- Method: MCMergingTest>>testMultiPackageMerge3 (in category 'tests') -----
+ testMultiPackageMerge3
+ 	| merger |
+ 	conflicts := #().
+ 	merger := MCThreeWayMerger new.
+ 	merger addBaseSnapshot: (self snapshotWithElements: #(a1 b1)).
+ 	merger applyPatch: ((self snapshotWithElements: #(a1 b1)) patchRelativeToBase: (self snapshotWithElements: #(b1))).
+ 	merger applyPatch: ((self snapshotWithElements: #()) patchRelativeToBase: (self snapshotWithElements: #(a1))).
+ 	merger conflicts do: [:ea | self handleConflict: ea].
+ 	self assert: merger mergedSnapshot definitions hasElements: #(a1 b1).
+ 	self assert: conflicts isEmpty!

Item was added:
+ TestCase subclass: #ProcessTerminateBug
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Exceptions'!

Item was added:
+ ----- Method: ClosureTests>>testWhileModificationAfterNotInlined (in category 'testing-while') -----
+ testWhileModificationAfterNotInlined
+ 	| index block |
+ 	index := 0.
+ 	block := [ 
+ 		collection add: [ index ].
+ 		index := index + 1 ].
+ 	[ index < 5 ] whileTrue: block.
+ 	self assertValues: #(5 5 5 5 5)!

Item was added:
+ ----- Method: MCPatchTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ 	|rev1 rev2|
+ 	rev1 :=  MCSnapshotResource takeSnapshot.
+ 	self change: #one toReturn: 2.
+ 	rev2 :=  MCSnapshotResource takeSnapshot.
+ 	patch := rev2 patchRelativeToBase: rev1.
+ 	self change: #one toReturn: 1.!

Item was added:
+ ----- Method: ClosureTests>>testToDoArgumentNotInlined (in category 'testing-todo') -----
+ testToDoArgumentNotInlined
+ 	| block |
+ 	block := [ :index |
+ 		collection add: [ index ] ].
+ 	1 to: 5 do: block.
+ 	self assertValues: #(1 2 3 4 5)!

Item was added:
+ Notification subclass: #ParserRemovedUnusedTemps
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Exceptions'!

Item was added:
+ DecompilerTests subclass: #DecompilerTestFailuresCollector
+ 	instanceVariableNames: 'failures'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!
+ 
+ !DecompilerTestFailuresCollector commentStamp: '<historical>' prior: 0!
+ (| dtfc |
+ dtfc := DecompilerTestFailuresCollector new.
+ (dtfc class superclass organization listAtCategoryNamed: #tests) do:
+ 	[:s| dtfc perform: s].
+ dtfc failures)
+ 
+ (Transcript nextPut: ${.
+ self do: [:mr| Transcript print: mr actualClass; nextPut: $.; space; store: mr methodSymbol; nextPut: $.; cr; flush].
+ Transcript nextPut: $}; flush)
+ 
+ eem 7/1/2009 16:13
+ {AdditionalMethodState. #keysAndValuesDo:.
+ AdditionalMethodState. #propertyKeysAndValuesDo:.
+ AdditionalMethodState. #at:ifAbsent:.
+ AdditionalMethodState. #removeKey:ifAbsent:.
+ AdditionalMethodState. #at:ifAbsentPut:.
+ AdditionalMethodState. #setMethod:.
+ AdditionalMethodState. #at:put:.
+ AdditionalMethodState. #pragmas.
+ AdditionalMethodState. #includesProperty:.
+ AdditionalMethodState. #properties.
+ AdditionalMethodState. #hasLiteralSuchThat:.
+ AdditionalMethodState. #propertyValueAt:ifAbsent:.
+ AdditionalMethodState. #hasLiteralThorough:.
+ Array. #hasLiteralSuchThat:.
+ BitBltSimulation. #initDither8Lookup.
+ BlockNode. #sizeCodeExceptLast:.
+ BlockNode. #emitCodeExceptLast:encoder:.
+ Categorizer. #changeFromCategorySpecs:.
+ Categorizer. #elementCategoryDict.
+ CColorPicker. #colors:.
+ CCustomDrawListCostume. #drawListOn:in:.
+ ChangeList. #browseCurrentVersionsOfSelections.
+ ClosureTests. #testToDoInsideTemp.
+ Cogit. #computeMaximumSizes.
+ Cogit. #outputInstructionsAt:.
+ Cogit. #generateMapAt:start:.
+ CogVMSimulator. #printFrameThing:at:.
+ CogVMSimulator. #str:n:cmp:.
+ CoInterpreter. #validStackPageBaseFrames.
+ CoInterpreter. #markAndTraceTraceLog.
+ CoInterpreter. #mapTraceLog.
+ CoInterpreter. #checkStackIntegrity.
+ CoInterpreter. #mapStackPages.
+ CoInterpreter. #updateStackZoneReferencesToCompiledCodePreCompaction.
+ CoInterpreter. #ceActivateFailingPrimitiveMethod:.
+ CoInterpreterStackPages. #initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom:.
+ CompiledMethod. #=.
+ CompiledMethod. #getPreambleFrom:at:.
+ CompiledMethod. #hasLiteralThorough:.
+ CompiledMethod. #hasLiteralSuchThat:.
+ CPopUpMenuCostume. #drawMenu:on:in:.
+ CroquetParticipant. #dropFiles:.
+ CTextParagraph. #selectionRectsFrom:to:.
+ CWheelWidgetCostume. #drawOn:in:.
+ Dictionary. #scanFor:.
+ Float. #printPaddedWith:to:.
+ FMSound. #mixSampleCount:into:startingAt:leftVol:rightVol:.
+ Form. #transformColors:.
+ FTPClient. #getDataInto:.
+ GIFReadWriter. #nextImageWithPlugin.
+ GraphMorph. #drawDataOn:.
+ GZipReadStream. #on:from:to:.
+ HTTPServiceDispatcher. #errorReportFor:stack:on:.
+ HttpUrl. #checkAuthorization:retry:.
+ Integer. #benchSwitch:.
+ Interpreter. #primitiveClosureValueWithArgs.
+ Interpreter. #primitivePerformAt:.
+ Interpreter. #primitiveDoPrimitiveWithArgs.
+ Interpreter. #primitiveNewMethod.
+ InterpreterStackPages. #initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom:.
+ JPEGReadWriter. #decodeBlockInto:component:dcTable:acTable:.
+ KeyedIdentitySet. #scanFor:.
+ KeyedSet. #scanFor:.
+ LargeIntegersPlugin. #isNormalized:.
+ LargeIntegersPlugin. #cBytesCopyFrom:to:len:.
+ LargeIntegersPlugin. #cDigitMultiply:len:with:len:into:.
+ LiteralDictionary. #scanFor:.
+ LoopedSampledSound. #mixSampleCount:into:startingAt:leftVol:rightVol:.
+ MethodDictionary. #scanFor:.
+ MP4BoxInfoParser. #parseMP4BoxOutput:.
+ MP4BoxNHMLTrack. #computeDTSDeltas.
+ MultiByteBinaryOrTextStream. #next:.
+ MultiByteFileStream. #next:.
+ MViewPane. #reconstructEnabledDocuments.
+ MViewPane. #reconstructOpenDocuments.
+ MViewPane. #reconstructSelectionList.
+ NewParagraph. #selectionRectsFrom:to:.
+ Object. #instanceFields.
+ OldSocket. #getResponseNoLF.
+ PasteUpMorph. #dropFiles:.
+ PlotMorphGrid. #bestStep:.
+ PluckedSound. #reset.
+ PluggableDictionary. #scanFor:.
+ PluggableSet. #scanFor:.
+ PluggableTabButtonMorph. #calculateArcLengths.
+ PluggableTabButtonMorph. #drawTabOn:.
+ PNGReadWriter. #copyPixelsGray:.
+ PNMReadWriter. #readPlainRGB.
+ PNMReadWriter. #readBWreverse:.
+ PNMReadWriter. #nextPutRGB:.
+ PNMReadWriter. #nextPutBW:reverse:.
+ PopUpMenu. #readKeyboard.
+ QFloorFan. #initialize.
+ QMinimalForum. #demoDesksUnused.
+ QNetVidReorderingBuffer. #popFramesForCTS:.
+ QNetVidTrackStreamer. #sampleIndexWithCTS:.
+ QServiceProvider. #statusReport.
+ QServicesPane. #forumMenuInto:.
+ QUserListItem. #drawOn:in:.
+ QVMProfiler. #computeHistograms:.
+ QVMProfiler. #selectSymbolsInRange.
+ QwaqParticipantUI. #onDropFiles:.
+ RelativeInstructionPrinter. #print:.
+ RemoteHandMorph. #appendNewDataToReceiveBuffer.
+ SchizophrenicClosureFormatStackInterpreter. #primitiveClosureValueWithArgs.
+ Set. #do:.
+ Set. #scanFor:.
+ SHParserST80. #isBinary.
+ ShootoutMall. #processVisitors.
+ ShortIntegerArray. #writeOn:.
+ SparseLargeArray. #analyzeSpaceSaving.
+ StackInterpreter. #validStackPageBaseFrames.
+ StackInterpreter. #divorceAllFrames.
+ StackInterpreter. #checkStackIntegrity.
+ StackInterpreter. #primitiveDoPrimitiveWithArgs.
+ StackInterpreter. #reverseDisplayFrom:to:.
+ StackInterpreter. #printOop:.
+ StackInterpreter. #mapStackPages.
+ StackInterpreter. #primitiveNewMethod.
+ StackInterpreter. #primitiveClosureValueWithArgs.
+ StrikeFontSet. #displayStringR2L:on:from:to:at:kern:.
+ String. #howManyMatch:.
+ Text. #asHtmlFragmentTextStyle:useBreaks:.
+ TextURL. #actOnClickFor:.
+ TFractalTerrain. #heightAt:.
+ TFractalTerrain. #makeFaces.
+ TFractalTerrain. #makeVertices.
+ TFractalTerrain. #makeTextureUV.
+ TFractalTerrain. #makeVertexNormals.
+ TFrame. #computeUnionSphere.
+ TMethod. #emitCCommentOn:.
+ TRFBStreamOutput. #handleRequest:.
+ TTCFontReader. #processCharacterMappingTable:.
+ TTContourConstruction. #segmentsDo:.
+ TTensor. #projectionIntegrate:.
+ TTFontReader. #processHorizontalMetricsTable:length:.
+ TTFontReader. #processCharacterMappingTable:.
+ TWaves. #step.
+ Vector. #copyFrom:.
+ Vector. #asVector3.
+ VectorColor. #copyFrom:.
+ WeakKeyDictionary. #scanForNil:.
+ WeakKeyDictionary. #scanFor:.
+ WeakSet. #scanFor:.
+ WeakSet. #scanForLoadedSymbol:.
+ }!

Item was added:
+ MCTestCase subclass: #MCMethodDefinitionTest
+ 	instanceVariableNames: 'navigation isModified'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesKAtoKM (in category 'tests') -----
+ testDecompilerInClassesKAtoKM
+ 	self decompileClassesSelect: [:cn| cn first = $K and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testAnnotationPane (in category 'testing') -----
+ testAnnotationPane
+ 	| oldPref |
+ 	oldPref := Preferences annotationPanes.
+ 
+ 	Preferences disable: #annotationPanes.
+ 	morph := model buildWindow.
+ 	self assert: (self morphsOfClass: TextMorph) size = 1.
+ 
+ 	Preferences enable: #annotationPanes.
+ 	morph := model buildWindow.
+ 	self assert: (self morphsOfClass: TextMorph) size = 2.
+ 
+ 	Preferences setPreference: #annotationPanes toValue: oldPref!

Item was added:
+ ----- Method: MCWorkingCopyTest>>assertNameWhenSavingTo:is: (in category 'asserting') -----
+ assertNameWhenSavingTo: aRepository is: aString
+ 	| name |
+ 	name := nil.
+ 	[aRepository storeVersion: workingCopy newVersion]
+ 		on: MCVersionNameAndMessageRequest
+ 		do: [:n | name := n suggestedName. n resume: (Array with: name with: '')].
+ 	self assert: name = aString!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesXAtoXM (in category 'tests') -----
+ testDecompilerInClassesXAtoXM
+ 	self decompileClassesSelect: [:cn| cn first = $X and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: CompilerExceptionsTest>>testUndefinedVariable (in category 'tests') -----
+ testUndefinedVariable
+ 	self 
+ 		should: 
+ 			[self class 
+ 				compile: 'griffle | goo | ^ goo'
+ 				notifying: self]
+ 		raise: UndefinedVariable!

Item was added:
+ ----- Method: ExceptionTests>>testResumableOuter (in category 'testing-outer') -----
+ testResumableOuter
+ 
+ 	| result |
+ 	result := [Notification signal. 4] 
+ 		on: Notification 
+ 		do: [:ex | ex outer. ex return: 5].
+ 	self assert: result == 5
+ !

Item was added:
+ ----- Method: MCMethodDefinitionTest>>testPartiallyRevertOverrideMethod (in category 'testing') -----
+ testPartiallyRevertOverrideMethod
+ 	| definition |
+ 	self class compile: 'override ^ 2' classified: '*foobarbaz'.
+ 	self class compile: 'override ^ 3' classified: self mockOverrideMethodCategory.
+ 	self class compile: 'override ^ 4' classified: self mockOverrideMethodCategory.
+ 	definition := (MethodReference class: self class selector: #override) asMethodDefinition.
+ 	self assert: definition isOverrideMethod.
+ 	self assert: self override = 4.
+ 	definition unload.
+ 	self assert: self override = 2.
+ 	self assert: (MethodReference class: self class selector: #override) category = '*foobarbaz'.
+ 	!

Item was added:
+ ----- Method: MCAncestryTest>>assertPathTo:is: (in category 'asserting') -----
+ assertPathTo: aSymbol is: anArray
+ 	self
+ 		assertNamesOf: (self tree allAncestorsOnPathTo: (self treeFrom: {aSymbol}))
+ 		are: anArray!

Item was added:
+ ----- Method: ClosureTests>>testWhileWithTemp (in category 'testing-while') -----
+ testWhileWithTemp
+ 	| index |
+ 	index := 0.
+ 	[ index < 5 ] whileTrue: [
+ 		| temp |
+ 		temp := index := index + 1.
+ 		collection add: [ temp ] ].
+ 	self assertValues: #(1 2 3 4 5)!

Item was added:
+ ----- Method: MCSnapshotResource class>>mockPackageName (in category 'as yet unclassified') -----
+ mockPackageName
+ 	^ MCMockPackageInfo new packageName!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testIfSequence4 (in category 'tests') -----
+ testIfSequence4
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a b c d) and: #(d b c a).
+ 	self assert: patch size = 6.	"lcs is bc"
+ 	self assert: (patch count: [ :each | each key = #match ]) = 2.
+ 	self assert: (patch count: [ :each | each key = #insert ]) = 2.
+ 	self assert: (patch count: [ :each | each key = #remove ]) = 2.
+ 	patch do: [ :each | 
+ 		each key = #match 
+ 			ifTrue: [ self assert: ('bc' includes: each value first) ]
+ 			ifFalse: [ self assert: ('ad' includes: each value first) ] ]!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testThreeButtons (in category 'testing') -----
+ testThreeButtons
+ 	self assertButtonExists: 'instance'.
+ 	self assertButtonExists: '?'.
+ 	self assertButtonExists: 'class'.!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testAncestorMerge (in category 'tests') -----
+ testAncestorMerge
+ 	| base revA revB revC |
+ 
+ 	base := self snapshot.
+ 	self change: #a toReturn: 'a1'.
+ 	revA :=  self snapshot.
+ 	self change: #b toReturn: 'b1'.
+ 	revB :=  self snapshot.	
+ 	self change: #c toReturn: 'c1'.
+ 	revC :=  self snapshot.	
+ 
+ 	self should: [self basicMerge: revA] raise: MCNoChangesException.
+ 	!

Item was added:
+ ----- Method: MCWorkingCopyTest>>snapshot (in category 'actions') -----
+ snapshot
+ 	| version |
+ 	[version := workingCopy newVersion]
+ 		on: MCVersionNameAndMessageRequest
+ 		do: [:n | n resume: (Array with: n suggestedName with: '')].
+ 	versions at: version info put: version.
+ 	^ version!

Item was added:
+ ----- Method: MCVersionTest>>testDependencyOrder (in category 'tests') -----
+ testDependencyOrder
+ 	self 
+ 		assert: #allDependenciesDo: 
+ 		orders: #(a (b c)) 
+ 		as: #(b c)!

Item was added:
+ ----- Method: DecompilerTests>>isFailure:sel: (in category 'utilities') -----
+ isFailure: cls sel: selector 
+ 	"self new isKnowProblem: PNMReaderWriter sel: #nextImage"
+ 	"#((PNMReadWriter nextImage)) includes: {PNMReadWriter
+ 	name asSymbol . #nextImage}."
+ 	^(#(#DoIt #DoItIn:) includes: selector)
+ 	   or: [self decompilerFailures includes: {cls name asSymbol. selector}]!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesDAtoDM (in category 'tests') -----
+ testDecompilerInClassesDAtoDM
+ 	self decompileClassesSelect: [:cn| cn first = $D and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- 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 added:
+ ----- Method: MCInitializationTest>>tearDown (in category 'as yet unclassified') -----
+ tearDown
+ 	(MCWorkingCopy forPackage: self mockPackage) unregister!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>selectMockClassA (in category 'selecting') -----
+ selectMockClassA
+ 	self clickOnListItem: self mockCategoryName.
+ 	self clickOnListItem: 'MCMockClassA'.
+ 	!

Item was added:
+ ----- Method: ClosureTests>>testWhileModificationBefore (in category 'testing-while') -----
+ testWhileModificationBefore
+ 	| index |
+ 	index := 0.
+ 	[ index < 5 ] whileTrue: [ 
+ 		index := index + 1.
+ 		collection add: [ index ] ].
+ 	self assertValues: #(5 5 5 5 5)!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesPNtoPZ (in category 'tests') -----
+ testDecompilerInClassesPNtoPZ
+ 	self decompileClassesSelect: [:cn| cn first = $P and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MirrorPrimitiveTests>>testMirrorAt (in category 'tests') -----
+ testMirrorAt
+ 	| stackpBefore stackpAfter array byteArray |
+ 	stackpBefore := thisContext stackPtr.
+ 	array := { 1. 2. 3 }.
+ 	byteArray := ByteArray with: 1 with: 2 with: 3.
+ 	self assert: (thisContext object: array basicAt: 1) = 1.
+ 	self assert: (thisContext object: byteArray basicAt: 2) = 2.
+ 	thisContext object: array basicAt: 2 put: #two.
+ 	self assert: array = #(1 #two 3).
+ 	thisContext object: byteArray basicAt: 2 put: 222.
+ 	self assert: byteArray asArray = #(1 222 3).
+ 	stackpAfter := thisContext stackPtr.
+ 	self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments"
+ 	self should: [thisContext object: array basicAt: 4] raise: Error.
+ 	self should: [thisContext object: byteArray basicAt: 0] raise: Error.
+ 	self should: [thisContext object: byteArray basicAt: 1 put: -1] raise: Error!

Item was added:
+ ----- 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 added:
+ ----- Method: ExceptionTester>>doublePassOuterTestResults (in category 'signaledException results') -----
+ doublePassOuterTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doYetAnotherThingString;
+ 		add: self doSomethingElseString;
+ 		yourself!

Item was added:
+ ----- 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 added:
+ ----- Method: MCSnapshotBrowserTest>>annotationTextMorph (in category 'morphic') -----
+ annotationTextMorph
+ 	^ (self morphsOfClass: TextMorph) first!

Item was added:
+ ----- Method: ExceptionTester>>simpleOuterTest (in category 'signaledException tests') -----
+ simpleOuterTest
+ 	"uses #resume"
+ 
+ 	[[self doSomething.
+ 	MyTestNotification signal.
+ 	"self doSomethingElse"
+ 	self doSomethingExceptional]
+ 		on: MyTestNotification
+ 		do: [:ex | ex outer. self doSomethingElse]]
+ 				on: MyTestNotification
+ 				do: [:ex | self doYetAnotherThing. ex resume]!

Item was added:
+ ----- Method: MCSnapshotResource>>snapshot (in category 'as yet unclassified') -----
+ snapshot
+ 	^ snapshot!

Item was added:
+ ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'as yet unclassified') -----
+ testKindOfSubclass
+ 	| classes |
+ 	classes := {self mockClassA. String. MethodContext. WeakArray. Float}.
+ 	classes do: [:c | | d |
+ 		d :=  c asClassDefinition.
+ 		self assert: d kindOfSubclass = c kindOfSubclass.
+ 	].!

Item was added:
+ ----- Method: FileDirectoryTest>>myLocalDirectoryName (in category 'resources') -----
+ myLocalDirectoryName
+ 
+ 	^'zTestDir'!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFullNameFor (in category 'as yet unclassified') -----
+ testFullNameFor
+ 	"Hoping that you have 'C:' of course..."
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	self assert: (FileDirectory default fullNameFor: 'C:') = 'C:'.
+ 	self assert: (FileDirectory default fullNameFor: 'C:\test') = 'C:\test'.
+ 	self assert: (FileDirectory default fullNameFor: '\\share') = '\\share'.
+ 	self assert: (FileDirectory default fullNameFor: '\\share\test') = '\\share\test'.
+ 	self assert: (FileDirectory default fullNameFor: '\test') = (FileDirectory default pathParts first, '\test').
+ !

Item was added:
+ ----- Method: ClosureCompilerTest class>>methodWithVariousTemps (in category 'code examples') -----
+ methodWithVariousTemps
+ 	| classes total totalLength |
+ 	classes := self withAllSuperclasses.
+ 	total := totalLength := 0.
+ 	classes do: [:class| | className |
+ 		className := class name.
+ 		total := total + 1.
+ 		totalLength := totalLength + className size].
+ 	^total -> totalLength
+ 
+ 	"Parser new
+ 		parse: (self class sourceCodeAt: #methodWithVariousTemps)
+ 		class: self class"!

Item was added:
+ ----- Method: ExceptionTester>>testString (in category 'accessing') -----
+ testString
+ 
+ 	^'This is only a test.'!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleEnsure (in category 'testing-ExceptionTester') -----
+ testSimpleEnsure
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTest ) !

Item was added:
+ ----- Method: DosFileDirectoryTests>>testIsDriveForShare (in category 'as yet unclassified') -----
+ testIsDriveForShare
+ 	self assert: (DosFileDirectory isDrive: '\\server').
+ 	self deny: (DosFileDirectory isDrive: '\\server\').
+ 	self deny: (DosFileDirectory isDrive: '\\server\foo').
+ !

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testCategorySelected (in category 'testing') -----
+ testCategorySelected
+ 	self clickOnListItem: self mockCategoryName.
+ 	
+ 	self assertAListMatches: self allCategories.
+ 	self assertAListMatches: self definedClasses.
+ 	self denyAListIncludesAnyOf: self allProtocols.
+ 	self denyAListIncludesAnyOf: self allMethods.
+ 	self assertTextIs: ''.!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesINtoIZ (in category 'tests') -----
+ testDecompilerInClassesINtoIZ
+ 	self decompileClassesSelect: [:cn| cn first = $I and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>classAClassProtocols (in category 'private') -----
+ classAClassProtocols
+ 	^ self protocolsForClass: self mockClassA class.!

Item was added:
+ ----- Method: ClosureTests>>evaluateCopyOf: (in category 'utilities') -----
+ evaluateCopyOf: aBlock
+ 	aBlock copy value!

Item was added:
+ ----- 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 added:
+ ----- Method: ExpandedSourceFileArrayTest>>testChangesFileAddressRange (in category 'testing') -----
+ testChangesFileAddressRange
+ 	"Test file position to source pointer address translation for the changes file"
+ 	
+ 	| sf i p a a2 |
+ 	sf := ExpandedSourceFileArray new.
+ 	(0 to: 16r1FFFFFFF by: 4093) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		i := sf fileIndexFromSourcePointer: a.
+ 		self assert: i == 2.
+ 		p := sf filePositionFromSourcePointer: a.
+ 		self assert: p = e.
+ 		a2 := sf sourcePointerFromFileIndex: 2 andPosition: p.
+ 		self assert: a2 = a].
+ 	(0 to: 16rFFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16r2000000 and: 16r2FFFFFF)].
+ 	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16r4000000 and: 16r4FFFFFF)].
+ 	(16r2000000 to: 16r2FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16r6000000 and: 16r6FFFFFF)].
+ 	(16r3000000 to: 16r3FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16r8000000 and: 16r8FFFFFF)].
+ 	(16r4000000 to: 16r4FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16rA000000 and: 16rAFFFFFF)].
+ 	(16r5000000 to: 16r5FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16rC000000 and: 16rCFFFFFF)].
+ 	(16r6000000 to: 16r6FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16rE000000 and: 16rEFFFFFF)].
+ 	(16r7000000 to: 16r7FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
+ 		self assert: (a between: 16r10000000 and: 16r10FFFFFF)]
+ 
+ 
+ 
+ !

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesVNtoVZ (in category 'tests') -----
+ testDecompilerInClassesVNtoVZ
+ 	self decompileClassesSelect: [:cn| cn first = $V and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCTestCase>>mockVersion (in category 'mocks') -----
+ mockVersion
+ 	^ MCVersion 
+ 		package: self mockPackage
+ 		info: self mockVersionInfo
+ 		snapshot: self mockSnapshot!

Item was added:
+ ----- Method: DecompilerTests>>decompileClassesSelect: (in category 'utilities') -----
+ decompileClassesSelect: aBlock
+ 	
+ 	(Smalltalk classNames select: aBlock) do:
+ 		[:cn | | cls |
+ 		cls := Smalltalk at: cn.
+ 		Smalltalk garbageCollect.
+ 		 Transcript cr; show: cn.
+ 		 cls selectorsDo:
+ 			[:selector | | methodNode oldMethod newMethod oldCodeString newCodeString |
+ 			(self isFailure: cls sel: selector) ifFalse:
+ 				[" to help making progress
+ 					(self
+ 						isStoredProblems: cls theNonMetaClass
+ 						sel: selector
+ 						meta: cls isMeta)
+ 					ifFalse: [ "
+ 				Transcript nextPut: $.; flush.
+ 				self checkDecompileMethod: (cls compiledMethodAt: selector)]]]!

Item was added:
+ ----- Method: ClosureCompilerTest>>testSourceRangeAccessForBlueBookLongFormInjectInto (in category 'tests') -----
+ testSourceRangeAccessForBlueBookLongFormInjectInto
+ 	"Test debugger source range selection for inject:into: for a version compiled with closures"
+ 	"self new testSourceRangeAccessForBlueBookLongFormInjectInto"
+ 	| source method |
+ 	source := (Collection sourceCodeAt: #inject:into:) asString.
+ 	method := (Parser new
+ 						encoderClass: EncoderForLongFormV3;
+ 						parse: source
+ 						class: Collection)
+ 					generate: (Collection compiledMethodAt: #inject:into:) trailer.
+ 	self supportTestSourceRangeAccessForInjectInto: method source: source!

Item was added:
+ ----- Method: MCTestCase>>mockInstanceA (in category 'mocks') -----
+ mockInstanceA
+ 	^ self mockClassA new!

Item was added:
+ ----- Method: MCStWriterTest>>expectedOrganizationDefinition (in category 'data') -----
+ expectedOrganizationDefinition
+ 	^ 'SystemOrganization addCategory: ''Monticello-Mocks''!!
+ '!

Item was added:
+ ----- Method: CompilerExceptionsTest>>testUnknownSelector (in category 'tests') -----
+ testUnknownSelector
+ 	self 
+ 		should: 
+ 			[self class 
+ 				compile: 'griffle self reallyHopeThisIsntImplementedAnywhere'
+ 				notifying: self]
+ 		raise: UnknownSelector!

Item was added:
+ ----- Method: ExceptionTests>>testSignalFromHandlerActionTest (in category 'testing-ExceptionTester') -----
+ testSignalFromHandlerActionTest
+ 	self assertSuccess: (ExceptionTester new runTest: #signalFromHandlerActionTest ) !

Item was added:
+ ----- Method: EventManagerTest>>testNoValueSupplierHasArguments (in category 'running-broadcast query') -----
+ testNoValueSupplierHasArguments
+ 
+ 	succeeded := eventSource 
+ 		triggerEvent: #needsValue:
+ 		with: 'nelja'
+ 		ifNotHandled: [true].
+ 	self should: [succeeded]!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testRedundantMerge (in category 'tests') -----
+ testRedundantMerge
+ 	| base |
+ 	base :=  self snapshot.
+ 	self merge: base.
+ 	self shouldnt: [self merge: base] raise: Error.!

Item was added:
+ ----- Method: CompilerExceptionsTest>>unusedVariableSource (in category 'private') -----
+ unusedVariableSource
+ 	^ 'griffle 
+ 		| goo |
+ 		^ nil'!

Item was added:
+ ----- Method: MCTestCase class>>resources (in category 'as yet unclassified') -----
+ resources
+ 	^ Array with: MCSnapshotResource!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesBNtoBZ (in category 'tests') -----
+ testDecompilerInClassesBNtoBZ
+ 	self decompileClassesSelect: [:cn| cn first = $B and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: ClosureTests>>testWhileWithTempNotInlined (in category 'testing-while') -----
+ testWhileWithTempNotInlined
+ 	| index block |
+ 	index := 0.
+ 	block := [
+ 		| temp |
+ 		temp := index := index + 1.
+ 		collection add: [ temp ] ].
+ 	[ index < 5 ] whileTrue: block.
+ 	self assertValues: #(1 2 3 4 5)!

Item was added:
+ ----- Method: MCScannerTest>>test1 (in category 'tests') -----
+ test1
+ 	self assertScans: #(a '23' (x))!

Item was added:
+ ----- Method: ExceptionTests>>testNonResumableOuter (in category 'testing-outer') -----
+ testNonResumableOuter
+ 
+ 	self should: [
+ 		[Error signal. 4] 
+ 			on: Error 
+ 			do: [:ex | ex outer. ex return: 5]
+ 		] raise: Error
+ !

Item was added:
+ ----- Method: MCFileInTest>>setUp (in category 'running') -----
+ setUp
+ 	expected := self mockSnapshot.
+ 	stream := RWBinaryOrTextStream on: String new.!

Item was added:
+ ----- Method: MCTestCase>>mockCategoryName (in category 'mocks') -----
+ mockCategoryName
+ 	^ 'Monticello-Mocks'!

Item was added:
+ ----- Method: MCFileInTest>>assertNoChange (in category 'asserting') -----
+ assertNoChange
+ 	| actual |
+ 	actual := MCSnapshotResource takeSnapshot.
+ 	diff := actual patchRelativeToBase: expected.
+ 	self assert: diff isEmpty!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesONtoOZ (in category 'tests') -----
+ testDecompilerInClassesONtoOZ
+ 	self decompileClassesSelect: [:cn| cn first = $O and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: ExpandedSourceFileArrayTest>>testCompatibilityWithStandardSourceFileArray (in category 'testing') -----
+ testCompatibilityWithStandardSourceFileArray
+ 	"Test compatibility with StandardSourceFileArray across the address range of
+ 	StandardSourceFileArray, including the unused address space below 16r1000000"
+ 	
+ 	| ssf esf i1 i2 p1 p2 a1 a2 |
+ 	ssf := StandardSourceFileArray new.
+ 	esf := ExpandedSourceFileArray new.
+ 	(0 to: 16rFFFFFF by: 811) do: [:e |
+ 		i1 := ssf fileIndexFromSourcePointer: e.
+ 		i2 := esf fileIndexFromSourcePointer: e.
+ 		self assert: i1 = i2.
+ 		self assert: i1 = 0. "This is unused address space"
+ 		p1 := ssf filePositionFromSourcePointer: e.
+ 		p2 := esf filePositionFromSourcePointer: e.
+ 		self assert: p1 = p2].
+ 	(16r4FFFFFF to: 16r4FFFFFF by: 811) do: [:e |
+ 		i1 := ssf fileIndexFromSourcePointer: e.
+ 		i2 := esf fileIndexFromSourcePointer: e.
+ 		self assert: i1 = i2.
+ 		p1 := ssf filePositionFromSourcePointer: e.
+ 		p2 := esf filePositionFromSourcePointer: e.
+ 		self assert: p1 = p2.
+ 		a1 := ssf sourcePointerFromFileIndex: i1 andPosition: p1.
+ 		a2 := esf sourcePointerFromFileIndex: i2 andPosition: p2.
+ 		self assert: a1 = a2.
+ 		self assert: a1= e]
+ 
+ !

Item was added:
+ ----- Method: MCDependencySorterTest>>assertItems:orderAs:withRequired:toLoad: (in category 'asserting') -----
+ assertItems: anArray orderAs: depOrder withRequired: missingDeps toLoad: unloadableItems
+ 	self assertItems: anArray orderAs: depOrder withRequired: missingDeps  toLoad: unloadableItems  extraProvisions: #()!

Item was added:
+ ----- Method: MCSnapshotTest>>setUp (in category 'running') -----
+ setUp
+ 	snapshot :=  self mockSnapshot.!

Item was added:
+ ----- Method: ExceptionTester>>simpleEnsureTestWithUparrow (in category 'tests') -----
+ simpleEnsureTestWithUparrow
+ 
+ 	[self doSomething.
+ 	true ifTrue: [^nil].
+ 	self doSomethingElse]
+ 		ensure:
+ 			[self doYetAnotherThing].
+ 	!

Item was added:
+ ----- Method: MCSerializationTest>>testMczSerialization (in category 'testing') -----
+ testMczSerialization
+ 	self assertVersionsMatchWith: MCMczWriter.
+ 	self assertExtensionProvidedBy: MCMczWriter.
+ 	self assertVersionInfosMatchWith: MCMczWriter.
+ 	self assertDependenciesMatchWith: MCMczWriter.!

Item was added:
+ ----- Method: MCRepositoryTest>>saveSnapshot1 (in category 'actions') -----
+ saveSnapshot1
+ 	^ self saveSnapshot: self snapshot1 named: 'rev1'!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>findButtonWithLabel: (in category 'morphic') -----
+ findButtonWithLabel: aString
+ 	^ self buttonMorphs detect: [:m | m label = aString]!

Item was added:
+ ----- Method: MCSortingTest>>methodNamed:class:meta: (in category 'building') -----
+ methodNamed: aSymbol class: className meta: aBoolean
+ 	^ MCMethodDefinition
+ 		className: className
+ 		classIsMeta: aBoolean
+ 		selector: aSymbol
+ 		category: ''
+ 		timeStamp: ''
+ 		source: ''!

Item was added:
+ ----- Method: MCVersionTest>>testAllUnresolved (in category 'tests') -----
+ testAllUnresolved
+ 	self 
+ 		assert: #allDependenciesDo:ifUnresolved: 
+ 		orders: #(a ((b (d e)) (c missing)))
+ 		as: #(d e b)
+ 		unresolved: #(c)!

Item was added:
+ ----- Method: ExceptionTester>>doubleOuterTest (in category 'signaledException tests') -----
+ doubleOuterTest
+ 	"uses #resume"
+ 
+ 	[[[self doSomething.
+ 	MyTestNotification signal.
+ 	self doSomethingExceptional]
+ 		on: MyTestNotification
+ 		do: [:ex | ex outer.
+ 			self doSomethingExceptional]]
+ 			on: MyTestNotification
+ 			do: [:ex | ex outer.
+ 				self doSomethingElse]]
+ 				on: MyTestNotification
+ 				do: [:ex | self doYetAnotherThing. ex resume]!

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

Item was added:
+ ----- Method: ClosureCompilerTest>>testSourceRangeAccessForClosureBytecodeInjectInto (in category 'tests') -----
+ testSourceRangeAccessForClosureBytecodeInjectInto
+ 	"Test debugger source range selection for inject:into: for a version compiled with closures"
+ 	"self new testSourceRangeAccessForClosureBytecodeInjectInto"
+ 	| source method |
+ 	source := (Collection sourceCodeAt: #inject:into:) asString.
+ 	method := (Parser new
+ 						encoderClass: EncoderForV3PlusClosures;
+ 						parse: source
+ 						class: Collection)
+ 					generate: (Collection compiledMethodAt: #inject:into:) trailer.
+ 	self supportTestSourceRangeAccessForInjectInto: method source: source!

Item was added:
+ ----- Method: ClosureCompilerTest>>testInlineBlockCollectionLR2 (in category 'tests') -----
+ testInlineBlockCollectionLR2
+ 	"Test case from Lukas Renggli"
+ 	| col |
+ 	col := OrderedCollection new.
+ 	1 to: 11 do: [ :each | #(1) do: [:ignored| col add: [ each ]] ].
+ 	self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesHNtoHZ (in category 'tests') -----
+ testDecompilerInClassesHNtoHZ
+ 	self decompileClassesSelect: [:cn| cn first = $H and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCDependencySorterTest>>testMultiRequirementOrdering (in category 'tests') -----
+ testMultiRequirementOrdering
+ 	self assertItems: #(
+ 		(a (x) (z))
+ 		(b (y) ())
+ 		(c (z) ())
+ 		(d () (x y z)))
+ 		orderAs: #(b c a d)
+ 		withRequired: #()
+ 		toLoad: #()!

Item was added:
+ ----- Method: ClosureTests>>testToDoArgument (in category 'testing-todo') -----
+ testToDoArgument
+ 	1 to: 5 do: [ :index |
+ 		collection add: [ index ] ].
+ 	self assertValues: #(1 2 3 4 5)!

Item was added:
+ ----- Method: MCDependencySorterTest>>testSimpleOrdering (in category 'tests') -----
+ testSimpleOrdering
+ 	self assertItems: #((a (x) ())
+ 								 (c () (y))
+ 								 (b (y) (x)))
+ 		orderAs: #(a b c)
+ 		withRequired: #()
+ 		toLoad: #()!

Item was added:
+ ----- Method: MCVersionTest>>dependencyFromTree: (in category 'building') -----
+ dependencyFromTree: sexpr
+ 	^ MCMockDependency fromTree: sexpr!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>denyButtonOn: (in category 'asserting') -----
+ denyButtonOn: aString
+ 	self deny: (self findButtonWithLabel: aString) getModelState.
+ 	!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryLocalName (in category 'as yet unclassified') -----
+ testFileDirectoryLocalName
+ 	"Hoping that you have 'C:' of course..."
+ 	| fd |
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	fd := FileDirectory on: 'C:'.
+ 	self assert: fd localName = 'C:'.
+ !

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>falsehoodMethodSource (in category 'private') -----
+ falsehoodMethodSource
+ 	^ 'falsehood
+ 	^ false'!

Item was added:
+ ----- Method: MCAncestryTest>>testLinearPath (in category 'tests') -----
+ testLinearPath
+ 	self assertPathTo: #b1 is: #(b3 b2)!

Item was added:
+ ----- Method: ClosureCompilerTest class>>methodWithCopiedAndAssignedTemps (in category 'code examples') -----
+ methodWithCopiedAndAssignedTemps
+ 	| blk "0w" a "0w" b "0w" c "0w" t "0w" r1 "0w" r2 "0w" |
+ 	a := 1. "1w"
+ 	b := 2. "1w"
+ 	c := 4. "1w"
+ 	t := 0. "1w"
+ 	blk "5w" := ["2" t  "3w" := t "3r" + a "3r" + b "3r" + c "3r" ] "4".
+ 	r1 "5w" := blk "5r" value.
+ 	b "5w" := -100.
+ 	r2 "5w" := blk "5r" value.
+ 	^r1 "5r" -> r2 "5r" -> t "5r"
+ 
+ 	"a: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read
+ 	 b: main(read(),write(0,1,5)), block(read(3),write()) => remote; write follows contained read
+ 	 blk: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5
+ 	 c: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read
+ 	 r1: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5
+ 	 r2: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5
+ 	 t: main(read(5),write(0,1)), block(read(3),write(3)) => remote; read follows contained write"
+ 
+ 
+ 	"(Parser new
+ 		encoderClass: EncoderForV3;
+ 		parse: (self class sourceCodeAt: #methodWithCopiedAndAssignedTemps)
+ 		class: self class) generateUsingClosures: #(0 0 0 0)"!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testComment (in category 'testing') -----
+ testComment
+ 	self clickOnButton: '?'.
+ 	self assertTextIs: ''.
+ 	
+ 	self clickOnListItem: self mockCategoryName.
+ 	self assertTextIs: ''.
+ 	
+ 	self clickOnListItem: 'MCMockClassA'.
+ 	self assertTextIs: self classAComment.!

Item was added:
+ ----- Method: FileDirectoryTest>>testDirectoryNamed (in category 'existence tests') -----
+ testDirectoryNamed
+ 
+ 	self should: [(self myDirectory containingDirectory 
+ 					directoryNamed: self myLocalDirectoryName) pathName 
+ 						= self myDirectory pathName]!

Item was added:
+ ----- Method: MCScannerTest>>test5 (in category 'tests') -----
+ test5
+ 	self assertScans: #((a) b)!

Item was added:
+ Error subclass: #MyTestError
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Exceptions'!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryContainingEntry (in category 'as yet unclassified') -----
+ testFileDirectoryContainingEntry
+ 	"Hoping that you have 'C:' of course..."
+ 	| fd |
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	fd := FileDirectory on: 'C:'.
+ 	self assert: (fd containingDirectory entryAt: fd localName) notNil.
+ !

Item was added:
+ ----- Method: MCClassDefinitionTest>>testEquals (in category 'as yet unclassified') -----
+ testEquals
+ 	| a b |
+ 	a := self mockClass: 'ClassA' super: 'SuperA'.
+ 	b := self mockClass: 'ClassA' super: 'SuperA'.
+ 	self assert: a = b!

Item was added:
+ ----- Method: MCStWriterTest>>assertContentsOf:match: (in category 'asserting') -----
+ assertContentsOf: strm match: expected 
+ 	| actual |
+ 	actual := strm contents.
+ 	self assert: actual size = expected size.
+ 	actual with: expected do: [:a :e | self assert: a = e]!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testSelectiveBackport (in category 'tests') -----
+ testSelectiveBackport
+ 	| inst base intermediate final |
+ 	inst := self mockInstanceA.
+ 	base :=  self snapshot.
+ 	self assert: inst one = 1.
+ 	self change: #one toReturn: 2.
+ 	intermediate := self snapshot.
+ 	self change: #two toReturn: 3.
+ 	final := self snapshot.
+ 	[workingCopy backportChangesTo: base info]
+ 		on: MCChangeSelectionRequest
+ 		do: [:e | | selected patch |
+ 			patch := e patch.
+ 			selected := patch operations select: [:ea | ea definition selector = #two].
+ 			e resume: (MCPatch operations: selected)]. 
+ 	self assert: inst one = 1.
+ 	self assert: inst two = 3.
+ 	self assert: workingCopy ancestry ancestors size = 1.
+ 	self assert: workingCopy ancestry ancestors first = base info.
+ 	self assert: workingCopy ancestry stepChildren size = 1.
+ 	self assert: workingCopy ancestry stepChildren first = final info!

Item was added:
+ ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'as yet unclassified') -----
+ testCannotLoad
+ 	| d |
+ 	d :=  self mockClass: 'MCMockClassC' super: 'NotAnObject'.
+ 	self should: [d load] raise: Error.
+ 	self deny: (Smalltalk hasClassNamed: 'MCMockClassC').!

Item was added:
+ ----- Method: CompilerExceptionsTest>>text (in category 'emulating') -----
+ text
+ 	^ self unusedVariableSource!

Item was added:
+ TestCase subclass: #ContextCompilationTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Compiler'!

Item was added:
+ ----- Method: ClosureCompilerTest>>testInjectIntoDecompilations (in category 'tests') -----
+ testInjectIntoDecompilations
+ 	"Test various compilations decompile to the same code for a method sufficiently
+ 	 simple that this is possible and sufficiently complex that the code generated
+ 	 varies between the compilations."
+ 	"self new testInjectIntoDecompilations"
+ 	| source |
+ 	source := (Collection sourceCodeAt: #inject:into:) asString.
+ 	{ Encoder.
+ 	   EncoderForV3. EncoderForLongFormV3.
+ 	   EncoderForV3PlusClosures. EncoderForLongFormV3PlusClosures } do:
+ 		[:encoderClass| | method |
+ 		method := (Parser new
+ 							encoderClass: encoderClass;
+ 							parse: source
+ 							class: Collection)
+ 						generate.
+ 		self assert: (Scanner new scanTokens: method decompileString)
+ 					= #(inject: t1 into: t2
+ 							| t3 |
+ 							t3 ':=' t1 .
+ 							self do: [ ':t4' | t3 ':=' t2 value: t3 value: t4 ] .
+ 							^ t3)]!

Item was added:
+ ClassTestCase subclass: #FileDirectoryTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Files'!

Item was added:
+ MCRepositoryTest subclass: #MCDictionaryRepositoryTest
+ 	instanceVariableNames: 'dict'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCTestCase>>assertSnapshot:matches: (in category 'asserting') -----
+ assertSnapshot: actual matches: expected
+ 	| diff |
+ 	diff := actual patchRelativeToBase: expected.
+ 	self assert: diff isEmpty
+ !

Item was added:
+ ----- Method: ClosureCompilerTest>>testBlockNumberingForInjectInto (in category 'tests') -----
+ testBlockNumberingForInjectInto
+ 	"Test that the compiler and CompiledMethod agree on the block numbering of Collection>>inject:into:
+ 	 and that temp names for inject:into: are recorded."
+ 	"self new testBlockNumberingForInjectInto"
+ 	| methodNode method tempRefs |
+ 	methodNode := Parser new
+ 						encoderClass: EncoderForV3PlusClosures;
+ 						parse: (Collection sourceCodeAt: #inject:into:)
+ 						class: Collection.
+ 	method := methodNode generate.
+ 	tempRefs := methodNode encoder blockExtentsToTempsMap.
+ 	self assert: tempRefs keys asSet = method startpcsToBlockExtents values asSet.
+ 	self assert: ((tempRefs includesKey: (0 to: 6))
+ 				and: [(tempRefs at: (0 to: 6)) hasEqualElements: #(('thisValue' 1) ('binaryBlock' 2) ('nextValue' (3 1)))]).
+ 	self assert: ((tempRefs includesKey: (2 to: 4))
+ 				and: [(tempRefs at: (2 to: 4)) hasEqualElements: #(('each' 1) ('binaryBlock' 2) ('nextValue' (3 1)))])!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testClassSelected (in category 'testing') -----
+ testClassSelected
+ 	self selectMockClassA.
+ 	
+ 	self assertAListMatches: self allCategories.
+ 	self assertAListMatches: self definedClasses.
+ 	self assertAListMatches: self classAProtocols.
+ 	self denyAListIncludesAnyOf: self allMethods.
+ 	self assertTextIs: self classADefinitionString.!

Item was added:
+ ----- 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 added:
+ ----- Method: MCRepositoryTest>>snapshot1 (in category 'building') -----
+ snapshot1
+ 	^ (MCSnapshot fromDefinitions: (Array with: (MCOrganizationDefinition categories: #('y'))))!

Item was added:
+ ----- Method: CompilerExceptionsTest>>testUnusedVariable (in category 'tests') -----
+ testUnusedVariable
+ 	self 
+ 		should: 
+ 			[self class 
+ 				compile: self unusedVariableSource
+ 				notifying: self]
+ 		raise: UnusedVariable!

Item was added:
+ ----- Method: MCTestCase>>commentForClass: (in category 'mocks') -----
+ commentForClass: name
+ 	^ 'This is a comment for ', name!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesUAtoUM (in category 'tests') -----
+ testDecompilerInClassesUAtoUM
+ 	self decompileClassesSelect: [:cn| cn first = $U and: [cn second asUppercase <= $M]]!

Item was added:
+ TestCase subclass: #MacFileDirectoryTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Files'!

Item was added:
+ ----- Method: StandardSystemFontsTest>>saveStandardSystemFontsDuring: (in category 'utilities') -----
+ saveStandardSystemFontsDuring: aBlock
+ 	| standardDefaultTextFont standardListFont standardEToysFont standardMenuFont 
+ 	windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont |
+ 
+ 	standardDefaultTextFont := Preferences standardDefaultTextFont.
+ 	standardListFont := Preferences standardListFont.
+ 	standardEToysFont := Preferences standardEToysFont.
+ 	standardMenuFont := Preferences standardMenuFont.
+ 	windowTitleFont := Preferences windowTitleFont.
+ 	standardBalloonHelpFont := Preferences standardBalloonHelpFont.
+ 	standardCodeFont := Preferences standardCodeFont.
+ 	standardButtonFont := Preferences standardButtonFont.
+ 	[aBlock value] ensure: [
+ 		Preferences setSystemFontTo: standardDefaultTextFont.
+ 		Preferences setListFontTo: standardListFont.
+ 		Preferences setEToysFontTo: standardEToysFont.
+ 		Preferences setMenuFontTo: standardMenuFont.
+ 		Preferences setWindowTitleFontTo: windowTitleFont.
+ 		Preferences setBalloonHelpFontTo: standardBalloonHelpFont.
+ 		Preferences setCodeFontTo: standardCodeFont.
+ 		Preferences setButtonFontTo: standardButtonFont]!

Item was added:
+ ----- Method: MCAncestryTest>>testCommonAncestors (in category 'tests') -----
+ testCommonAncestors
+ 	self assertCommonAncestorOf: #a2 and: #e2 is: #a1 in: self tree.
+ 	self assertCommonAncestorOf: #e2 and: #b3 is: #a1 in: self tree.
+ 	self assertCommonAncestorOf: #b2 and: #e2 is: #'00' in: self tree.
+ 	
+ 	self assertCommonAncestorOf: #a4 and: #b5 in: #(b2 a1) in: self twoPersonTree.
+ 	self assertCommonAncestorOf: #b5 and: #b3 is: #b2 in: self twoPersonTree.
+ 	self assertCommonAncestorOf: #b2 and: #a4 is: #b2 in: self twoPersonTree.
+ 	self assertCommonAncestorOf: #b2 and: #b2 is: #b2 in: self twoPersonTree.
+ 	self assertCommonAncestorOf: #b2 and: #a1 is: #a1 in: self twoPersonTree.
+ 	self assertCommonAncestorOf: #a1 and: #b2 is: #a1 in: self twoPersonTree.!

Item was added:
+ ----- Method: MCRepositoryTest>>saveSnapshot:named: (in category 'actions') -----
+ saveSnapshot: aSnapshot named: aString
+ 	| version |
+ 	version := self versionWithSnapshot: aSnapshot name: aString.
+ 	repository storeVersion: version.
+ 	^ version info
+ 	!

Item was added:
+ ----- Method: ClosureTests>>testToDoOutsideTempNotInlined (in category 'testing-todo') -----
+ testToDoOutsideTempNotInlined
+ 	| block temp |
+ 	block := [ :index | 
+ 		temp := index. 
+ 		collection add: [ temp ] ].
+ 	1 to: 5 do: block.
+ 	self assertValues: #(5 5 5 5 5)!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesAAtoAM (in category 'tests') -----
+ testDecompilerInClassesAAtoAM
+ 	self decompileClassesSelect: [:cn| cn first = $A and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: MCClassDefinitionTest class>>restoreClassAComment (in category 'as yet unclassified') -----
+ restoreClassAComment
+ 	Smalltalk 
+ 		at: #MCMockClassA 
+ 		ifPresent: [:a | a classComment: self classAComment stamp: self classACommentStamp]!

Item was added:
+ TestCase subclass: #MCTestCase
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: MCPatchTest>>testPatchContents (in category 'as yet unclassified') -----
+ testPatchContents
+ 	self assert: patch operations size = 1.
+ 	self assert: patch operations first isModification.
+ 	self assert: patch operations first definition selector = #one.
+ !

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesNAtoNM (in category 'tests') -----
+ testDecompilerInClassesNAtoNM
+ 	self decompileClassesSelect: [:cn| cn first = $N and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- 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 added:
+ ----- Method: MacFileDirectoryTest>>testMacIsAbsolute (in category 'test') -----
+ testMacIsAbsolute
+ 	"(self selector: #testMacIsAbsolute) run"
+ 	
+ 	
+ 	self deny: (MacFileDirectory isAbsolute: 'Volumes').
+ 	self assert: (MacFileDirectory isAbsolute: 'Volumes:Data:Stef').
+ 	self deny: (MacFileDirectory isAbsolute: ':Desktop:test.st')!

Item was added:
+ ----- Method: ExceptionTester>>simpleEnsureTest (in category 'tests') -----
+ simpleEnsureTest
+ 
+ 	[self doSomething.
+ 	self doSomethingElse]
+ 		ensure:
+ 			[self doYetAnotherThing].
+ 	!

Item was added:
+ ----- Method: ExceptionTester>>iterationsBeforeTimeout (in category 'accessing') -----
+ iterationsBeforeTimeout
+ 
+ 	^ iterationsBeforeTimeout!

Item was added:
+ ----- Method: MCMergingTest>>snapshotWithElements: (in category 'emulating') -----
+ snapshotWithElements: anArray
+ 	^ MCSnapshot
+ 		fromDefinitions: (anArray collect: [:t | self mockToken: t])!

Item was added:
+ ----- Method: ExceptionTester>>doSomethingString (in category 'accessing') -----
+ doSomethingString
+ 
+ 	^'Do something.'!

Item was added:
+ ----- Method: MCWorkingCopyTest>>testSnapshotAndLoad (in category 'tests') -----
+ testSnapshotAndLoad
+ 	| base inst |
+ 	inst := self mockInstanceA.
+ 	base :=  self snapshot.
+ 	self change: #one toReturn: 2.
+ 	self assert: inst one = 2.
+ 	self load: base.
+ 	self assert: inst one = 1.!

Item was added:
+ ----- Method: MCVersionTest>>testAllMissing (in category 'tests') -----
+ testAllMissing
+ 	self 
+ 		assert: #allDependenciesDo: 
+ 		orders: #(a ((b (d e)) (c missing))) 
+ 		as: #(d e b)!

Item was added:
+ ----- Method: DecompilerTestFailuresCollector>>assert:description:resumable: (in category 'accessing') -----
+ assert: aBoolean description: aString resumable: resumableBoolean 
+ 	aBoolean ifFalse: 
+ 		[failures isNil ifTrue:
+ 			[failures := OrderedCollection new].
+ 		 failures addLast: (thisContext sender tempAt: 1) methodReference]!

Item was added:
+ ----- Method: MCVersionTest>>setUp (in category 'running') -----
+ setUp
+ 	visited := OrderedCollection new.!

Item was added:
+ ----- Method: StandardSourceFileArrayTest>>testSourcesFileAddressRange (in category 'testing') -----
+ testSourcesFileAddressRange
+ 	"Test file position to source pointer address translation for the sources file"
+ 	
+ 	| sf a |
+ 	sf := StandardSourceFileArray new.
+ 	(0 to: 16r1FFFFFF by: 811) do: [:e | | a2 p i |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		i := sf fileIndexFromSourcePointer: a.
+ 		self assert: i == 1.
+ 		p := sf filePositionFromSourcePointer: a.
+ 		self assert: p = e.
+ 		a2 := sf sourcePointerFromFileIndex: 1 andPosition: p.
+ 		self assert: a2 = a].
+ 	(0 to: 16rFFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16r1000000 and: 16r1FFFFFF)].
+ 	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e |
+ 		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
+ 		self assert: (a between: 16r3000000 and: 16r3FFFFFF)]
+ 
+ !

Item was added:
+ ----- Method: TextDiffBuilderTest>>testEmptyLcs2 (in category 'tests') -----
+ testEmptyLcs2
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #() and: #(a b c).
+ 	self assert: patch size = 3.	
+ 	self assert: (patch allSatisfy: [ :each | each key = #insert ])!

Item was added:
+ ----- Method: MCDirectoryRepositoryTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ 	repository := MCDirectoryRepository new directory: self directory!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>assertButtonExists: (in category 'asserting') -----
+ assertButtonExists: aString
+ 	self buttonMorphs detect: [:m | m label = aString] ifNone: [self assert: false].
+ 				!

Item was added:
+ ----- Method: MCVersionTest>>testWithAllMissing (in category 'tests') -----
+ testWithAllMissing
+ 	self 
+ 		assert: #withAllDependenciesDo: 
+ 		orders: #(a ((b (d e)) (c missing))) 
+ 		as: #(d e b a)!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesGAtoGM (in category 'tests') -----
+ testDecompilerInClassesGAtoGM
+ 	self decompileClassesSelect: [:cn| cn first = $G and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: ExceptionTester>>simpleEnsureTestWithNotificationResults (in category 'results') -----
+ simpleEnsureTestWithNotificationResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingString;
+ 		add: self doSomethingElseString;
+ 		add: self doYetAnotherThingString;
+ 		yourself!

Item was added:
+ ----- Method: MCSnapshotTest>>testCreation (in category 'tests') -----
+ testCreation
+ 	|d|
+ 	d :=  self mockSnapshot definitions.
+ 	self assert: (d anySatisfy: [:ea | ea isClassDefinition and: [ea className = #MCMockClassA]]).
+ 	self assert: (d anySatisfy: [:ea | ea isMethodDefinition and: [ea selector = #mockClassExtension]]).
+ 	self assert: (d allSatisfy: [:ea | ea isClassDefinition not or: [ea category endsWith: 'Mocks']]).
+ 	!

Item was added:
+ ----- Method: ClosureTests>>testBlockArgument (in category 'testing') -----
+ testBlockArgument
+ 	| block block1 block2 |
+ 	block := [ :arg | | temp | temp := arg. [ temp ] ].
+ 	block1 := block value: 1.
+ 	block2 := block value: 2.
+ 	self assert: block1 value = 1.
+ 	self assert: block2 value = 2!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesTAtoTM (in category 'tests') -----
+ testDecompilerInClassesTAtoTM
+ 	self decompileClassesSelect: [:cn| cn first = $T and: [cn second asUppercase <= $M]]!

Item was added:
+ ----- Method: EventManagerTest>>getTrue (in category 'private') -----
+ getTrue
+ 
+ 	^true!

Item was added:
+ ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'as yet unclassified') -----
+ testDefinitionString
+ 	| d |
+ 	d := self mockClassA asClassDefinition.
+ 	self assert: d definitionString = self mockClassA definition.!

Item was added:
+ ----- Method: MCStWriterTest>>testMethodDefinition (in category 'testing') -----
+ testMethodDefinition
+ 	writer visitMethodDefinition: (MethodReference class: self mockClassA selector: #one) 									asMethodDefinition.
+ 	self assertContentsOf: stream match: self expectedMethodDefinition.
+ 	stream reset.
+ 	self assert: stream nextChunk isAllSeparators.
+ 	self assertChunkIsWellFormed: stream nextChunk.
+ 	self assertMethodChunkIsWellFormed: stream nextChunk.
+ 	self assert: stream nextChunk isAllSeparators !

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>findListContaining: (in category 'morphic') -----
+ findListContaining: aString
+ 	^ self listMorphs detect: [:m | m getList includes: aString]!

Item was added:
+ ----- Method: MCChangeNotificationTest>>setUp (in category 'running') -----
+ setUp
+ 	workingCopy := MCWorkingCopy forPackage: self mockPackage.
+ 	!

Item was added:
+ ----- Method: MCSerializationTest>>assertSnapshotsMatchWith: (in category 'asserting') -----
+ assertSnapshotsMatchWith: writerClass
+ 	| readerClass expected stream actual |
+ 	readerClass := writerClass readerClass.
+ 	expected := self mockSnapshot.
+ 	stream := RWBinaryOrTextStream on: String new.
+ 	(writerClass on: stream) writeSnapshot: expected.
+ 	actual := readerClass snapshotFromStream: stream reset.
+ 	self assertSnapshot: actual matches: expected.!

Item was added:
+ ----- Method: DecompilerTestFailuresCollector>>failures (in category 'accessing') -----
+ failures
+ 	^failures!

Item was added:
+ ----- Method: MCMergingTest>>testMultiPackageMerge2 (in category 'tests') -----
+ testMultiPackageMerge2
+ 	| merger |
+ 	conflicts := #().
+ 	merger := MCThreeWayMerger new.
+ 	merger addBaseSnapshot: (self snapshotWithElements: #(a1 b1)).
+ 	merger applyPatch: ((self snapshotWithElements: #()) patchRelativeToBase: (self snapshotWithElements: #(a1))).
+ 	merger applyPatch: ((self snapshotWithElements: #(a1 b1)) patchRelativeToBase: (self snapshotWithElements: #(b1))).
+ 	merger conflicts do: [:ea | self handleConflict: ea].
+ 	self assert: merger mergedSnapshot definitions hasElements: #(a1 b1).
+ 	self assert: conflicts isEmpty!

Item was added:
+ ----- Method: MCPatchTest>>tearDown (in category 'as yet unclassified') -----
+ tearDown
+ 	self restoreMocks!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryContainingDirectoryExistence (in category 'as yet unclassified') -----
+ testFileDirectoryContainingDirectoryExistence
+ 	"Hoping that you have 'C:' of course..."
+ 	| fd |
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	fd := FileDirectory on: 'C:'.
+ 	self assert: (fd containingDirectory fileOrDirectoryExists: 'C:').!

Item was added:
+ ----- Method: ClosureCompilerTest>>testSourceRangeAccessForInjectInto (in category 'tests') -----
+ testSourceRangeAccessForInjectInto
+ 	"Test debugger source range selection for inject:into: for the current version of the method"
+ 	"self new testSourceRangeAccessForInjectInto"
+ 	self supportTestSourceRangeAccessForInjectInto: (Collection compiledMethodAt: #inject:into:)
+ 		source: (Collection sourceCodeAt: #inject:into:) asString!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleRetryUsing (in category 'testing-ExceptionTester') -----
+ testSimpleRetryUsing
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleRetryUsingTest ) !

Item was added:
+ ----- Method: MCTestCase>>compileClass:source:category: (in category 'compiling') -----
+ compileClass: aClass source: source category: category
+ 	aClass compileSilently: source classified: category!

Item was added:
+ ----- Method: ExceptionTester>>warningTest (in category 'tests') -----
+ warningTest
+ 
+ 	self log: 'About to signal warning.'.
+ 	Warning signal: 'Ouch'.
+ 	self log: 'Warning signal handled and resumed.'!

Item was added:
+ ----- Method: MCSerializationTest>>assertExtensionProvidedBy: (in category 'asserting') -----
+ assertExtensionProvidedBy: aClass
+ 	self shouldnt: [aClass readerClass extension] raise: Exception.!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleReturn (in category 'testing-ExceptionTester') -----
+ testSimpleReturn
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleReturnTest ) !

Item was added:
+ ----- Method: ExceptionTester>>simpleEnsureTestWithError (in category 'tests') -----
+ simpleEnsureTestWithError
+ 
+ 	[self doSomething.
+ 	MyTestError signal.
+ 	self doSomethingElse]
+ 		ensure:
+ 			[self doYetAnotherThing].
+ 	!

Item was added:
+ ----- Method: ExceptionTester>>signalFromHandlerActionTest (in category 'tests') -----
+ signalFromHandlerActionTest
+ 
+ 	[self doSomething.
+ 	MyTestError signal.
+ 	self doSomethingElse]
+ 		on: MyTestError
+ 		do:
+ 			[self doYetAnotherThing.
+ 			MyTestError signal]!

Item was added:
+ ----- Method: ClosureCompilerTest class>>methodWithOptimizedBlocks (in category 'code examples') -----
+ methodWithOptimizedBlocks
+ 	| s c |
+ 	s := self isNil
+ 			ifTrue: [| a | a := 'isNil'. a]
+ 			ifFalse: [| b | b := 'notNil'. b].
+ 	c := String new: s size.
+ 	1 to: s size do:
+ 		[:i| c at: i put: (s at: i)].
+ 	^c
+ 
+ 	"Parser new
+ 		parse: (self class sourceCodeAt: #methodWithOptimizedBlocks)
+ 		class: self class"!

Item was added:
+ ----- Method: MCStWriterTest>>expectedMethodDefinitionWithBangs (in category 'data') -----
+ expectedMethodDefinitionWithBangs
+ 	^ '
+ !!MCStWriterTest methodsFor: ''testing'' stamp: ''cwp 8/9/2003 14:55''!!
+ methodWithBangs
+ 	^ ''
+ 	^ ReadStream on: 
+ ''''MCRevisionInfo packageName: ''''MonticelloCompatibilityTest''''!!!!!!!!
+ MCOrganizationDeclaration categories: 
+   #(
+   ''''Monticello-Mocks'''')!!!!!!!!
+ 
+ MCClassDeclaration
+   name: #MCMockClassD
+   superclassName: #Object
+   category: #''''Monticello-Mocks''''
+   instVarNames: #()
+   comment: ''''''''!!!!!!!!
+ 
+ MCMethodDeclaration className: #MCMockClassD selector: #one category: #''''as yet unclassified'''' timeStamp: ''''cwp 7/8/2003 21:21'''' source: 
+ ''''one
+ 	^ 1''''!!!!!!!!
+ ''''
+ ''
+ !! !!
+ '!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>testProtocolSelected (in category 'testing') -----
+ testProtocolSelected
+ 	self clickOnListItem: self mockCategoryName.
+ 	self clickOnListItem: 'MCMockClassA'.
+ 	self clickOnListItem: 'boolean'.
+ 	
+ 	self assertAListMatches: self allCategories.
+ 	self assertAListMatches: self definedClasses.
+ 	self assertAListMatches: self classAProtocols.
+ 	self assertAListMatches: self classABooleanMethods.
+ 	self assertTextIs: ''.		!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesYNtoYZ (in category 'tests') -----
+ testDecompilerInClassesYNtoYZ
+ 	self decompileClassesSelect: [:cn| cn first = $Y and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: ClosureTests>>assertValues: (in category 'utilities') -----
+ assertValues: anArray
+ 	| values |
+ 	values := collection collect: [ :each | each value ].
+ 	self 
+ 		assert: anArray asArray = values asArray
+ 		description: 'Expected: ' , anArray asArray printString , 
+ 			', but got ' , values asArray printString!

Item was added:
+ ----- Method: ExceptionTester>>simpleTimeoutWithZeroDurationTestResults (in category 'results') -----
+ simpleTimeoutWithZeroDurationTestResults
+ 
+ 	^OrderedCollection new
+ 		add: self doSomethingElseString;
+ 		yourself!

Item was added:
+ ----- Method: ScannerTest>>testLiteralSymbols (in category 'testing') -----
+ testLiteralSymbols
+ 
+ 	self assert: ('*+-/\~=<>&@%,|' allSatisfy: [:char | Scanner isLiteralSymbol: (Symbol with: char)])
+ 		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 added:
+ ----- Method: MCWorkingCopyTest>>testBackport (in category 'tests') -----
+ testBackport
+ 	| inst base final backported |
+ 	inst := self mockInstanceA.
+ 	base :=  self snapshot.
+ 	self assert: inst one = 1.
+ 	self change: #one toReturn: 2.
+ 	self change: #two toReturn: 3.
+ 	final := self snapshot.
+ 	[workingCopy backportChangesTo: base info]
+ 		on: MCChangeSelectionRequest
+ 		do: [:e | e resume: e patch].
+ 	self assert: inst one = 2.
+ 	self assert: inst two = 3.
+ 	self assert: workingCopy ancestry ancestors size = 1.
+ 	self assert: workingCopy ancestry ancestors first = base info.
+ 	self assert: workingCopy ancestry stepChildren size = 1.
+ 	self assert: workingCopy ancestry stepChildren first = final info.
+ 	backported := self snapshot.
+ 	[workingCopy backportChangesTo: base info]
+ 		on: MCChangeSelectionRequest
+ 		do: [:e | e resume: e patch].
+ 	self assert: workingCopy ancestry ancestors size = 1.
+ 	self assert: workingCopy ancestry ancestors first = base info.
+ 	self assert: workingCopy ancestry stepChildren size = 1.
+ 	self assert: workingCopy ancestry stepChildren first = backported info.
+ 	!

Item was added:
+ ----- Method: MCSortingTest>>testSortOrder (in category 'tests') -----
+ testSortOrder
+ 	| aA aAm aB bA bB A B cA bAm cAm |
+ 	aA := self methodNamed: #a class: #A meta: false.
+ 	bA := self methodNamed: #b class: #A meta: false.
+ 	cA := self methodNamed: #c class: #A meta: false.
+ 	aAm := self methodNamed: #a class: #A meta: true.
+ 	bAm := self methodNamed: #b class: #A meta: true.
+ 	cAm := self methodNamed: #c class: #A meta: true.
+ 	aB := self methodNamed: #a class: #B meta: false.
+ 	bB := self methodNamed: #b class: #B meta: false.
+ 	A := self classNamed: #A.
+ 	B := self classNamed: #B.
+ 	self assert: (self sortDefinitions: {aA. aAm. cAm. aB. bAm. bA. bB. A. cA. B})
+ 					= {A. aAm. bAm. cAm. aA. bA. cA. B. aB.  bB}!

Item was added:
+ ----- Method: MCDependencySorterTest>>assertItems:orderAs:withRequired:toLoad:extraProvisions: (in category 'asserting') -----
+ assertItems: anArray orderAs: depOrder withRequired: missingDeps toLoad: unloadableItems extraProvisions: provisions
+ 	| order sorter items missing unloadable |
+ 	items := anArray collect: [:ea | self itemWithSpec: ea].
+ 	sorter := MCDependencySorter items: items.
+ 	sorter addExternalProvisions: provisions.
+ 	order := (sorter orderedItems collect: [:ea | ea name]) asArray.
+ 	self assert: order = depOrder.
+ 	missing := sorter externalRequirements.
+ 	self assert: missing asSet = missingDeps asSet.
+ 	unloadable := (sorter itemsWithMissingRequirements collect: [:ea | ea name]) asArray.
+ 	self assert: unloadable asSet = unloadableItems asSet!

Item was added:
+ ----- Method: ContextCompilationTest>>testVariablesAndOffsetsDo (in category 'tests') -----
+ testVariablesAndOffsetsDo
+ 
+ 	"ContextCompilationTest new testVariablesAndOffsetsDo"
+ 	| contextClasses |
+ 	contextClasses := ContextPart withAllSuperclasses, ContextPart allSubclasses asArray.
+ 	contextClasses do:
+ 		[:class|
+ 		class variablesAndOffsetsDo:
+ 			[:var :offset|
+ 			self assert: offset < 0.
+ 			self assert: (class instVarNameForIndex: offset negated) == var]].
+ 
+ 	InstructionStream withAllSuperclasses, InstructionStream allSubclasses asArray do:
+ 		[:class|
+ 		(contextClasses includes: class) ifFalse:
+ 			[class variablesAndOffsetsDo:
+ 				[:var :offset|
+ 				(InstructionStream instVarNames includes: var) ifFalse:
+ 					[self assert: offset > 0.
+ 					 self assert: (class instVarNameForIndex: offset) == var]]]]!

Item was added:
+ ----- Method: StandardSourceFileArrayTest>>testSourcePointerFromFileIndexAndPosition (in category 'testing') -----
+ testSourcePointerFromFileIndexAndPosition
+ 	"Test valid input ranges"
+ 
+ 	| sf |
+ 	sf := StandardSourceFileArray new.
+ 	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 0] raise: Error.
+ 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 0] raise: Error.
+ 	self shouldnt: [sf sourcePointerFromFileIndex: 2 andPosition: 0] raise: Error.
+ 	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 3] raise: Error.
+ 	self should: [sf sourcePointerFromFileIndex: 1 andPosition: -1] raise: Error.
+ 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF] raise: Error.
+ 	self should: [sf sourcePointerFromFileIndex: 1 andPosition: 16r2000000] raise: Error.
+ 	self should: [sf sourcePointerFromFileIndex: 3 andPosition: 0] raise: Error.
+ 	self should: [sf sourcePointerFromFileIndex: 4 andPosition: 0] raise: Error.
+ 	
+ 	self assert: 16r1000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 0).
+ 	self assert: 16r1000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r13).
+ 	self assert: 16r1FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16rFFFFFF).
+ 	self assert: 16r2000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 0).
+ 	self assert: 16r2000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r13).
+ 	self assert: 16r2FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16rFFFFFF).
+ 	self assert: 16r3000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000000).
+ 	self assert: 16r3000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000013).
+ 	self assert: 16r3FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF).
+ 	self assert: 16r4000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000000).
+ 	self assert: 16r4000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000013).
+ 	self assert: 16r4FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1FFFFFF)
+ !

Item was added:
+ ----- Method: MirrorPrimitiveTests>>testMirrorSize (in category 'tests') -----
+ testMirrorSize
+ 	| stackpBefore stackpAfter |
+ 	stackpBefore := thisContext stackPtr.
+ 	self assert: (thisContext objectSize: #(1 2 3)) = 3.
+ 	self assert: (thisContext objectSize: '123') = 3.
+ 	self assert: (thisContext objectSize: nil) = 0.
+ 	self assert: (thisContext objectSize: 1) = 0.
+ 	stackpAfter := thisContext stackPtr.
+ 	self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments"!

Item was added:
+ ----- Method: MCSerializationTest>>assertVersionsMatchWith: (in category 'asserting') -----
+ assertVersionsMatchWith: writerClass
+ 	| stream readerClass expected actual |
+ 	readerClass := writerClass readerClass.
+ 	expected := self mockVersion.
+ 	stream := RWBinaryOrTextStream on: String new.
+ 	writerClass fileOut: expected on: stream.
+ 	actual := readerClass versionFromStream: stream reset.
+ 	self assertVersion: actual matches: expected.!

Item was added:
+ ----- Method: MCTestCase>>assertVersionInfo:matches: (in category 'asserting') -----
+ assertVersionInfo: actual matches: expected
+ 	self assert: actual name = expected name.
+ 	self assert: actual message = expected message.
+ 	self assert: actual ancestors size = expected ancestors size.
+ 	actual ancestors with: expected ancestors do: [:a :e | self assertVersionInfo: a matches: e]
+ 	!

Item was added:
+ ----- Method: ClosureTests>>testWhileModificationBeforeNotInlined (in category 'testing-while') -----
+ testWhileModificationBeforeNotInlined
+ 	| index block |
+ 	index := 0.
+ 	block := [ 
+ 		index := index + 1.
+ 		collection add: [ index ] ].
+ 	[ index < 5 ] whileTrue: block.
+ 	self assertValues: #(5 5 5 5 5)!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testIfSequence3 (in category 'tests') -----
+ testIfSequence3
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #(a b c d) and: #(b d c a).
+ 	self assert: patch size = 6.	"lcs is bd"
+ 	self assert: (patch count: [ :each | each key = #match ]) = 2.
+ 	self assert: (patch count: [ :each | each key = #insert ]) = 2.
+ 	self assert: (patch count: [ :each | each key = #remove ]) = 2.
+ 	patch do: [ :each | 
+ 		each key = #match 
+ 			ifTrue: [ self assert: ('bd' includes: each value first) ]
+ 			ifFalse: [ self assert: ('ac' includes: each value first) ] ]!

Item was added:
+ ----- Method: MCDirectoryRepositoryTest>>addVersion: (in category 'as yet unclassified') -----
+ addVersion: aVersion
+ 	| file |
+ 	file := FileStream newFileNamed: (directory fullNameFor: aVersion fileName).
+ 	aVersion fileOutOn: file.
+ 	file close.!

Item was added:
+ ----- Method: MCTestCase>>mockClassB (in category 'mocks') -----
+ mockClassB
+ 	^ Smalltalk at: #MCMockClassB!

Item was added:
+ ----- Method: MCSnapshotResource class>>mockPackage (in category 'as yet unclassified') -----
+ mockPackage
+ 	^ (MCPackage new name: self mockPackageName)!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesENtoEZ (in category 'tests') -----
+ testDecompilerInClassesENtoEZ
+ 	self decompileClassesSelect: [:cn| cn first = $E and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: MCStWriterTest>>assertAllChunksAreWellFormed (in category 'asserting') -----
+ assertAllChunksAreWellFormed
+ 	stream reset.
+ 	stream 
+ 		untilEnd: [self assertChunkIsWellFormed: stream nextChunk]
+ 		displayingProgress: 'Checking syntax...'!

Item was added:
+ ----- Method: MCStWriterTest>>testOrganizationDefinition (in category 'testing') -----
+ testOrganizationDefinition
+ 	| definition |
+ 	definition := MCOrganizationDefinition categories: 
+ 					(self mockPackage packageInfo systemCategories).
+ 	writer visitOrganizationDefinition: definition.
+ 	self assertContentsOf: stream match: self expectedOrganizationDefinition.
+ 	self assertAllChunksAreWellFormed.!

Item was added:
+ ----- Method: ExceptionTester>>simpleNoTimeoutTest (in category 'tests') -----
+ simpleNoTimeoutTest
+ 
+ 	[ self doSomething ]
+ 		valueWithin: 1 day onTimeout:
+ 			[ self doSomethingElse ].
+ 	!

Item was added:
+ ----- Method: StandardSourceFileArrayTest>>testFilePositionFromSourcePointer (in category 'testing') -----
+ testFilePositionFromSourcePointer
+ 	"Test derivation of file position for sources or changes file from source pointers"
+ 
+ 	| sf |
+ 	sf := StandardSourceFileArray new.
+ 	"sources file"
+ 	self assert: 0 = (sf filePositionFromSourcePointer: 16r1000000).
+ 	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r1000013).
+ 	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r1FFFFFF).
+ 	self assert: 16r1000000 = (sf filePositionFromSourcePointer: 16r3000000).
+ 	self assert: 16r1000013 = (sf filePositionFromSourcePointer: 16r3000013).
+ 	self assert: 16r1FFFFFF = (sf filePositionFromSourcePointer: 16r3FFFFFF).
+ 	"changes file"
+ 	self assert: 0 = (sf filePositionFromSourcePointer: 16r2000000).
+ 	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r2000013).
+ 	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r2FFFFFF).
+ 	self assert: 16r1000000 = (sf filePositionFromSourcePointer: 16r4000000).
+ 	self assert: 16r1000013 = (sf filePositionFromSourcePointer: 16r4000013).
+ 	self assert: 16r1FFFFFF = (sf filePositionFromSourcePointer: 16r4FFFFFF).
+ 	"the following numeric ranges are unused but currently produces results as follows"
+ 	self assert: 0 = (sf filePositionFromSourcePointer: 16r0000000).
+ 	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r0000013).
+ 	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r0FFFFFF)
+ !

Item was added:
+ ----- Method: MCSerializationTest>>testStSerialization (in category 'testing') -----
+ testStSerialization
+ 	self assertSnapshotsMatchWith: MCStWriter.!

Item was added:
+ ----- Method: DecompilerTests>>decompilerFailures (in category 'utilities') -----
+ decompilerFailures
+ 	"here is the list of failures: DNU resulting in trying to decompile the following methods"
+ 
+ 	^ #((BalloonEngineSimulation circleCosTable "-0.3826834323650903 => -0.38268343236509 or -0.3826834323650902")
+ 		 (BalloonEngineSimulation circleSinTable "-0.3826834323650903 => -0.38268343236509 or -0.3826834323650902")
+ 		 (GeniePlugin primSameClassAbsoluteStrokeDistanceMyPoints:otherPoints:myVectors:otherVectors:mySquaredLengths:otherSquaredLengths:myAngles:otherAngles:maxSizeAndReferenceFlag:rowBase:rowInsertRemove:rowInsertRemoveCount: "Cannot compile -- stack including temps is too deep")
+ 		(QPickable2D pick:) "foo ifTrue: [^bar] ifFalse: [^baz]. ^huh?"
+ 		(QUsersPane userEntryCompare:to:) "foo ifTrue: [^bar] ifFalse: [^baz]. ^huh?"
+ 		(TShaderProgram vertexStrings) "foo ifTrue: []. => foo. => ."
+ 		(TShaderProgram fragmentStrings) "foo ifTrue: []. => foo. => ."
+ 		(TWindow zoomWindow:) "foo ifTrue: [^bar] ifFalse: [^baz]. ^huh?"
+ 
+ 		"(PNMReadWriter nextImage) (Collection #ifEmpty:ifNotEmpty:) (Collection #ifEmpty:) (Collection #ifNotEmpty:ifEmpty:) (Text #alignmentAt:ifAbsent:) (ObjectWithDocumentation propertyAt:ifAbsent:)")!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesRNtoRZ (in category 'tests') -----
+ testDecompilerInClassesRNtoRZ
+ 	self decompileClassesSelect: [:cn| cn first = $R and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: ClosureTests>>methodWithNonLocalReturn (in category 'utilities') -----
+ methodWithNonLocalReturn
+ 	self evaluateCopyOf: [^ self].
+ 	self signalFailure: 'Should never reach here'!

Item was added:
+ ----- 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 added:
+ ----- Method: ExceptionTests>>testSimpleResignalAs (in category 'testing-ExceptionTester') -----
+ testSimpleResignalAs
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleResignalAsTest ) !

Item was added:
+ ----- Method: ExceptionTester>>doSomethingElseString (in category 'accessing') -----
+ doSomethingElseString
+ 
+ 	^'Do something else.'!

Item was added:
+ ----- Method: MCMergingTest>>testIdenticalModification (in category 'tests') -----
+ testIdenticalModification
+ 	self
+ 		assertMerge: #(a2 b1)
+ 				with: #(a2 b1)
+ 				base: #(a1 b1)
+ 				
+ 				gives: #(a2 b1)
+ 				conflicts: #()!

Item was added:
+ ----- Method: FileDirectoryTest>>testDeleteDirectory (in category 'create/delete tests') -----
+ testDeleteDirectory
+ 	"Test deletion of a directory"
+ 	
+ 	| aContainingDirectory preTestItems |
+ 	aContainingDirectory := self myDirectory containingDirectory.
+ 	preTestItems := aContainingDirectory fileAndDirectoryNames.
+ 	
+ 	self assert: self myAssuredDirectory exists.
+ 	aContainingDirectory deleteDirectory: self myLocalDirectoryName.
+ 
+ 	self shouldnt: 
+ 		[aContainingDirectory directoryNames 
+ 			includes: self myLocalDirectoryName ]
+ 		description: 'Should successfully delete directory.'.
+ 	self should: 
+ 		[preTestItems = aContainingDirectory fileAndDirectoryNames]
+ 		description: 'Should only delete the indicated directory.'.
+ 
+ 	
+ 	!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesKNtoKZ (in category 'tests') -----
+ testDecompilerInClassesKNtoKZ
+ 	self decompileClassesSelect: [:cn| cn first = $K and: [cn second asUppercase > $M]]!

Item was added:
+ ----- Method: ExceptionTests>>assertSuccess: (in category 'private') -----
+ assertSuccess: anExceptionTester
+ 	self should: [ ( anExceptionTester suiteLog first) endsWith:  'succeeded'].!

Item was added:
+ ----- Method: ExceptionTests>>testSimpleIsNested (in category 'testing-ExceptionTester') -----
+ testSimpleIsNested
+ 	self assertSuccess: (ExceptionTester new runTest: #simpleIsNestedTest ) !

Item was added:
+ ----- 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 added:
+ ----- Method: ArrayLiteralTest>>testSymbols (in category 'tests') -----
+ testSymbols
+ 	self class compile: 'array ^ #(#nil #true #false #''nil'' #''true'' #''false'')'.
+ 	self assert: self array = {#nil. #true. #false. #nil. #true. #false}.!

Item was added:
+ TestCase subclass: #MCSortingTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello'!

Item was added:
+ ----- Method: ClosureTests>>testMethodTemp (in category 'testing') -----
+ testMethodTemp
+ 	| block1 block2 |
+ 	block1 := self methodArgument: 1.
+ 	block2 := self methodArgument: 2.
+ 	self assert: block1 value = 1.
+ 	self assert: block2 value = 2!

Item was added:
+ ----- Method: MCSerializationTest>>assertVersionInfosMatchWith: (in category 'asserting') -----
+ assertVersionInfosMatchWith: writerClass
+ 	| stream readerClass expected actual |
+ 	readerClass := writerClass readerClass.
+ 	expected := self mockVersion.
+ 	stream := RWBinaryOrTextStream on: String new.
+ 	writerClass fileOut: expected on: stream.
+ 	actual := readerClass versionInfoFromStream: stream reset.
+ 	self assert: actual = expected info.!

Item was added:
+ ----- Method: MCMergingTest>>testMultipleConflicts (in category 'tests') -----
+ testMultipleConflicts
+ 	self assertMerge: #(a1 b3 c1)
+ 				with: #(a1 b2 d1)
+ 				base: #(a1 b1 c2)
+ 				
+ 				gives: #(a1 b3 d1)
+ 				conflicts: #((removed c1) (b2 b3))
+ !

Item was added:
+ ----- Method: MCMergingTest>>assert:hasElements: (in category 'asserting') -----
+ assert: aCollection hasElements: anArray
+ 	self assert: (aCollection collect: [:ea | ea token]) asSet = anArray asSet!

Item was added:
+ ----- Method: MCWorkingCopyTest>>assertNumberWhenSavingTo:is: (in category 'asserting') -----
+ assertNumberWhenSavingTo: aRepository is: aNumber
+ 	| name |
+ 	name := nil.
+ 	[aRepository storeVersion: workingCopy newVersion]
+ 		on: MCVersionNameAndMessageRequest
+ 		do: [:n | name := n suggestedName. n resume: (Array with: name with: '')].
+ 	self assert: name = (self packageName, '-', Utilities authorInitials, '.', aNumber asString)!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testIsDriveForDrive (in category 'as yet unclassified') -----
+ testIsDriveForDrive
+ 	self assert: (DosFileDirectory isDrive: 'C:').
+ 	self deny: (DosFileDirectory isDrive: 'C:\').
+ 	self deny: (DosFileDirectory isDrive: 'C:\foo').
+ 	self deny: (DosFileDirectory isDrive: 'C:foo').!

Item was added:
+ ----- Method: MCRepositoryTest>>testAddAndLoad (in category 'tests') -----
+ testAddAndLoad
+ 	| node |
+ 	node := self addVersionWithSnapshot: self snapshot1 name: 'rev1'.
+ 	self assert: (self snapshotAt: node) = self snapshot1.
+ !

Item was added:
+ ----- Method: ClosureCompilerTest class>>methodWithCopiedAndPostClosedOverAssignedTemps (in category 'code examples') -----
+ methodWithCopiedAndPostClosedOverAssignedTemps
+ 	| blk a b c r1 r2 |
+ 	a := 1.
+ 	b := 2.
+ 	c := 4.
+ 	blk := [a + b + c].
+ 	r1 := blk value.
+ 	b := nil.
+ 	r2 := blk value.
+ 	r1 -> r2
+ 
+ 	"(Parser new
+ 		encoderClass: EncoderForV3;
+ 		parse: (self class sourceCodeAt: #methodWithCopiedAndPostClosedOverAssignedTemps)
+ 		class: self class) generateUsingClosures: #(0 0 0 0)"!

Item was added:
+ ----- Method: ClosureTests>>methodArgument: (in category 'testing') -----
+ methodArgument: anObject
+ 	^ [ anObject ]
+ 	!

Item was added:
+ ----- Method: TextDiffBuilderTest>>testEmptySequences (in category 'tests') -----
+ testEmptySequences
+ 
+ 	| patch |
+ 	patch := self patchSequenceFor: #() and: #().
+ 	self assert: patch isEmpty!

Item was added:
+ ----- Method: ExceptionTester>>simplePassTest (in category 'signaledException tests') -----
+ simplePassTest
+ 
+ 	[self doSomething.
+ 	MyTestError signal.
+ 	self doSomethingElse]
+ 		on: MyTestError
+ 		do:
+ 			[:ex |
+ 			self doYetAnotherThing.
+ 			ex pass "expecting handler in #runTest:"]!

Item was added:
+ ----- Method: ExceptionTester>>basicANSISignaledExceptionTestSelectors (in category 'accessing') -----
+ basicANSISignaledExceptionTestSelectors
+ 
+ 	^#( simpleIsNestedTest simpleOuterTest doubleOuterTest doubleOuterPassTest doublePassOuterTest simplePassTest simpleResignalAsTest simpleResumeTest simpleRetryTest simpleRetryUsingTest simpleReturnTest)!

Item was added:
+ ----- Method: DecompilerTests>>testDecompilerInClassesDNtoDZ (in category 'tests') -----
+ testDecompilerInClassesDNtoDZ
+ 	self decompileClassesSelect: [:cn| cn first = $D and: [cn second asUppercase > $M]]!

Item was added:
+ ----- 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 added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryEntryFor (in category 'as yet unclassified') -----
+ testFileDirectoryEntryFor
+ 	"Hoping that you have 'C:' of course..."
+ 	| fd |
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	fd := FileDirectory root directoryEntryFor: 'C:'.
+ 	self assert: (fd name sameAs: 'C:').!

Item was added:
+ ----- Method: MCFileInTest>>tearDown (in category 'running') -----
+ tearDown
+ 	(diff isNil or: [diff isEmpty not])
+ 		 ifTrue: [expected updatePackage: self mockPackage]!

Item was added:
+ ----- 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 added:
+ ----- Method: MCSerializationTest>>mockDiffyVersion (in category 'mocks') -----
+ mockDiffyVersion
+ 	| repos workingCopy base next |
+ 	repos := MCDictionaryRepository new.
+ 	workingCopy := MCWorkingCopy forPackage: self mockPackage.
+ 	workingCopy repositoryGroup addRepository: repos.
+ 	MCRepositoryGroup default removeRepository: repos.
+ 	base := self mockVersion.
+ 	repos storeVersion: base.
+ 	self change: #a toReturn: 'a2'.
+ 	next := self mockVersionWithAncestor: base.
+ 	^ next asDiffAgainst: base	!

Item was added:
+ ----- Method: ExceptionTester>>clearLog (in category 'logging') -----
+ clearLog
+ 
+ 	log := nil!

Item was added:
+ ----- Method: FileDirectoryTest>>testOldFileOrNoneNamed (in category 'existence tests') -----
+ testOldFileOrNoneNamed
+ 
+ 	| file |
+ 	file := self myAssuredDirectory oldFileOrNoneNamed: 'test.txt'.
+ 	[self assert: file isNil.
+ 	
+ 	"Reproduction of Mantis #1049"
+ 	(self myAssuredDirectory fileNamed: 'test.txt')
+ 		nextPutAll: 'foo';
+ 		close.
+ 		
+ 	file := self myAssuredDirectory oldFileOrNoneNamed: 'test.txt'.
+ 	self assert: file notNil]
+ 		ensure: [
+ 			file ifNotNil: [file close].
+ 			self myAssuredDirectory deleteFileNamed: 'test.txt' ifAbsent: nil]
+ 	
+ !

Item was added:
+ ----- Method: MacFileDirectoryTest>>testMakeAbsolute (in category 'test') -----
+ testMakeAbsolute
+ 
+ 	self assert: (MacFileDirectory isAbsolute: (MacFileDirectory makeAbsolute: 'Data')).
+ 	self assert: (MacFileDirectory isAbsolute: (MacFileDirectory makeAbsolute: ':Data')).
+ !

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>classADefinitionString (in category 'private') -----
+ classADefinitionString
+ 	^ self mockClassA definition!

Item was added:
+ ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'as yet unclassified') -----
+ testEqualsSensitivity
+ 	| message a b defA args defB |
+ 	message := self creationMessage.
+ 	a := #(ClassA SuperA CategoryA #(iVarA) #(CVarA) #(PoolA) #(ciVarA)
+ 			typeA 'A comment' 'A').
+ 	b := #(ClassB SuperB CategoryB #(iVarB) #(CVarB) #(PoolB) #(ciVarB)
+ 			typeB 'B comment' 'B').
+ 	
+ 	defA := message valueWithArguments: a.
+ 	1 to: 8 do: [:index |
+ 				args := a copy.
+ 				args at: index put: (b at: index).
+ 				defB := message valueWithArguments: args.
+ 				self deny: defA = defB.]!

Item was added:
+ ----- Method: MCStReaderTest>>testCommentWithoutStyle (in category 'as yet unclassified') -----
+ testCommentWithoutStyle
+ 	| reader |
+ 	reader := MCStReader on: self commentWithoutStyle readStream.
+ 	self assert: (reader definitions anySatisfy: [:ea | ea isMethodDefinition]).!

Item was added:
+ ----- Method: MCVersionTest>>versionFromTree: (in category 'building') -----
+ versionFromTree: sexpr
+ 	^ (self dependencyFromTree: sexpr) resolve!

Item was added:
+ ----- Method: ObjectFinalizerTests>>setUp (in category 'running') -----
+ setUp
+ 	super setUp.
+ 	log := OrderedCollection new.!

Item was added:
+ ----- Method: MCSnapshotResource>>setUp (in category 'as yet unclassified') -----
+ setUp
+ 	snapshot := self class takeSnapshot.!

Item was added:
+ ----- Method: DosFileDirectoryTests>>testFileDirectoryContainingDirectory (in category 'as yet unclassified') -----
+ testFileDirectoryContainingDirectory
+ 	"Hoping that you have 'C:' of course..."
+ 	| fd |
+ 	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
+ 	fd := FileDirectory on: 'C:'.
+ 	self assert: fd containingDirectory pathName = ''.
+ !

Item was added:
+ ----- Method: ExceptionTester>>logTestResult: (in category 'logging') -----
+ logTestResult: aString
+ 
+ 	| index |
+ 	index := self suiteLog size.
+ 	self suiteLog 
+ 		at: index
+ 		put: ((self suiteLog at: index), ' ', aString)!

Item was added:
+ ----- Method: ExceptionTester>>log: (in category 'logging') -----
+ log: aString
+ 
+ 	self log add: aString!

Item was added:
+ ----- Method: MCSnapshotBrowserTest>>assertAListIncludes: (in category 'asserting') -----
+ assertAListIncludes: anArrayOfStrings
+ 	self listMorphs 
+ 			detect: [:m | m getList includesAllOf: anArrayOfStrings]
+ 			ifNone: [self assert: false].!

Item was added:
+ ----- Method: MCVersionTest>>assert:orders:as: (in category 'asserting') -----
+ assert: aSelector orders: sexpr as: array
+ 	| expected |
+ 	expected := OrderedCollection new.
+ 	version := self versionFromTree: sexpr.
+ 	version perform: aSelector with: [:ea | expected add: ea info name].
+ 	self assert: expected asArray = array!

Item was added:
+ ----- Method: ClosureCompilerTest>>testInlineBlockCollectionLR1 (in category 'tests') -----
+ testInlineBlockCollectionLR1
+ 	"Test case from Lukas Renggli"
+ 	| col |
+ 	col := OrderedCollection new.
+ 	1 to: 11 do: [ :each | col add: [ each ] ].
+ 	self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray!

Item was added:
+ ----- Method: MCTestCase>>mockMethod:class:source:meta: (in category 'mocks') -----
+ mockMethod: aSymbol class: className source: sourceString meta: aBoolean
+ 	^ MCMethodDefinition
+ 		className: className
+ 		classIsMeta: aBoolean
+ 		selector:  aSymbol
+ 		category: 'as yet unclassified'
+ 		timeStamp: ''
+ 		source: sourceString!

Item was added:
+ ----- Method: FileDirectoryTest>>testDirectoryExistsWhenLikeNamedFileExists (in category 'existence tests') -----
+ testDirectoryExistsWhenLikeNamedFileExists
+ 
+ [ | testFileName |
+ testFileName := self myAssuredDirectory fullNameFor: 'zDirExistsTest.testing'.
+ (FileStream newFileNamed: testFileName) close.
+ 
+ self should: [FileStream isAFileNamed: testFileName].
+ self shouldnt: [(FileDirectory on: testFileName) exists]]
+ ensure: [self myAssuredDirectory deleteFileNamed: 'zDirExistsTest.testing']
+ 
+ !

Item was added:
+ ----- Method: ExceptionTester>>simpleRetryUsingTest (in category 'signaledException tests') -----
+ simpleRetryUsingTest
+ 
+ 	[self doSomething.
+ 	MyTestError signal.
+ 	self doSomethingElse]
+ 		on: MyTestError
+ 		do:
+ 			[:ex | ex retryUsing: [self doYetAnotherThing]]!

Item was added:
+ ClassTestCase subclass: #EventManagerTest
+ 	instanceVariableNames: 'eventSource eventListener succeeded'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Object Events'!

Item was added:
+ ----- Method: MCStReaderTest>>methodWithStyle (in category 'as yet unclassified') -----
+ methodWithStyle
+ 	^ '!!EventHandler methodsFor: ''copying'' stamp: ''tk 1/22/2001 17:39''!!
+ veryDeepInner: deepCopier
+ 	"ALL fields are weakly copied.  Can''t duplicate an object by duplicating a button that activates it.  See DeepCopier."
+ 
+ 	super veryDeepInner: deepCopier.
+ 	"just keep old pointers to all fields"
+ 	clickRecipient := clickRecipient.!!
+ ]style[(25 108 10 111)f1b,f1,f1LDeepCopier Comment;,f1!! !!
+ 
+ '!

Item was added:
+ Error subclass: #MyResumableTestError
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Exceptions'!

Item was added:
+ ----- Method: ExceptionTester>>simpleTimeoutTest (in category 'tests') -----
+ simpleTimeoutTest
+ 
+ 	| n |
+ 	[1 to: 1000000 do: [ :i | n := i. self doSomething ] ]
+ 		valueWithin: 50 milliSeconds onTimeout:
+ 			[ self iterationsBeforeTimeout: n.
+ 			self doSomethingElse ]!



More information about the Packages mailing list