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

commits at source.squeak.org commits at source.squeak.org
Tue Jan 5 09:21:42 UTC 2010


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

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

Name: Tests-ar.42
Author: ar
Time: 5 January 2010, 10:21:35 am
UUID: 4cdf5a1b-2bce-1047-b435-39fd9957a9c2
Ancestors: Tests-ar.41

More unloading work: Move MC mock package to tests. Update tests to account for the change.

=============== Diff against Tests-ar.41 ===============

Item was added:
+ ----- Method: MCMockDefinition>>summary (in category 'as yet unclassified') -----
+ summary
+ 
+ 	^ token!

Item was added:
+ Object variableByteSubclass: #MCMockClassH
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

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'!
+ SystemOrganization addCategory: #'Tests-Monticello-Mocks'!

Item was added:
+ ----- Method: MCMockClassA class>>one (in category 'as yet unclassified') -----
+ one
+ 
+ 	^ 1!

Item was added:
+ ----- Method: MCMockDependency>>mockVersionInfo (in category 'mocks') -----
+ mockVersionInfo
+ 	^ MCVersionInfo
+ 		name: self name
+ 		id: (self uuidForName: name)
+ 		message: ''
+ 		date: nil
+ 		time: nil
+ 		author: ''
+ 		ancestors: #()!

Item was added:
+ ----- Method: MCMockClassA class>>cVar (in category 'as yet unclassified') -----
+ cVar
+ 	^ CVar!

Item was added:
+ ----- Method: MCMockClassD>>one (in category 'as yet unclassified') -----
+ one
+ 	^ 1!

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

Item was added:
+ ----- Method: MCMockDependency class>>fromTree: (in category 'instance creation') -----
+ fromTree: anArray 
+ 	^ self new initializeWithTree: anArray!

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

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

Item was added:
+ ----- Method: MCMockDefinition>>description (in category 'as yet unclassified') -----
+ description
+ 
+ 	^ token first!

Item was added:
+ ----- Method: MCMockClassB>>two (in category 'numeric') -----
+ two
+ 
+ 	^ 2!

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

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

Item was added:
+ ----- Method: MCMockDependency>>initializeWithTree: (in category 'accessing') -----
+ initializeWithTree: expr
+ 	expr isSymbol
+ 		ifTrue: [name := expr.
+ 				children := Array new.
+ 				hasResolution := true.]
+ 		ifFalse: [name := expr first.
+ 				expr second isSymbol
+ 					ifTrue: [hasResolution := false.
+ 							children := Array new]
+ 					ifFalse: [hasResolution := true.
+ 							children := expr second]]!

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

