The Inbox: Tests-fbs.280.mcz

A new version of Tests was added to project The Inbox:
http://source.squeak.org/inbox/Tests-fbs.280.mcz

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

Name: Tests-fbs.280
Author: fbs
Time: 21 December 2013, 8:01:37.029 pm
UUID: 4b89f11c-4ed2-774a-acb0-b396ae5aa8c9
Ancestors: Tests-fbs.279

Ensure that Monticello can load definitions into an Environment.

=============== Diff against Tests-fbs.279 ===============

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

Item was changed:
+ ----- Method: MCClassDefinitionTest>>creationMessage (in category 'data') -----
- ----- 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 changed:
+ ----- Method: MCClassDefinitionTest>>tearDown (in category 'running') -----
- ----- Method: MCClassDefinitionTest>>tearDown (in category 'as yet unclassified') -----
  tearDown
 
  super tearDown.
  Smalltalk at: 'MCMockClassC' ifPresent: [:c | c removeFromSystem]!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'tests - loading') -----
- ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'as yet unclassified') -----
  testCannotLoad
  | d |
+ [d :=  self mockClass: 'MCMockClassC' super: 'NotAnObject'.
- d :=  self mockClass: 'MCMockClassC' super: 'NotAnObject'.
  self should: [d load] raise: Error.
+ self deny: (environment hasClassNamed: 'MCMockClassC')]
+ on: EnvironmentRequest do: [:e | e resume: environment].!
- self deny: (Smalltalk hasClassNamed: 'MCMockClassC').!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testComparison (in category 'tests - equality') -----
- ----- 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 changed:
+ ----- Method: MCClassDefinitionTest>>testCreation (in category 'tests - creating') -----
- ----- 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 changed:
+ ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'tests - creating') -----
- ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'as yet unclassified') -----
  testDefinitionString
  | d |
  d := self mockClassA asClassDefinition.
  self assert: d definitionString = self mockClassA definition.!

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testEquals (in category 'tests - equality') -----
- ----- 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 changed:
+ ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'tests - equality') -----
- ----- 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 changed:
+ ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'tests - creating') -----
- ----- 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 changed:
+ ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'tests - loading') -----
- ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'as yet unclassified') -----
  testLoadAndUnload
  | d c |
+ [d :=  self mockClass: 'MCMockClassC' super: 'Object'.
- d :=  self mockClass: 'MCMockClassC' super: 'Object'.
  d load.
+ self assert: (environment hasClassNamed: 'MCMockClassC') description: 'Class not loaded'.
+ c := (environment classNamed: 'MCMockClassC').
+ self assert: (c isKindOf: Class) description: 'Not a Class'.
+ self assert: Object equals: c superclass description: 'Superclass'.
+ self assert: c instVarNames isEmpty description: 'Unexpected inst vars'.
+ self assert: c classVarNames isEmpty description: 'Unexpected class vars'.
+ self assert: c sharedPools isEmpty description: 'Unexpected shared pools'.
+ self assert: self mockCategoryName equals: c category description: 'Category'.
+ self assert: (self commentForClass: 'MCMockClassC') equals: c organization classComment asString description: 'Class comment'.
+ self assert: (self commentStampForClass: 'MCMockClassC') equals: c organization commentStamp description: 'Comment stamp'.
- 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: (environment hasClassNamed: 'MCMockClassC')]
+ on: EnvironmentRequest do: [:e | e resume: environment]!
- self deny: (Smalltalk hasClassNamed: 'MCMockClassC').!

Item was changed:
  MCTestCase subclass: #MCEnvironmentLoadTest
+ instanceVariableNames: ''
- instanceVariableNames: 'environment'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Tests-Monticello'!
 
  !MCEnvironmentLoadTest commentStamp: 'fbs 5/8/2013 20:46' prior: 0!
  I demonstrate that you can load MC snapshots into an environment.!

Item was removed:
- ----- Method: MCEnvironmentLoadTest>>setUp (in category 'as yet unclassified') -----
- setUp
- environment := Environment named: 'MCEnvironmentLoadTest'.!

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

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

Item was changed:
  ----- Method: MCMethodDefinitionTest>>testLoadAndUnload (in category 'testing') -----
  testLoadAndUnload
  |definition|
+ [definition := self mockMethod: #one class: 'MCMockClassA' source: 'one ^2' meta: false.
- 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)]
+ on: EnvironmentRequest do: [:e | e resume: environment].!
- self deny: (self mockInstanceA respondsTo: #one)!

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

Item was changed:
  ----- Method: MCTestCase>>mockClassA (in category 'mocks') -----
  mockClassA
+ "#classNamed: doesn't return a class that's only referenced, only a class that's declared."
+ ^ (environment bindingOf: #MCMockClassA) value!
- ^ Smalltalk at: #MCMockClassA!

Item was changed:
  ----- Method: MCTestCase>>mockClassB (in category 'mocks') -----
  mockClassB
+ "#classNamed: doesn't return a class that's only referenced, only a class that's declared."
+ ^ (environment bindingOf: #MCMockClassB) value.!
- ^ Smalltalk at: #MCMockClassB!

Item was added:
+ ----- Method: MCTestCase>>setUp (in category 'running') -----
+ setUp
+ environment := Environment withName: ('{1} test environment' format: {self className}).
+ environment import: Smalltalk globals.!