The Inbox: Tests-cwp.281.mcz

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

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

Name: Tests-cwp.281
Author: cwp
Time: 1 January 2014, 1:21:21.324 pm
UUID: bd0290d9-b157-4355-8e18-8dd4f4705e23
Ancestors: Tests-fbs.280, Tests-cwp.280

merge

=============== Diff against Tests-fbs.280 ===============

Item was added:
+ ----- Method: AliasTest>>testSource (in category 'tests') -----
+ testSource
+ | alias source |
+ source := #Griffle => value.
+ alias := source asBinding: #Plonk.
+ self assert: alias source == source!

Item was changed:
  TestCase subclass: #BindingPolicyTest
+ instanceVariableNames: 'environment policy value notified notifiedBinding'
- instanceVariableNames: 'namespace policy value'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Tests-Environments'!

Item was removed:
- ----- Method: BindingPolicyTest class>>isAbstract (in category 'as yet unclassified') -----
- isAbstract
- ^ self name = #BindingPolicyTest!

Item was added:
+ ----- Method: BindingPolicyTest>>addBinding: (in category 'emulating') -----
+ addBinding: aBinding
+ notified := #add.
+ notifiedBinding := aBinding!

Item was added:
+ ----- Method: BindingPolicyTest>>bindingPolicyWithNamePolicy: (in category 'tests') -----
+ bindingPolicyWithNamePolicy: aPolicy
+ ^ BindingPolicy
+ environment: environment
+ policy: aPolicy
+ addSelector: #addBinding:
+ removeSelector: #removeBinding:!

Item was added:
+ ----- Method: BindingPolicyTest>>removeBinding: (in category 'emulating') -----
+ removeBinding: aBinding
+ notified := #remove.
+ notifiedBinding := aBinding!

Item was changed:
  ----- Method: BindingPolicyTest>>setUp (in category 'running') -----
  setUp
+ environment := Environment withName: #test.
- namespace := IdentityDictionary new.
  value := Object new!

Item was added:
+ ----- Method: BindingPolicyTest>>tearDown (in category 'running') -----
+ tearDown
+ environment destroy.
+ environment := nil.
+ value := nil.!

Item was added:
+ ----- Method: BindingPolicyTest>>testAddHonorsEnvironment (in category 'tests') -----
+ testAddHonorsEnvironment
+ | binding other |
+ other := Environment withName: #other.
+ policy := self bindingPolicyWithNamePolicy: AllNamePolicy new.
+ binding := #Griffle => value.
+ policy binding: binding addedTo: other notify: self.
+ self assert: notified = nil!