Item was changed:
  ----- Method: MCStWriterTest>>expectedClassDefinitionA (in category 'data') -----
  expectedClassDefinitionA
   ^ '
  MCMock subclass: #MCMockClassA
  	instanceVariableNames: ''ivar''
  	classVariableNames: ''CVar''
  	poolDictionaries: ''''
+ 	category: ''Tests-Monticello-Mocks''!!
- 	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:
+ MCMock subclass: #MCMockDependentItem
+ 	instanceVariableNames: 'name provides requires'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

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

Item was added:
+ SharedPool subclass: #MCMockAPoolDictionary
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

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

Item was added:
+ ----- Method: MCMockASubclass>>variables (in category 'as yet unclassified') -----
+ variables
+ 	^ x + Y + MCMockClassA!

Item was added:
+ ----- Method: MCEmptyPackageInfo class>>wantsChangeSetLogging (in category 'as yet unclassified') -----
+ wantsChangeSetLogging
+ 	^ false!

Item was added:
+ ----- Method: MCMockPackageInfo class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	[self new register] on: MessageNotUnderstood do: []!

Item was added:
+ ----- Method: MCMockClassA class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	CVar := #initialized!

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

Item was added:
+ ----- Method: MCMockPackageInfo>>extensionMethods (in category 'as yet unclassified') -----
+ extensionMethods
+ 	^ Array with: (MethodReference new 
+ 					setStandardClass: MCSnapshotTest 
+ 					methodSymbol: #mockClassExtension)!

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

Item was added:
+ ----- Method: MCMockClassA>>c (in category 'numeric') -----
+ c
+ 	^ 'c1'!

Item was added:
+ ----- Method: MCEmptyPackageInfo class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	[self new register] on: MessageNotUnderstood do: []!

Item was added:
+ MCDefinition subclass: #MCMockDefinition
+ 	instanceVariableNames: 'token'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ ----- Method: MCMockDefinition class>>token: (in category 'as yet unclassified') -----
+ token: aString
+ 
+ 	^ self new token: aString!

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

Item was added:
+ ----- Method: MCMockDependentItem>>provisions (in category 'as yet unclassified') -----
+ provisions
+ 
+ 	^ provides ifNil: [#()]!

Item was added:
+ PackageInfo subclass: #MCDirtyPackageInfo
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ ----- Method: MCMock class>>wantsChangeSetLogging (in category 'as yet unclassified') -----
+ wantsChangeSetLogging
+ 	^ false!

Item was added:
+ Object variableSubclass: #MCMockClassE
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ ----- Method: MCMockClassA>>b (in category 'numeric') -----
+ b
+ 	^ 'b1'!

Item was added:
+ ----- Method: MCMockClassA>>two (in category 'numeric') -----
+ two
+ 	^ 2!

Item was added:
+ ----- Method: MCMockClassE class>>two (in category 'as yet unclassified') -----
+ two
+ 	^ 2!

Item was added:
+ ----- Method: MCMockDependency>>resolve (in category 'resolving') -----
+ resolve
+ 	^ self hasResolution
+ 		ifTrue: [MCVersion new
+ 					setPackage: MCSnapshotResource mockPackage
+ 					info: self mockVersionInfo
+ 					snapshot: MCSnapshotResource current snapshot
+ 					dependencies: self children]
+ 		ifFalse: [nil]!

Item was added:
+ ----- Method: MCMockDependency>>= (in category 'comparing') -----
+ = other
+ 	^ self name = other name!

Item was added:
+ ----- Method: MCMockClassA>>moreTruth (in category 'boolean') -----
+ moreTruth
+ 
+ 	^ true!

Item was added:
+ ----- Method: MCMockASubclass>>variables2 (in category 'as yet unclassified') -----
+ variables2
+ 	^ ivar + CVar!

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

Item was added:
+ ----- Method: MCDirtyPackageInfo class>>wantsChangeSetLogging (in category 'as yet unclassified') -----
+ wantsChangeSetLogging
+ 	^ false!

Item was added:
+ ----- Method: MCMockDefinition class>>wantsChangeSetLogging (in category 'as yet unclassified') -----
+ wantsChangeSetLogging
+ 	^ false!

Item was added:
+ ----- Method: MCMockClassA>>truth (in category 'boolean') -----
+ truth
+ 	^ true!

Item was added:
+ Object variableWordSubclass: #MCMockClassG
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ ----- Method: MCMockDependency>>hash (in category 'comparing') -----
+ hash
+ 	^ self name hash!

Item was added:
+ ----- Method: MCMockClassA>>a (in category 'numeric') -----
+ a
+ 	^ 'a2'!

Item was added:
+ ----- Method: MCDirtyPackageInfo class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	[self new register] on: MessageNotUnderstood do: []!

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

Item was added:
+ MCMock subclass: #MCMockClassB
+ 	instanceVariableNames: 'ivarb'
+ 	classVariableNames: 'CVar'
+ 	poolDictionaries: 'MCMockAPoolDictionary'
+ 	category: 'Tests-Monticello-Mocks'!
+ MCMockClassB class
+ 	instanceVariableNames: 'ciVar'!
+ 
+ !MCMockClassB commentStamp: '' prior: 0!
+ This comment has a bang!! Bang!! Bang!!!

Item was added:
+ Object subclass: #MCMockDependency
+ 	instanceVariableNames: 'name children hasResolution'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

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

Item was added:
+ Object weakSubclass: #MCMockClassI
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ MCMockClassA subclass: #MCMockASubclass
+ 	instanceVariableNames: 'x'
+ 	classVariableNames: 'Y'
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ ----- Method: MCMockClassA>>q (in category 'drag''n''drop') -----
+ q!

Item was changed:
  ----- Method: MCStWriterTest>>methodWithBangs (in category 'testing') -----
  methodWithBangs
  	^ '
  	^ ReadStream on: 
  ''MCRevisionInfo packageName: ''MonticelloCompatibilityTest''!!!!
  MCOrganizationDeclaration categories: 
    #(
+   ''Tests-Monticello-Mocks'')!!!!
-   ''Monticello-Mocks'')!!!!
  
  MCClassDeclaration
    name: #MCMockClassD
    superclassName: #Object
+   category: #''Tests-Monticello-Mocks''
-   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: MCMockDependency>>hasResolution (in category 'resolving') -----
+ hasResolution
+ 	^ hasResolution!

Item was added:
+ ----- Method: MCMockDependentItem>>requirements (in category 'as yet unclassified') -----
+ requirements
+ 
+ 	^ requires ifNil: [#()]!

Item was added:
+ ----- Method: MCMockDependentItem>><= (in category 'as yet unclassified') -----
+ <= other
+ 	^ self name <= other name!

Item was added:
+ ----- Method: MCMockDependentItem>>name: (in category 'as yet unclassified') -----
+ name: aString
+ 
+ 	name := aString!

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

Item was added:
+ ----- Method: MCMockDefinition>>asString (in category 'as yet unclassified') -----
+ asString
+ 
+ 	^ token!

Item was added:
+ Object subclass: #MCMockClassD
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ PackageInfo subclass: #MCMockPackageInfo
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ ----- Method: MCMockDependentItem>>provides: (in category 'as yet unclassified') -----
+ provides: anArray
+ 
+ 	provides := anArray!

Item was added:
+ ----- Method: MCMockDependency>>uuidForName: (in category 'mocks') -----
+ uuidForName: aName 
+ 	| nm id |
+ 	nm := aName asString.
+ 	id := '00000000-0000-0000-0000-0000000000' 
+ 				, (nm size = 1 ifTrue: [nm , '0'] ifFalse: [nm]).
+ 	^UUID fromString: id!

Item was added:
+ Object subclass: #MCMock
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ ----- Method: MCMockDependentItem>>requires: (in category 'as yet unclassified') -----
+ requires: anArray
+ 
+ 	requires := anArray!

Item was added:
+ ----- Method: MCMockDefinition>>printString (in category 'as yet unclassified') -----
+ printString
+ 
+ 	^ token!

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

Item was added:
+ ----- Method: MCMockClassA class>>touchCVar (in category 'as yet unclassified') -----
+ touchCVar
+ 	CVar := #touched!

Item was added:
+ ----- Method: MCMockClassA>>one (in category 'numeric') -----
+ one
+ 	^ 1!

Item was added:
+ Object subclass: #MCMockClassF
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'Foo'
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

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

Item was added:
+ ----- Method: MCMockDefinition>>token: (in category 'as yet unclassified') -----
+ token: aString
+ 
+ 	token := aString!

Item was added:
+ ----- Method: MCMockDependency>>children (in category 'accessing') -----
+ children
+ 	^ children collect: [:ea | self class fromTree: ea]!

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

Item was added:
+ ----- Method: MCMockClassA>>falsehood (in category 'boolean') -----
+ falsehood
+ 	^ false!

Item was changed:
  ----- Method: MCStWriterTest>>expectedMethodDefinitionWithBangs (in category 'data') -----
  expectedMethodDefinitionWithBangs
+ 	^'
+ !!MCStWriterTest methodsFor: ''testing'' stamp: ''ar 1/4/2010 18:03''!!
- 	^ '
- !!MCStWriterTest methodsFor: ''testing'' stamp: ''cwp 8/9/2003 14:55''!!
  methodWithBangs
  	^ ''
  	^ ReadStream on: 
  ''''MCRevisionInfo packageName: ''''MonticelloCompatibilityTest''''!!!!!!!!
  MCOrganizationDeclaration categories: 
    #(
