[Pkg] The Trunk: Tests-cwp.295.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Apr 1 02:36:24 UTC 2014


Colin Putney uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-cwp.295.mcz

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

Name: Tests-cwp.295
Author: cwp
Time: 31 March 2014, 9:35:49.208 pm
UUID: fcac78df-a827-4247-8945-d29aa1da1155
Ancestors: Tests-cwp.294

Add comments to EnvironmentTest.

=============== Diff against Tests-cwp.294 ===============

Item was changed:
+ ----- Method: EnvironmentTest>>createClass: (in category 'support') -----
- ----- Method: EnvironmentTest>>createClass: (in category 'running') -----
  createClass: aSymbol
  	| builder |
  	builder := ClassBuilder new.
  	^ builder
  		name: aSymbol
  		inEnvironment: env
  		subclassOf: Object
  		type: #normal
  		instanceVariableNames: ''
  		classVariableNames: ''
  		poolDictionaries: ''
  		category: 'Test'.
  	!

Item was changed:
+ ----- Method: EnvironmentTest>>storeValueMethod (in category 'support') -----
- ----- Method: EnvironmentTest>>storeValueMethod (in category 'running') -----
  storeValueMethod
+ 	"Assign an object to the global,
+ 	capture the value of the assignment 
+ 	expression, and answer both
+ 	the object and the result."
+ 
+ 
  	^ 'doStore
  	| expr result | 
  	expr := Object new.  
  	result := Plonk := expr. 
  	^ { expr. result }
  '!

Item was changed:
  ----- Method: EnvironmentTest>>testAtDoesntFindUndeclared (in category 'binding tests') -----
  testAtDoesntFindUndeclared
