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.!