+   ''''Tests-Monticello-Mocks'''')!!!!!!!!
-   ''''Monticello-Mocks'''')!!!!!!!!
  
  MCClassDeclaration
    name: #MCMockClassD
    superclassName: #Object
+   category: #''''Tests-Monticello-Mocks''''
-   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: MCMockPackageInfo>>systemCategories (in category 'as yet unclassified') -----
+ systemCategories
+ 	^ Array with: 'Monticello-Mocks'!

Item was added:
+ MCMock subclass: #MCMockClassA
+ 	instanceVariableNames: 'ivar'
+ 	classVariableNames: 'CVar'
+ 	poolDictionaries: ''
+ 	category: 'Tests-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:
+ ----- Method: MCDirtyPackageInfo>>methods (in category 'as yet unclassified') -----
+ methods
+ 	^ MCMockClassA selectors
+ 		select: [:ea | ea beginsWith: 'ordinal']
+ 		thenCollect:
+ 			[:ea | 
+ 				MethodReference new 
+ 					setStandardClass: MCMockClassA 
+ 					methodSymbol: ea].!

Item was added:
+ PackageInfo subclass: #MCEmptyPackageInfo
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-Monticello-Mocks'!

Item was added:
+ ----- Method: MCMockDefinition>>hash (in category 'as yet unclassified') -----
+ hash
+ 
+ 	^ token hash!



More information about the Packages mailing list