Item was added:
+ ----- Method: BindingPolicyTest>>testAddHonorsName (in category 'tests') -----
+ testAddHonorsName
+ | binding |
+ policy := self bindingPolicyWithNamePolicy: (ExplicitNamePolicy spec: #Griffle -> #Nurp).
+ binding := #Griffle => value.
+ policy binding: binding addedTo: environment notify: self.
+ self assert: notified == #add!

Item was added:
+ ----- Method: BindingPolicyTest>>testAddHonorsPolicy (in category 'tests') -----
+ testAddHonorsPolicy
+ | binding |
+ policy := self bindingPolicyWithNamePolicy: (ExplicitNamePolicy spec: #Nurp).
+ binding := #Griffle => value.
+ policy binding: binding addedTo: environment notify: self.
+ self assert: notified = nil!

Item was added:
+ ----- Method: BindingPolicyTest>>testAdded (in category 'tests') -----
+ testAdded
+ | binding |
+ policy := self bindingPolicyWithNamePolicy: AllNamePolicy new.
+ binding := #Griffle => value.
+ policy binding: binding addedTo: environment notify: self.
+ self assert: notified = #add.!

Item was added:
+ ----- Method: BindingPolicyTest>>testRemoveHonorsEnvironment (in category 'tests') -----
+ testRemoveHonorsEnvironment
+ | binding other |
+ other := Environment withName: #other.
+ policy := self bindingPolicyWithNamePolicy: AllNamePolicy new.
+ binding := #Griffle => value.
+ policy binding: binding removedFrom: other notify: self.
+ self assert: notified = nil!

Item was added:
+ ----- Method: BindingPolicyTest>>testRemoveHonorsName (in category 'tests') -----
+ testRemoveHonorsName
+ | binding |
+ policy := self bindingPolicyWithNamePolicy: (ExplicitNamePolicy spec: #Griffle -> #Nurp).
+ binding := #Griffle => value.
+ policy binding: binding removedFrom: environment notify: self.
+ self assert: notified = #remove.
+ self assert: notifiedBinding key = #Nurp.
+ self assert: notifiedBinding source == binding!

Item was added:
+ ----- Method: BindingPolicyTest>>testRemoveHonorsPolicy (in category 'tests') -----
+ testRemoveHonorsPolicy
+ | binding |
+ policy := self bindingPolicyWithNamePolicy: (ExplicitNamePolicy spec: #Nurp).
+ binding := #Griffle => value.
+ policy binding: binding removedFrom: environment notify: self.
+ self assert: notified = nil!

Item was added:
+ ----- Method: BindingPolicyTest>>testRemoved (in category 'tests') -----
+ testRemoved
+ | binding |
+ policy := self bindingPolicyWithNamePolicy: AllNamePolicy new.
+ binding := #Griffle => value.
+ policy binding: binding removedFrom: environment notify: self.
+ self assert: notified = #remove!

Item was added:
+ ----- Method: ClassBindingTest>>testSource (in category 'as yet unclassified') -----
+ testSource
+ | binding |
+ binding := ClassBinding key: #Griffle value: value.
+ self assert: binding source == binding!

Item was changed:
+ ----- Method: EnvironmentTest>>assertExports:value: (in category 'asserting') -----
- ----- Method: EnvironmentTest>>assertExports:value: (in category 'export tests') -----
  assertExports: aSymbol value: v2
+ | other |
+ other := Environment withName: #other.
+ other import: env.
+ self assert: (other bindingOf: aSymbol) value = v2!
- self assert: (env public includesKey: aSymbol).
- self assert: (env public at: aSymbol) == v2!

Item was added:
+ ----- Method: EnvironmentTest>>denyExports: (in category 'asserting') -----
+ denyExports: aSymbol
+ | other |
+ other := Environment withName: #other.
+ other import: env.
+ self assert: (other bindingOf: aSymbol) isNil!

Item was changed:
  ----- Method: EnvironmentTest>>tearDown (in category 'running') -----
  tearDown
+ env destroy.
+ env := nil!
- env destroy!

Item was changed:
  ----- Method: EnvironmentTest>>testAtPutDeclared (in category 'compatibility tests') -----
  testAtPutDeclared
  | binding |
+ env importSelf.
+ env bind: #Griffle to: Object new.
- env at: #Griffle put: Object new.
  binding := env bindingOf: #Griffle.
  env at: #Griffle put: value.
  self assert: binding value == value!

Item was added:
+ ----- Method: EnvironmentTest>>testDeclaredBecomeClassBinding (in category 'compatibility tests') -----
+ testDeclaredBecomeClassBinding
+ | binding class |
+ class := Behavior new.
+ binding := env
+ bind: #Griffle to: value;
+ declarationOf: #Griffle.
+ env at: #Griffle put: class.
+ self assert: (binding class == ClassBinding).
+ self assert: binding value == class.!

Item was added:
+ ----- Method: EnvironmentTest>>testDeclaredBecomeGlobal (in category 'compatibility tests') -----
+ testDeclaredBecomeGlobal
+ | binding class |
+ class := Behavior new.
+ binding := env
+ bind: #Griffle to: class;
+ declarationOf: #Griffle.
+ env at: #Griffle put: value.
+ self assert: (binding class == Global).
+ self assert: binding value == value.!

Item was changed:
  ----- Method: EnvironmentTest>>testExclusiveExplicitExport (in category 'export tests') -----
  testExclusiveExplicitExport
  env export: #Plonk.
  env at: #Griffle put: Object new.
+ self denyExports: #Griffle!
- self assert: env public isEmpty!

Item was changed:
  ----- Method: EnvironmentTest>>testExclusiveMultiExplicitExport (in category 'export tests') -----
  testExclusiveMultiExplicitExport
  env export: #(Plonk #Griffle).
  env at: #Nurp put: Object new.
+ self denyExports: #Nurp!
- self assert: env public isEmpty!

Item was changed:
  ----- Method: EnvironmentTest>>testExplicitExport (in category 'export tests') -----
  testExplicitExport
  env export: #Griffle.
+ env bind: #Griffle to: value.
- env at: #Griffle put: value.
  self assertExports: #Griffle value: value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportAddingPrefixResolvesUndeclared (in category 'import tests') -----
  testImportAddingPrefixResolvesUndeclared
  | binding foreign |
  foreign := Environment withName: #Foreign.
  foreign exportSelf.
+ foreign bind: #Griffle to: value.
+ binding := env undeclare: #XXGriffle.
- foreign at: #Griffle put: value.
- env undeclared at: #XXGriffle put: nil.
- binding := env undeclared associationAt: #XXGriffle.
  env import: foreign addingPrefix: 'XX'.
  self assert: (env bindingOf: #XXGriffle) == binding.
  self assert: (env valueOf: #XXGriffle) == value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportAlias (in category 'import tests') -----
  testImportAlias
  | foreign binding |
  foreign := Environment withName: #Foreign.
  foreign exportSelf.
+ foreign bind: #Griffle to: value.
+ env from: foreign import: #Griffle -> #Plonk.
- foreign at: #Griffle put: value.
- env from: foreign import: #Plonk -> #Griffle.
  binding := env bindingOf: #Plonk.
  self assert: binding key = #Plonk.
  self assert: binding value == value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportAliases (in category 'import tests') -----
  testImportAliases
  | foreign v2 v3 |
  foreign := Environment withName: #Foreign.
  foreign exportSelf.
  foreign at: #Griffle put: value.
  foreign at: #Nurp put: (v2 := Object new).
  foreign at: #Ziffy put: (v3 := Object new).
+ env from: foreign import: {#Nurp -> #Plonk. #Ziffy -> #Wiffy}.
- env from: foreign import: {#Plonk -> #Nurp. #Wiffy -> #Ziffy}.
  self assert: (env bindingOf: #Griffle) isNil.
  self assert: (env bindingOf: #Plonk) value == v2.
  self assert: (env bindingOf: #Wiffy) value == v3!

Item was changed:
  ----- Method: EnvironmentTest>>testImportRemovingPrefixResolvesUndeclared (in category 'import tests') -----
  testImportRemovingPrefixResolvesUndeclared
  | binding foreign |
  foreign := Environment withName: #Foreign.
  foreign exportSelf.
  foreign at: #XXGriffle put: value.
+ binding := env undeclare: #Griffle.
- env undeclared at: #Griffle put: nil.
- binding := env undeclared associationAt: #Griffle.
  env import: foreign removingPrefix: 'XX'.
  self assert: (env bindingOf: #Griffle) == binding.
  self assert: (env valueOf: #Griffle) == value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportResolvesUndeclared (in category 'import tests') -----
  testImportResolvesUndeclared
  | binding foreign |
  foreign := Environment withName: #Foreign.
  foreign exportSelf.
  foreign at: #Griffle put: value.
+ binding := env undeclare: #Griffle.
- env undeclared at: #Griffle put: nil.
- binding := env undeclared associationAt: #Griffle.
  env import: foreign.
  self assert: (env bindingOf: #Griffle) == binding.
  self assert: (env valueOf: #Griffle) == value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportWritable (in category 'import tests') -----
  testImportWritable
  | foreign binding |
  foreign := Environment withName: #Foreign.
  foreign exportSelf.
+ foreign bind: #Griffle to: 'v1'.
+ env from: foreign import: #Griffle -> #Plonk.
- foreign at: #Griffle put: 'v1'.
- env from: foreign import: #Plonk -> #Griffle.
  binding := env bindingOf: #Plonk.
  binding value: 'v2'.
+ self assert: (foreign declarationOf: #Griffle) value = 'v2' !
- self assert: (foreign bindingOf: #Griffle) value == 'v2' !

Item was changed:
  ----- Method: EnvironmentTest>>testInternalVisibility (in category 'compiling tests') -----
  testInternalVisibility
  | griffle plonk |
+ env importSelf.
  self createClass: #Griffle.
  self createClass: #Plonk.
  griffle := env at: #Griffle.
  griffle compile: 'plonk ^ Plonk'.
  plonk := griffle new plonk.
  self assert: (env at: #Plonk) == plonk!

Item was changed:
  ----- Method: EnvironmentTest>>testReadOnlyBindings (in category 'binding tests') -----
  testReadOnlyBindings
  | binding class |
  class := Behavior new.
+ env importSelf.
+ env bind: #Griffle to: class.
- env at: #Griffle put: class.
  binding := env bindingOf: #Griffle.
  self
  should: [binding value: nil]
  raise: AttemptToWriteReadOnlyGlobal!

Item was changed:
  ----- Method: EnvironmentTest>>testRequireExplicitExports (in category 'export tests') -----
  testRequireExplicitExports
+ env bind: #Griffle to: Object new.
+ self denyExports: #Griffle.!
- env at: #Griffle put: Object new.
- self assert: env public isEmpty!

Item was changed:
  ----- Method: EnvironmentTest>>testStoreDomesticValue (in category 'compiling tests') -----
  testStoreDomesticValue
  | griffle values |
+ env importSelf.
  self createClass: #Griffle.
+ env bind: #Plonk to: value.
- env at: #Plonk put: 'v1'.
 
  griffle := env at: #Griffle.
  griffle compile: self storeValueMethod.
  values := griffle new doStore.
 
  self assert: values isArray.
  self assert: values size = 2.
  self assert: values first == values last.
+ self assert: (env valueOf: #Plonk) == values first!
- self assert: (env at: #Plonk) == values first!

Item was added:
+ ----- Method: EnvironmentTest>>testUndeclare (in category 'binding tests') -----
+ testUndeclare
+ | one two |
+ one := env undeclare: #Griffle.
+ two := env bindingOf: #Griffle.
+ self assert: one == two.
+ self assert: one class == Global!

Item was added:
+ ----- Method: EnvironmentTest>>testUndeclaredBecomeClassBinding (in category 'compatibility tests') -----
+ testUndeclaredBecomeClassBinding
+ | binding class |
+ class := Behavior new.
+ binding := env undeclared
+ add: (#Griffle => nil);
+ associationAt: #Griffle.
+ env at: #Griffle put: class.
+ self assert: (binding class == ClassBinding).
+ self assert: binding value == class.!

Item was added:
+ ----- Method: EnvironmentTest>>testUndeclaredBecomesGlobal (in category 'compatibility tests') -----
+ testUndeclaredBecomesGlobal
+ | binding class |
+ class := Behavior new.
+ binding := env undeclared
+ add: (#Griffle => class);
+ associationAt: #Griffle.
+ env bind: #Griffle to: value.
+ self assert: (binding class == Global).
+ self assert: binding value == value.!

Item was changed:
  ----- Method: EnvironmentTest>>testWriteAndLookup (in category 'binding tests') -----
  testWriteAndLookup
  | assoc |
+ env importSelf.
  env at: #Griffle put: value.
  assoc := env bindingOf: #Griffle.
  self assert: assoc key == #Griffle.
  self assert: assoc value == value.
  !

Item was removed:
- BindingPolicyTest subclass: #ExportTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Tests-Environments'!

Item was removed:
- ----- Method: ExportTest>>policyClass (in category 'running') -----
- policyClass
- ^ Export!

Item was removed:
- ----- Method: ExportTest>>testExportAll (in category 'tests') -----
- testExportAll
- policy := Export namespace: namespace.
- policy bind: #Griffle to: value.
- self assert: (namespace at: #Griffle) == value!

Item was removed:
- ----- Method: ExportTest>>testExported (in category 'tests') -----
- testExported
- policy := Export namespace: namespace policy: (ExplicitNamePolicy spec: #(Griffle)).
- policy bind: #Griffle to: value.
- self assert: (namespace at: #Griffle) == value!

Item was removed:
- ----- Method: ExportTest>>testNotExported (in category 'tests') -----
- testNotExported
- policy := Export namespace: namespace policy: (ExplicitNamePolicy spec: #Nurp).
- policy bind: #Griffle to: value.
- self assert: namespace isEmpty!

Item was removed:
- ----- Method: ExportTest>>testStackedExports (in category 'tests') -----
- testStackedExports
- | griffle plonk |
- griffle := Export
- namespace: namespace
- policy: (ExplicitNamePolicy spec: #Griffle).
- plonk := Export
- namespace: namespace
- policy: (ExplicitNamePolicy spec: #Plonk)
- next: griffle.
- plonk bind: #Griffle to: value.
- self assert: (namespace at: #Griffle) == value!

Item was added:
+ ----- Method: GlobalTest>>testSource (in category 'tests') -----
+ testSource
+ | global |
+ global := Global key: #Griffle value: Object new.
+ self assert: global source == global!

Item was removed:
- BindingPolicyTest subclass: #ImportTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Tests-Environments'!

Item was removed:
- ----- Method: ImportTest>>policyClass (in category 'running') -----
- policyClass
- ^ Import!

Item was removed:
- ----- Method: ImportTest>>testImportAll (in category 'tests') -----
- testImportAll
- | binding |
- policy := Import namespace: namespace.
- namespace at: #Griffle put: value.
- binding := policy bindingOf: #Griffle.
- self assert: binding value == value!

Item was removed:
- ----- Method: ImportTest>>testImported (in category 'tests') -----
- testImported
- | binding |
- policy := Import namespace: namespace policy: (ExplicitNamePolicy spec: #Griffle).
- namespace at: #Griffle put: value.
- binding := policy bindingOf: #Griffle.
- self assert: binding value == value.!

Item was removed:
- ----- Method: ImportTest>>testNotImported (in category 'tests') -----
- testNotImported
- | binding |
- policy := Import namespace: namespace policy: (ExplicitNamePolicy spec: #Nurp).
- namespace at: #Griffle put: value.
- binding := policy bindingOf: #Griffle.
- self assert: binding value isNil!

Item was removed:
- ----- Method: ImportTest>>testStackedImports (in category 'tests') -----
- testStackedImports
- | griffle plonk binding |
- griffle := Import
- namespace: namespace
- policy: (ExplicitNamePolicy spec: #Griffle).
- plonk := Import
- namespace: namespace
- policy: (ExplicitNamePolicy spec: #Plonk)
- next: griffle.
- namespace at: #Griffle put: value.
- binding := plonk bindingOf: #Griffle.
- self assert: binding value == value.!

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

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

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

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

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

Item was changed:
+ ----- Method: MCClassDefinitionTest>>testEquals (in category 'as yet unclassified') -----
- ----- Method: MCClassDefinitionTest>>testEquals (in category 'tests - equality') -----
  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 'as yet unclassified') -----
- ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'tests - equality') -----
  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 'as yet unclassified') -----
- ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'tests - creating') -----
  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 'as yet unclassified') -----
- ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'tests - loading') -----
  testLoadAndUnload
  | d c |
+ d :=  self mockClass: 'MCMockClassC' super: 'Object'.
- [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').
- 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'.
  d unload.
+ self deny: (Smalltalk hasClassNamed: 'MCMockClassC').!
- self deny: (environment hasClassNamed: 'MCMockClassC')]
- on: EnvironmentRequest do: [:e | e resume: environment]!

Item was changed:
  MCTestCase subclass: #MCEnvironmentLoadTest
+ instanceVariableNames: 'environment'
- instanceVariableNames: ''
  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 added:
+ ----- 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] raise: Error.
+ self assert: (navigation allImplementorsOf: #kjahs87) isEmpty!
- self
- should: [[definition load] on: EnvironmentRequest do: [:e | e resume: environment]]
- 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)!
- self deny: (self mockInstanceA respondsTo: #one)]
- on: EnvironmentRequest do: [:e | e resume: environment].!

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

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

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

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

Item was changed:
  ----- Method: PackageDependencyTest>>testCollections (in category 'tests') -----
  testCollections
  self testPackage: 'Collections' dependsExactlyOn: #(
  Compiler
  Kernel
  Files
  Graphics
  Multilingual
  System
  'ToolBuilder-Kernel'
+ Tools
  ).!

On 1 January 2014 18:41,  <[hidden email]> wrote:
I think I've established my reputation as a loud lover of
#assert:equals: :) Just sayin'.

What I often do is set these kinds of variables - variables that show
that some side effect took place - to some obviously wrong value. In
this case, you could set notifier := #notCalled in the #setUp.

I can't figure out what this test _does_ though: when you say that add
honours Environment, you mean that it only adds the binding if the
addedTo: environment matches the policy's environment, and we know
this because the notifier isn't called?

> Item was added:
> + ----- Method: BindingPolicyTest>>testRemoveHonorsEnvironment (in category 'tests') -----
> + testRemoveHonorsEnvironment
> +       | binding other |
> +       other := Environment withName: #other.
> +       policy := self bindingPolicyWithNamePolicy: AllNamePolicy new.
> +       binding := #Griffle => value.
> +       policy binding: binding removedFrom: other notify: self.
> +       self assert: notified = nil!

Same thing as #testAddHonorsEnvironment?
> Item was changed:
>   ----- Method: EnvironmentTest>>testImportAddingPrefixResolvesUndeclared (in category 'import tests') -----
>   testImportAddingPrefixResolvesUndeclared
>         | binding foreign |
>         foreign := Environment withName: #Foreign.
>         foreign exportSelf.
> +       foreign bind: #Griffle to: value.
> +       binding := env undeclare: #XXGriffle.

I like this. Nice & explicit language.

> Item was changed:
>   ----- Method: EnvironmentTest>>testImportAliases (in category 'import tests') -----
>   testImportAliases
>         | foreign v2 v3 |
>         foreign := Environment withName: #Foreign.
>         foreign exportSelf.
>         foreign at: #Griffle put: value.
>         foreign at: #Nurp put: (v2 := Object new).
>         foreign at: #Ziffy put: (v3 := Object new).

Shouldn't these be #bind:to: now?

> +       env from: foreign import: {#Nurp -> #Plonk. #Ziffy -> #Wiffy}.
> -       env from: foreign import: {#Plonk -> #Nurp. #Wiffy -> #Ziffy}.

I find this hard to understand. So the Array of Associations looks
like it says "when you see Ziffy, interpret that as if you saw Wiffy",
or "map Ziffy to Wiffy". Oh. It says "when you import foreign, map
foreign's Ziffy to env's (new) Wiffy. OK, that makes sense.

>         self assert: (env bindingOf: #Griffle) isNil.
>         self assert: (env bindingOf: #Plonk) value == v2.
>         self assert: (env bindingOf: #Wiffy) value == v3!

I realise this is existing behaviour, but I'm not so keen on
sub-environments being able to tinker with parent environments'
bindings. What's the use case here? It means an Environment can't be
used as a sandbox.

> Item was added:
> + ----- Method: EnvironmentTest>>testUndeclare (in category 'binding tests') -----
> + testUndeclare
> +       | one two |
> +       one := env undeclare: #Griffle.
> +       two := env bindingOf: #Griffle.
> +       self assert: one == two.
> +       self assert: one class == Global!

Ah. This shows that you can always add new undeclared stuff to an
environment. The name of the test didn't tell me that :/. Also, is it
part of the API that one value isNil?

Minor nit: one of these tests says "BecomeSomething" and the other
says "BecomesSomething".

> Item was changed:
> + ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'as yet unclassified') -----

So all this noise in the Monticello tests is because there are two
Tests-fbs.280 - one in trunk, and one in the inbox. Fun times. The one
in the inbox changes the MC tests to load definitions into an
Environment that's then thrown away after the test runs. This avoids
MC mucking around with global state.

The changes have been sitting in the Inbox for a week, but given
Colin's big chunk of stuff landing in the Inbox, let's review it, push
to trunk when ready, and then I'll update my MC test hacking, and
resubmit.

frank

On 1 January 2014 22:26, Colin Putney <[hidden email]> wrote:
Yep :)

Yes, indeed.

Yes, it is. OK. It might just be something to get used to. I wouldn't
mind a comment in #from:import: saying this.

Hm, OK.

>> So all this noise in the Monticello tests is because there are two
>> Tests-fbs.280 - one in trunk, and one in the inbox. Fun times. The one
>> in the inbox changes the MC tests to load definitions into an
>> Environment that's then thrown away after the test runs. This avoids
>> MC mucking around with global state.
>
>
> Ugh, sorry about that. Didn't notice the extra changes.

No, that's the thing: because you submitted this commit to the Inbox,
we get a diff against Tests-fbs.280 from the Inbox. These changes
aren't relative to trunk. It's just unfortunate happenstance that I
hacked on Tests in both trunk and Inbox.

The changes aren't in this commit.

>> The changes have been sitting in the Inbox for a week, but given
>> Colin's big chunk of stuff landing in the Inbox, let's review it, push
>> to trunk when ready, and then I'll update my MC test hacking, and
>> resubmit.
>
>
> I've been meaning to review that, but I wanted to get these changes done
> before I forget how they work. :-)

Yeah, I'll rein in my impatience for the moment :)

frank

> Colin