+ 	"It seems reasonable for #bindingOf: to answer either an
+ 	existing binding, or create an undeclared binding and
+ 	answer that. Reasonable, but wrong. The tools expect to 
+ 	receive nil if no binding exists, and explicitly create
+ 	an undeclared binding if that's desirable."
+ 	
  	env := Environment withName: #Test.
  	env bindingOf: #Griffle.
  	self should: [ env at: #Griffle ] raise: KeyNotFound!

Item was changed:
  ----- Method: EnvironmentTest>>testAtIfAbsent (in category 'compatibility tests') -----
  testAtIfAbsent
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 
  	| result |
  	result := env at: #Griffle ifAbsent: [value].
  	self assert: result == value!

Item was changed:
  ----- Method: EnvironmentTest>>testAtIfAbsentNot (in category 'compatibility tests') -----
  testAtIfAbsentNot
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 
  	| result |
  	env at: #Griffle put: value.
  	result := env at: #Griffle ifAbsent: [self assert: false].
  	self assert: result == value!

Item was changed:
  ----- Method: EnvironmentTest>>testAtIfPresent (in category 'compatibility tests') -----
  testAtIfPresent
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 
  	| result |
  	env at: #Griffle put: value.
  	env at: #Griffle ifPresent: [:v | result := v].
  	self assert: result == value!

Item was removed:
- ----- Method: EnvironmentTest>>testAtIfPresentIfAbsent (in category 'compatibility tests') -----
- testAtIfPresentIfAbsent
- 	self assert: #absent equals: (env at: #Griffle ifPresent: [:c | c] ifAbsent: [#absent]).
- 	env at: #Griffle put: value.
- 	self assert: value equals: (env at: #Griffle ifPresent: [:c | c] ifAbsent: [#absent]).!

Item was added:
+ ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentAbsent (in category 'compatibility tests') -----
+ testAtIfPresentIfAbsentAbsent
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 
+ 	| answer result |
+ 	result := Object new.
+ 	answer := env 
+ 		at: #Griffle 
+ 		ifPresent: [:v | self fail: 'should not reach here'] 
+ 		ifAbsent: [result].
+ 		
+ 	self
+ 		assert: result 
+ 		identical: answer
+ 		description: 'Method answers the result of the absent block'!

Item was added:
+ ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentPresent (in category 'compatibility tests') -----
+ testAtIfPresentIfAbsentPresent
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 
+ 	| answer argument result |
+ 	result := Object new.
+ 	env at: #Griffle put: value.
+ 	answer := env 
+ 		at: #Griffle 
+ 		ifPresent: [:v | argument := v. result] 
+ 		ifAbsent: [#absent].
+ 		
+ 	self 
+ 		assert: value 
+ 		identical: argument 
+ 		description: 'Value is passed to the ifPresent block'.
+ 	self
+ 		assert: result 
+ 		identical: answer
+ 		description: 'Method answers the result of the block'!

Item was changed:
  ----- Method: EnvironmentTest>>testAtIfPresentNot (in category 'compatibility tests') -----
  testAtIfPresentNot
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 	
+ 	env 
+ 		at: #Griffle 
+ 		ifPresent: [self fail: 'should not reach here'].!
- 	env at: #Griffle ifPresent: [self assert: false].!

Item was changed:
  ----- Method: EnvironmentTest>>testAtPutDeclared (in category 'compatibility tests') -----
  testAtPutDeclared
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 
  	| binding |
- 	env importSelf.
  	env bind: #Griffle to: Object new.
+ 	binding := env associationAt: #Griffle.
- 	binding := env bindingOf: #Griffle.
  	env at: #Griffle put: value.
  	self assert: binding value == value!

Item was changed:
  ----- Method: EnvironmentTest>>testAtPutUndeclared (in category 'compatibility tests') -----
  testAtPutUndeclared
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 
  	| binding |
+ 	binding := env undeclare: #Griffle.
- 	binding := env undeclared
- 		at: #Griffle put: nil;
- 		associationAt: #Griffle.
  	env at: #Griffle put: value.
  	self assert: binding value == value!

Item was changed:
  ----- Method: EnvironmentTest>>testDeclaredBecomeClassBinding (in category 'compatibility tests') -----
  testDeclaredBecomeClassBinding
+ 	"If a global variable is assigned a class as
+ 	its value, its binding will become a class 
+ 	binding."
+ 
  	| 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 changed:
  ----- Method: EnvironmentTest>>testDeclaredBecomeGlobal (in category 'compatibility tests') -----
  testDeclaredBecomeGlobal
+ 	"If a class binding gets assigned a non-
+ 	class value, the binding becomes a global."
+ 
  	| 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>>testDestroyRemovesObservers (in category 'observation tests') -----
  testDestroyRemovesObservers
+ 	"When an imported environment is destroyed,
+ 	the import is destroyed along with it."
+ 
  	| foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	env import: foreign.
  	foreign destroy.
  	self assert: 0 equals: (env instVarNamed: 'policies') size!

Item was changed:
  ----- Method: EnvironmentTest>>testDestroyStopsObserving (in category 'observation tests') -----
  testDestroyStopsObserving
+ 	"When an environment is destroyed, it removes its self
+ 	from the observers list of other environments."
+ 
  	| foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	env import: foreign.
  	env destroy.
  	self assert: 0 equals: (foreign instVarNamed: 'observers') size!

Item was changed:
  ----- Method: EnvironmentTest>>testDestroyedImportIsUndeclared (in category 'observation tests') -----
  testDestroyedImportIsUndeclared
+ 	"When an imported environment is destroyed, it's
+ 	bindings become undeclared in the importing environment"
+ 
  	| foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign at: #Griffle put: value.
  	env from: foreign import: #Griffle.
  	foreign destroy.
  	self assert: (env bindingOf: #Griffle) isNil.
  	self assert: (env isUndeclared: #Griffle).!

Item was changed:
  ----- Method: EnvironmentTest>>testExclusiveExplicitExport (in category 'export tests') -----
  testExclusiveExplicitExport
+ 	"Exporting one name shouldn't
+ 	export others."
+ 
  	env export: #Plonk.
  	env at: #Griffle put: Object new.
  	self denyExports: #Griffle!

Item was changed:
  ----- Method: EnvironmentTest>>testExclusiveMultiExplicitExport (in category 'export tests') -----
  testExclusiveMultiExplicitExport
+ 	"Exporting multiple names shouldn't export
+ 	a name not on the list."
+ 
  	env export: #(Plonk #Griffle).
  	env at: #Nurp put: Object new.
  	self denyExports: #Nurp!

Item was changed:
  ----- Method: EnvironmentTest>>testExplicitExport (in category 'export tests') -----
  testExplicitExport
+ 	"Export a single name"
+ 	
  	env export: #Griffle.
  	env bind: #Griffle to: value.
  	self assertExports: #Griffle value: value!

Item was changed:
  ----- Method: EnvironmentTest>>testExportAddPrefix (in category 'export tests') -----
  testExportAddPrefix
+ 	"export all names, adding a prefix."
+ 	
  	env exportAddingPrefix: 'XX'.
  	env at: #Griffle put: value.
  	self assertExports: #XXGriffle value: value!

Item was changed:
  ----- Method: EnvironmentTest>>testExportAddingPrefixPublicizesExistingValue (in category 'export tests') -----
  testExportAddingPrefixPublicizesExistingValue
+ 	"Export, adding prefix, *after* the binding has been created"
+ 	
  	env at: #Griffle put: value.
  	env exportAddingPrefix: 'XX'.
  	self assertExports: #XXGriffle value: value!

Item was changed:
  ----- Method: EnvironmentTest>>testExportPublicizesExistingValue (in category 'export tests') -----
  testExportPublicizesExistingValue
+ 	"Export a single name, after the binding as been created."
+ 	
  	env at: #Griffle put: value.
  	env export: #Griffle.
  	self assertExports: #Griffle value: value!

Item was changed:
  ----- Method: EnvironmentTest>>testExportRemovingPrefix (in category 'export tests') -----
  testExportRemovingPrefix
+ 	"Export all names, removing a prefix"
+ 
  	env exportRemovingPrefix: 'XX'.
  	env at: #XXGriffle put: value.
  	self assertExports: #Griffle value: value!

Item was changed:
  ----- Method: EnvironmentTest>>testExportRemovingPrefixPublicizesExistingValue (in category 'export tests') -----
  testExportRemovingPrefixPublicizesExistingValue
+ 	"Export all names, removing a prefix, 
+ 	after a binding has been created."
+ 
  	env at: #XXGriffle put: value.
  	env exportRemovingPrefix: 'XX'.
  	self assertExports: #Griffle value: value!

Item was changed:
  ----- Method: EnvironmentTest>>testExportSelfPublicizesExistingValue (in category 'export tests') -----
  testExportSelfPublicizesExistingValue
+ 	"Export all values, after a binding has been created."
+ 	
  	env at: #Griffle put: value.
  	env exportSelf.
  	self assertExports: #Griffle value: value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportAddingPrefix (in category 'import tests') -----
  testImportAddingPrefix
+ 	"Import a single name adding a prefix."
+ 
  	| foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign at: #Griffle put: value.
  	env import: foreign addingPrefix: 'XX'.
  	self assert: (env bindingOf: #XXGriffle) value == value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportAddingPrefixResolvesUndeclared (in category 'import tests') -----
  testImportAddingPrefixResolvesUndeclared
+ 	"If there's an existing undeclared variable, importing
+ 	a binding with the same (transformed) name creates
+ 	the binding."
+ 
  	| binding foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign bind: #Griffle to: value.
  	binding := env undeclare: #XXGriffle.
  	env import: foreign addingPrefix: 'XX'.
  	self assert: (env bindingOf: #XXGriffle) == binding.
  	self assert: (env valueOf: #XXGriffle) == value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportAliases (in category 'import tests') -----
  testImportAliases
+ 	"Import several specific names, renaming them."
+ 
  	| 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}.
  	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>>testImportFromOther (in category 'import tests') -----
  testImportFromOther
+ 	"Import a whole environment."
+ 
  	| foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign at: #Griffle put: value.
  	env import: foreign.
  	self assert: (env bindingOf: #Griffle) value == value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportOne (in category 'import tests') -----
  testImportOne
+ 	"import s specific name"
+ 
  	| foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign at: #Griffle put: value.
  	env from: foreign import: #Griffle.
  	self assert: (env bindingOf: #Griffle) value == value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportRemovingPrefix (in category 'import tests') -----
  testImportRemovingPrefix
+ 	"Import all names, removing a prefix."
+ 
  	| foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign at: #XXGriffle put: value.
  	env import: foreign removingPrefix: 'XX'.
  	self assert: (env bindingOf: #Griffle) value == value!

Item was changed:
  ----- Method: EnvironmentTest>>testImportRemovingPrefixResolvesUndeclared (in category 'import tests') -----
  testImportRemovingPrefixResolvesUndeclared
+ 	"Import all names, removing a prefix, with undeclared"
+ 
  	| binding foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign at: #XXGriffle put: value.
  	binding := env undeclare: #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
+ 	"Import all bindings, with undeclared"
+ 
  	| binding foreign |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign at: #Griffle put: value.
  	binding := env undeclare: #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
+ 	"Imported globals, even if renamed, should be writable."
+ 
  	| foreign binding |
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign bind: #Griffle to: 'v1'.
  	env from: foreign import: #Griffle -> #Plonk.
  	binding := env bindingOf: #Plonk.
  	binding value: 'v2'.
  	self assert: (foreign declarationOf: #Griffle) value = 'v2' !

Item was changed:
  ----- Method: EnvironmentTest>>testInternalVisibility (in category 'compiling tests') -----
  testInternalVisibility
+ 	"A method on a class in an environment
+ 	can refer to other classes in that environment
+ 	(provided the environment imports its self)"
+ 	
  	| 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>>testMultiExplicitExport (in category 'export tests') -----
  testMultiExplicitExport
+ 	"Export a list of names"
+ 
  	| v2 |
  	env export: #(#Griffle #Plonk).
  	env at: #Griffle put: value.
  	env at: #Plonk put: (v2 := Object new).
  	self assertExports: #Griffle value: value.
  	self assertExports: #Plonk value: v2!

Item was changed:
  ----- Method: EnvironmentTest>>testMultiExportPublicizesExistingValue (in category 'export tests') -----
  testMultiExportPublicizesExistingValue
+ 	"Export a list of names, with existing binaries."
+ 	
  	| v2 |
  	env at: #Griffle put: value.
  	env at: #Plonk put: (v2 := Object new).
  	env export: #(Griffle Plonk).
  	self assertExports: #Griffle value: value.
  	self assertExports: #Plonk value: v2.!

Item was changed:
  ----- Method: EnvironmentTest>>testReadOnlyBindings (in category 'binding tests') -----
  testReadOnlyBindings
+ 	"It's almost always a bug to overwrite a class, so 
+ 	all class bindings should be read-only by default."
+ 	
  	| binding class |
  	class := Behavior new.
  	env importSelf.
  	env bind: #Griffle to: class.
  	binding := env bindingOf: #Griffle.
  	self
  		should: [binding value: nil]
  		raise: AttemptToWriteReadOnlyGlobal!

Item was changed:
  ----- Method: EnvironmentTest>>testRemoveKey (in category 'compatibility tests') -----
  testRemoveKey
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 
+ 	self 
+ 		should: [env removeKey: #Griffle] 
+ 		raise: KeyNotFound.!
- 	self should: [env removeKey: #Griffle] raise: KeyNotFound.!

Item was changed:
  ----- Method: EnvironmentTest>>testRemoveKeyIfAbsent (in category 'compatibility tests') -----
  testRemoveKeyIfAbsent
+ 	"For compatibility with legacy code, environments 
+ 	should implement the dictionary protocol."
+ 
  	| result |
  	result := env removeKey: #Griffle ifAbsent: [#removed].
  	self assert: #removed equals: result.
  	
  	env at: #Griffle put: value.
  	result := env removeKey: #Griffle ifAbsent: [#removed].
  	self assert: value equals: result.!

Item was changed:
  ----- Method: EnvironmentTest>>testRenameCreatesNewBinding (in category 'class tests') -----
  testRenameCreatesNewBinding
+ 	"When we rename a class, a completely new 
+ 	binding should be created for the new name.
+ 	The old binding is moved to undeclared, and
+ 	given a null value."
+ 
  	| class newBinding oldBinding |
  	env importSelf.
  	class := self createClass: #Griffle.
  	oldBinding := env bindingOf: #Griffle.
  	class rename: #Plonk.
  	newBinding := env bindingOf: #Plonk.
  	self deny: newBinding == oldBinding.
  	
  	self assert: nil identical: oldBinding value.
  	self assert: #Griffle equals: oldBinding key.
  	
  	self assert: #Plonk equals: newBinding key.
  	self assert: class identical: newBinding value.
  	!

Item was changed:
  ----- Method: EnvironmentTest>>testRequireExplicitExports (in category 'export tests') -----
  testRequireExplicitExports
+ 	"Names that haven't been exported
+ 	aren't visible, even if a binding exists."
+ 
  	env bind: #Griffle to: Object new.
  	self denyExports: #Griffle.!

Item was changed:
  ----- Method: EnvironmentTest>>testStoreDomesticValue (in category 'compiling tests') -----
  testStoreDomesticValue
+ 	"Create a class that implements #doStore.
+ 	(see the comment in #storeValueMethod.)
+ 	Send the message, then examine the results.
+ 	The two values should be identical."
+ 
  	| griffle values |
  	env importSelf.
  	self createClass: #Griffle.
  	env bind: #Plonk to: value.
  		
  	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!

Item was changed:
  ----- Method: EnvironmentTest>>testStoreImportedValue (in category 'compiling tests') -----
  testStoreImportedValue
+ 	"Create a class that implements #doStore.
+ 	Import #Plonk from another environment.
+ 	(see the comment in #storeValueMethod.)
+ 	Send the message, then examine the results.
+ 	The two values should be identical."
+ 
  	| griffle foreign values |
  	self createClass: #Griffle.
  	foreign := Environment withName: #Foreign.
  	foreign exportSelf.
  	foreign at: #Plonk put: 'v1'.
  	env from: foreign import: #Plonk.
  	
  	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: (foreign at: #Plonk) == values first!

Item was changed:
  ----- Method: EnvironmentTest>>testUndeclare (in category 'binding tests') -----
  testUndeclare
+ 	"When a symbol is undeclared, it's not visible to methods compiled
+ 	in the environment, so #bindingOf: should answer nil. However, 
+ 	methods that refer to the symbol anyway use a canonical binding.
+ 	That binding should have a nil value and be an instance of Global, 
+ 	rather than a class binding or alias."
+ 
  	| one two |
  	one := env undeclare: #Griffle.
  	two := env bindingOf: #Griffle.
  	self assert: nil equals: two description: '#bindingOf:'.
  	self assert: Global equals: one class description: 'Type of binding'.
  	self assert: nil equals: one value description: 'Value of binding'.!

Item was changed:
  ----- Method: EnvironmentTest>>testUndeclareAgain (in category 'binding tests') -----
  testUndeclareAgain
+ 	"Multiple 'undeclarations' of the same variable name should
+ 	use the same canonical binding."
+ 	
  	| one two |
  	one := env undeclare: #Griffle.
  	two := env undeclare: #Griffle.
  	self assert: one == two.!

Item was changed:
  ----- Method: EnvironmentTest>>testUndeclareFromConflict (in category 'binding tests') -----
  testUndeclareFromConflict
+ 	"When a shared variable is removed from a class pool,
+ 	it gets undeclared in the environment. If that variable
+ 	name is *already* undeclared in the environment, the
+ 	binding in the environment is maintained, and references
+ 	to the pool binding become references to the environment's
+ 	binding. The binding should be a Global."
+ 
  	| one pool three two |
  	pool := IdentityDictionary new.
  	pool at: #Griffle put: value.
  	one := pool bindingOf: #Griffle.
  	two := env undeclare: #Griffle.
  	three := env undeclare: #Griffle from: pool.
  	self assert: three == two description: 'Existing binding is reused'.
  	self assert: three == one description: 'Pool binding is forwarded'.
  	self assert: Global equals: three class description: 'Type of binding'.
  	!

Item was changed:
  ----- Method: EnvironmentTest>>testUndeclareFromEmpty (in category 'binding tests') -----
  testUndeclareFromEmpty
+ 	"When a binding is moved from a pool to an environment, but
+ 	actually doesn't exist in the pool in the first place, a new binding
+ 	with a nil value is created for the environment's undeclared dictionary."
+ 
  	| binding |
  	binding := env undeclare: #Griffle from: IdentityDictionary new.
  	self assert: Global equals: binding class description: 'Type of binding'.
  	self assert: nil equals: binding value description: 'Value of binding'.!

Item was changed:
  ----- Method: EnvironmentTest>>testUndeclareFromRemovesOld (in category 'binding tests') -----
  testUndeclareFromRemovesOld
+ 	"When a binding is removed from a pool,
+ 	and undeclared in the enviornment, it should
+ 	actually be removed from the pool dictionary."
+ 	
  	| pool |
  	pool := IdentityDictionary new.
  	pool at: #Griffle put: value.
  	env undeclare: #Griffle from: pool.
  	self 
  		assert: false 
  		equals: (pool includesKey: #Griffle) 
  		description: 'Existing binding is removed'.
  	!

Item was changed:
  ----- Method: EnvironmentTest>>testUndeclaredBecomeClassBinding (in category 'compatibility tests') -----
  testUndeclaredBecomeClassBinding
+ 	"When a undeclared name is bound to a
+ 	class existing bindings are transformed
+ 	into ClassBindings."
+ 
  	| binding class |
  	class := Behavior new.
+ 	binding := env undeclare: #Griffle.
- 	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 changed:
  ----- Method: EnvironmentTest>>testUndeclaredBecomesGlobal (in category 'compatibility tests') -----
  testUndeclaredBecomesGlobal
+ 	"If a class binding is somehow undeclared, 
+ 	it becomes a Global when a non-behavior
+ 	value is bound to the name."
+ 
  	| 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>>testUndeclaredBindingMoved (in category 'binding tests') -----
  testUndeclaredBindingMoved
+ 	"If a binding is undeclared, and subsequently
+ 	declared, the existing binding is re-used for 
+ 	the declaration."
+ 	
+ 	| binding |
+ 	binding := env undeclare: #Griffle.
+ 	env bind: #Griffle to: value.
+ 	self assert: (env declarationOf: #Griffle) = binding.!
- 	| assoc |
- 	assoc := env bindingOf: #Griffle.
- 	env at: #Griffle put: value.
- 	self assert: (env at: #Griffle) == value!

Item was changed:
+ ----- Method: EnvironmentTest>>testWriteAndLookup (in category 'compatibility tests') -----
- ----- Method: EnvironmentTest>>testWriteAndLookup (in category 'binding tests') -----
  testWriteAndLookup
+ 	"For compatibility with SystemDictionary, #at:put:
+ 	should create a binding which can subsequently
+ 	be found with #associationAt:."
+ 	
+ 	| binding |
- 	| assoc |
- 	env importSelf.
  	env at: #Griffle put: value.
+ 	binding := env associationAt: #Griffle.
+ 	self assert: binding key == #Griffle.
+ 	self assert: binding value == value.
- 	assoc := env bindingOf: #Griffle.
- 	self assert: assoc key == #Griffle.
- 	self assert: assoc value == value.
  	!

Item was changed:
+ ----- Method: EnvironmentTest>>testWriteAndRead (in category 'compatibility tests') -----
- ----- Method: EnvironmentTest>>testWriteAndRead (in category 'binding tests') -----
  testWriteAndRead
+ 	"For compatibility with SystemDictionary,
+ 	a value set with #at:put: should be retrievable
+ 	with #at:"
+ 
  	env at: #Griffle put: value.
  	self assert: (env at: #Griffle) == value.!



More information about the Packages mailing list