Packages April 2014

packages@lists.squeakfoundation.org

2 participants
18 discussions

The Trunk: Files-eem.132.mcz
by commits＠source.squeak.org 22 Apr '14

22 Apr '14

Eliot Miranda uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-eem.132.mcz ==================== Summary ==================== Name: Files-eem.132 Author: eem Time: 21 April 2014, 3:07:09.85 pm UUID: 4ae7fd40-36ae-4c78-9481-eede8bd586cd Ancestors: Files-cmm.131 Fix FileDirectory on: asnd FileDirectory class on: for "..", and hence fix the VMMakerTool for paths such as '../platforms'. =============== Diff against Files-cmm.131 =============== Item was changed: ----- Method: FileDirectory class>>on: (in category 'instance creation') ----- on: pathString "Return a new file directory for the given path, of the appropriate FileDirectory subclass for the current OS platform." | pathName | DirectoryClass ifNil: [self setDefaultDirectoryClass]. "If path ends with a delimiter (: or /) then remove it" + pathName := pathString. + (pathName at: pathName size ifAbsent: nil) = self pathNameDelimiter ifTrue: + [pathName := pathName allButLast]. + DirectoryClass parentDirectoryNickname ifNotNil: + [:parentName| + (pathName beginsWith: parentName) ifTrue: + [pathName = parentName ifTrue: + [^self default containingDirectory]. + (pathName at: parentName size + 1 ifAbsent: nil) = self pathNameDelimiter ifTrue: + [^self default containingDirectory on: (pathName allButFirst: parentName size + 1)]]]. + ^DirectoryClass new setPathName: pathName! - ((pathName := pathString) endsWith: self pathNameDelimiter asString) ifTrue: [ - pathName := pathName copyFrom: 1 to: pathName size - 1]. - ^ DirectoryClass new setPathName: pathName - ! Item was changed: ----- Method: FileDirectory>>on: (in category 'path access') ----- + on: path - on: fullPath "Return another instance" + ^ self class on: ((path at: 1 ifAbsent: nil) = self pathNameDelimiter + ifTrue: [path] + ifFalse: [pathName asString, (String with: self pathNameDelimiter), path])! - ^ self class on: fullPath!

1 0

The Trunk: Files-eem.132.mcz
by commits＠source.squeak.org 22 Apr '14

22 Apr '14

1 0

The Trunk: KernelTests-dtl.265.mcz
by commits＠source.squeak.org 19 Apr '14

19 Apr '14

David T. Lewis uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-dtl.265.mcz ==================== Summary ==================== Name: KernelTests-dtl.265 Author: dtl Time: 18 April 2014, 9:40:18.546 pm UUID: b53640c7-174e-4b68-8298-a4886b8b4098 Ancestors: KernelTests-nice.264 Add DateAndTimeTest>>testAsStringFromString to verify parsing and printing across a wide time range. Fix DateAndTimeTest>>testReadFrom to restore its apparent original intent. =============== Diff against KernelTests-nice.264 =============== Item was added: + ----- Method: DateAndTimeTest>>testAsStringFromString (in category 'Tests') ----- + testAsStringFromString + "Convert to string then back, verify same date and time. Skip years in the + range 0 to 99 because they are interpreted relative to 2000." + + | day hour dt min mo nano offset sec dtNew s | + mo := 12. + day := 2. + hour := 2. + min := 3. + sec := 4. + nano := 5. + offset := 6 hours. + (-2000 to: -1) , (100 to: 5000) do: [:yr | + dt := DateAndTime + year: yr month: mo day: day + hour: hour minute: min second: sec nanoSecond: nano + offset: offset. + s := dt asString. + dtNew := DateAndTime fromString: s. + self assert: dt equals: dtNew]. + ! Item was changed: ----- Method: DateAndTimeTest>>testReadFrom (in category 'Tests') ----- testReadFrom + self assert: '-1199-01-05T20:33:14.321-05:00' equals: (DateAndTime readFrom: '-1199-01-05T20:33:14.321-05:00' readStream) printString. + self assert: '-1199-01-05T20:33:14.321-05:00' equals: '-1199-01-05T20:33:14.321-05:00' asDateAndTime printString. + self assert: '2002-05-16T17:20:45.1+01:01' equals: '2002-05-16T17:20:45.1+01:01' asDateAndTime printString. + self assert: '2002-05-16T17:20:45.02+01:01' equals: ' 2002-05-16T17:20:45.02+01:01' asDateAndTime printString. + self assert: '2002-05-16T17:20:45.000000009+01:01' equals: '2002-05-16T17:20:45.000000009+01:01' asDateAndTime printString. + self assert: '2002-05-16T17:20:00+00:00' equals: ' 2002-05-16T17:20' asDateAndTime printString. + self assert: '2002-05-16T17:20:45+00:00' equals: '2002-05-16T17:20:45' asDateAndTime printString. + self assert: '2002-05-16T17:20:45+01:57' equals: ' 2002-05-16T17:20:45+01:57' asDateAndTime printString. + self assert: '2002-05-16T17:20:45-02:34' equals: ' 2002-05-16T17:20:45-02:34' asDateAndTime printString. + self assert: '2002-05-16T17:20:45+00:00' equals: '2002-05-16T17:20:45+00:00' asDateAndTime printString. + self assert: '1997-04-26T01:02:03+01:02:3' equals: '1997-04-26T01:02:03+01:02:3' asDateAndTime printString! - self assert: ((DateAndTime readFrom: '-1199-01-05T20:33:14.321-05:00' readStream) printString = '-1199-01-05T20:33:14.321-05:00'). - - - !

1 0

The Trunk: KernelTests-dtl.265.mcz
by commits＠source.squeak.org 19 Apr '14

19 Apr '14

1 0

The Trunk: KernelTests-dtl.265.mcz
by commits＠source.squeak.org 19 Apr '14

19 Apr '14

1 0

The Trunk: Tests-cwp.295.mcz
by commits＠source.squeak.org 01 Apr '14

01 Apr '14

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

1 0

The Trunk: Tests-cwp.295.mcz
by commits＠source.squeak.org 01 Apr '14

01 Apr '14

1 0

The Trunk: Tests-cwp.295.mcz
by commits＠source.squeak.org 01 Apr '14

01 Apr '14

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages April 2014