Squeak-dev December 2009

squeak-dev@lists.squeakfoundation.org

97 participants
553 discussions

The Trunk: System-ar.206.mcz
by commits＠source.squeak.org 28 Dec '09

28 Dec '09

Andreas Raab uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ar.206.mcz ==================== Summary ==================== Name: System-ar.206 Author: ar Time: 28 December 2009, 1:39:55 am UUID: ae1a4168-4967-0c4b-90cb-d15f8d045a23 Ancestors: System-dtl.205 Preparations for NanoTraits: Make sure traits are treated like superclasses when filing out class categories; Smalltalk>>traitNames uses #isTrait instead of isKindOf: Trait and SystemNavigation>>allBehaviorsDo: delegates to ClassDescription to vector through the current traits implementation. =============== Diff against System-dtl.205 =============== Item was changed: ----- Method: SystemDictionary>>traitNames (in category 'class and trait names') ----- traitNames "Answer a SortedCollection of all traits (not including class-traits) names." | names | names := OrderedCollection new. self do: [:cl | (cl isInMemory + and: [(cl isTrait) - and: [(cl isKindOf: Trait) and: [(cl name beginsWith: 'AnObsolete') not]]) ifTrue: [names add: cl name]]. ^ names! Item was changed: ----- Method: SystemNavigation>>allBehaviorsDo: (in category 'query') ----- allBehaviorsDo: aBlock "Evaluate the argument, aBlock, for each kind of Behavior in the system (that is, Object and its subclasses and Traits). ar 7/15/1999: The code below will not enumerate any obsolete or anonymous behaviors for which the following should be executed: Smalltalk allObjectsDo:[:obj| obj isBehavior ifTrue:[aBlock value: obj]]. but what follows is way faster than enumerating all objects." aBlock value: ProtoObject. ProtoObject allSubclassesDoGently: aBlock. "don't bring in ImageSegments" "Classes outside the ProtoObject hierarchy" Class subclassesDo: [:aClass | (aClass == ProtoObject class or: [aClass isInMemory not or: [aClass isMeta not]]) ifFalse: ["Enumerate the non-meta class and its subclasses" aBlock value: aClass soleInstance. aClass soleInstance allSubclassesDoGently: aBlock]]. + ClassDescription allTraitsDo:[:trait | aBlock value: trait].! - Trait allInstances , ClassTrait allInstances do: [:trait | - aBlock value: trait]! Item was changed: ----- Method: ChangeSet class>>doWeFileOut:given:cache: (in category 'fileIn/Out') ----- doWeFileOut: aClass given: aSet cache: cache | aClassAllSuperclasses aClassSoleInstanceAllSuperclasses | + aClassAllSuperclasses := cache at: aClass ifAbsentPut:[ + aClass allSuperclasses asArray, aClass allTraits. + ]. - - aClassAllSuperclasses := cache at: aClass - ifAbsent: [cache at: aClass put: aClass allSuperclasses asArray]. (aSet includesAnyOf: aClassAllSuperclasses) ifTrue: [^false]. aClass isMeta ifFalse: [^true]. (aSet includes: aClass soleInstance) ifTrue: [^false]. aClassSoleInstanceAllSuperclasses := cache at: aClass soleInstance + ifAbsentPut: [aClass soleInstance allSuperclasses asArray, aClass soleInstance allTraits]. - ifAbsent: [cache at: aClass soleInstance put: aClass soleInstance allSuperclasses asArray]. (aSet includesAnyOf: aClassSoleInstanceAllSuperclasses) ifTrue: [^false]. ^true!

1 0

The Trunk: Monticello-ar.343.mcz
by commits＠source.squeak.org 28 Dec '09

28 Dec '09

Andreas Raab uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ar.343.mcz ==================== Summary ==================== Name: Monticello-ar.343 Author: ar Time: 28 December 2009, 1:37:41 am UUID: 869b076e-188c-a847-b63c-57eb46d7e8b7 Ancestors: Monticello-nice.342 NanoTraits preparations: Vector traits creation through ClassDescription protocol so that we can replace Berne traits. =============== Diff against Monticello-nice.342 =============== Item was changed: ----- Method: MCTraitDefinition>>createClass (in category 'visiting') ----- createClass + ^ClassDescription + newTraitNamed: name - ^Trait - named: name uses: (Compiler evaluate: self traitCompositionString) category: category !

1 0

The Trunk: Kernel-ar.348.mcz
by commits＠source.squeak.org 28 Dec '09

28 Dec '09

Andreas Raab uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ar.348.mcz ==================== Summary ==================== Name: Kernel-ar.348 Author: ar Time: 28 December 2009, 1:35:01 am UUID: 9537d1a1-5ef5-c941-b4a6-601d0aa6ad76 Ancestors: Kernel-dtl.347 NanoTrait preparations: Vector all traits dependencies through a protocol in ClassDescription so that we can have alternative trait versions be the default. Provide CompiledMethod>>methodHome to ask for the original place a particular method was defined (methodHome == methodClass for all 'normal' methods). Additional guards for Berne trait idiosynchracies (updateOrganizationSelector: etc) that simply do not apply for alternative traits. =============== Diff against Kernel-dtl.347 =============== Item was added: + ----- Method: Behavior>>removeSelector: (in category 'adding/removing methods') ----- + removeSelector: aSelector + "Assuming that the argument, selector (a Symbol), is a message selector + in my method dictionary, remove it and its method. + + If the method to remove will be replaced by a method from my trait composition, + the current method does not have to be removed because we mark it as non-local. + If it is not identical to the actual method from the trait it will be replaced automatically + by #noteChangedSelectors:. + + This is useful to avoid bootstrapping problems when moving methods to a trait + (e.g., from TPureBehavior to TMethodDictionaryBehavior). Manual moving (implementing + the method in the trait and then remove it from the class) does not work if the methods + themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or + addTraitSelector:withMethod:)" + + | changeFromLocalToTraitMethod | + + "-- support for alternative trait implementation --" + (self traitComposition isKindOf: TraitComposition) + ifFalse:[^self basicRemoveSelector: aSelector]. + + changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector) + and: [self hasTraitComposition] + and: [self traitComposition includesMethod: aSelector]. + + changeFromLocalToTraitMethod + ifFalse: [self basicRemoveSelector: aSelector] + ifTrue: [self ensureLocalSelectors]. + self deregisterLocalSelector: aSelector. + self noteChangedSelectors: (Array with: aSelector) + + ! Item was changed: ----- Method: Class>>hasTraitComposition (in category 'accessing') ----- hasTraitComposition + ^traitComposition notNil and:[traitComposition isEmpty not]! - ^traitComposition notNil! Item was added: + ----- Method: AdditionalMethodState>>methodHome (in category 'accessing') ----- + methodHome + "The behavior (trait/class) this method was originally defined in. + The methodClass in AdditionalMethodState but subclasses + (TraitMethodState) may know differently" + ^method methodClass! Item was added: + ----- Method: ClassDescription>>fileOutInitializerOn: (in category 'fileIn/Out') ----- + fileOutInitializerOn: aStream + "If the receiver has initialization, file it out. Backstop for subclasses."! Item was added: + ----- Method: Behavior>>basicRemoveSelector: (in category 'adding/removing methods') ----- + basicRemoveSelector: selector + "Assuming that the argument, selector (a Symbol), is a message selector + in my method dictionary, remove it and its method. Returns the old method + if found, nil otherwise." + + | oldMethod | + oldMethod := self methodDict at: selector ifAbsent: [^ nil]. + self methodDict removeKey: selector. + + "Now flush Squeak's method cache, either by selector or by method" + oldMethod flushCache. + selector flushCache. + ^oldMethod! Item was changed: ----- Method: Metaclass>>hasTraitComposition (in category 'accessing') ----- hasTraitComposition + ^traitComposition notNil and:[traitComposition isEmpty not]! - ^traitComposition notNil! Item was added: + ----- Method: ClassDescription class>>allTraitsDo: (in category 'traits') ----- + allTraitsDo: aBlock + "Evaluate aBlock with all the instance and class traits present in the system" + TraitImpl ifNotNil:[TraitImpl allTraitsDo: aBlock].! Item was changed: ----- Method: Metaclass>>definition (in category 'fileIn/Out') ----- definition "Refer to the comment in ClassDescription|definition." + ^ String streamContents:[:strm | + strm print: self. + self traitComposition isEmpty ifFalse:[ + strm crtab; nextPutAll: 'uses: '; nextPutAll: self traitComposition asString. + ]. + strm - ^ String streamContents: - [:strm | - strm print: self; crtab; nextPutAll: 'instanceVariableNames: '; store: self instanceVariablesString]! Item was added: + ----- Method: ClassDescription>>fileOutOn:moveSource:toFile:initializing: (in category 'fileIn/Out') ----- + fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool + "File out the receiver. Backstop for subclasses." + ^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex! Item was added: + ----- Method: ClassDescription>>removeSelector: (in category 'accessing method dictionary') ----- + removeSelector: selector + "Remove the message whose selector is given from the method + dictionary of the receiver, if it is there. Answer nil otherwise." + + | priorMethod priorProtocol | + priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil]. + priorProtocol := self whichCategoryIncludesSelector: selector. + + "-- support for alternative trait implementation --" + (self traitComposition isKindOf: TraitComposition) ifFalse:[ + SystemChangeNotifier uniqueInstance doSilently: [ + self organization removeElement: selector]. + ]. + + super removeSelector: selector. + (self traitComposition isKindOf: TraitComposition) ifTrue:[ + SystemChangeNotifier uniqueInstance doSilently: [self updateOrganizationSelector: selector oldCategory: priorProtocol newCategory: nil]. + ]. + SystemChangeNotifier uniqueInstance + methodRemoved: priorMethod selector: selector inProtocol: priorProtocol class: self.! Item was added: + ----- Method: ClassDescription class>>traitImpl: (in category 'traits') ----- + traitImpl: aTraitClass + "Make the given trait class the default implementor of traits" + TraitImpl := aTraitClass.! Item was changed: ----- Method: Metaclass>>traitComposition (in category 'accessing') ----- traitComposition + "Vector the creation through ClassDescription to support alternative traits" + ^traitComposition ifNil: [traitComposition := ClassDescription newTraitComposition].! - traitComposition ifNil: [traitComposition := TraitComposition new]. - ^traitComposition! Item was added: + ----- Method: ClassDescription class>>newTraitNamed:uses:category: (in category 'traits') ----- + newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString + "Creates a new trait. If no current trait implementation + is installed, raise an error." + ^TraitImpl + ifNil:[self error: 'Traits are not installed'] + ifNotNil:[TraitImpl newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString]! Item was added: + ----- Method: ClassDescription class>>traitImpl (in category 'traits') ----- + traitImpl + "Answer the default implementor of traits" + ^TraitImpl! Item was added: + ----- Method: ClassDescription>>updateOrganizationSelector:oldCategory:newCategory: (in category 'organization updating') ----- + updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil + | currentCategory effectiveCategory sel changedCategories composition | + changedCategories := IdentitySet new. + composition := self hasTraitComposition + ifTrue: [self traitComposition] + ifFalse: [TraitComposition new]. + + "-- support for alternative trait implementation --" + (composition isKindOf: TraitComposition) ifFalse:[^self]. + + (composition methodDescriptionsForSelector: aSymbol) do: [:each | + sel := each selector. + (self includesLocalSelector: sel) ifFalse: [ + currentCategory := self organization categoryOfElement: sel. + effectiveCategory := each effectiveMethodCategoryCurrent: currentCategory new: newCategoryOrNil. + effectiveCategory isNil ifTrue: [ + currentCategory ifNotNil: [changedCategories add: currentCategory]. + self organization removeElement: sel. + ] ifFalse: [ + ((currentCategory isNil or: [currentCategory == ClassOrganizer ambiguous or: [currentCategory == oldCategoryOrNil]]) and: [currentCategory ~~ effectiveCategory]) ifTrue: [ + currentCategory ifNotNil: [changedCategories add: currentCategory]. + self organization + classify: sel + under: effectiveCategory + suppressIfDefault: false]]]]. + ^ changedCategories! Item was added: + ----- Method: CompiledMethod>>methodHome (in category 'accessing') ----- + methodHome + "The behavior (trait/class) this method was originally defined in. + Can be different from methodClass if the method was recompiled." + ^self properties methodHome! Item was added: + ----- Method: ClassDescription class>>newTraitTemplateIn: (in category 'traits') ----- + newTraitTemplateIn: categoryString + ^TraitImpl ifNil:[''] ifNotNil:[TraitImpl newTemplateIn: categoryString].! Item was changed: ----- Method: Class>>traitComposition (in category 'accessing') ----- traitComposition + "Vector the creation through ClassDescription to support alternative traits" + ^traitComposition ifNil: [traitComposition := ClassDescription newTraitComposition].! - traitComposition ifNil: [traitComposition := TraitComposition new]. - ^traitComposition! Item was changed: ----- Method: ClassDescription>>fileOutCategory:on:moveSource:toFile: (in category 'fileIn/Out') ----- fileOutCategory: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex "File a description of the receiver's category, aString, onto aFileStream. If moveSource, is true, then set the method source pointer to the new file position. Note when this method is called with moveSource=true, it is condensing the .sources file, and should only write one preamble per method category." | selectors | aFileStream cr. selectors := (aSymbol asString = ClassOrganizer allCategory) ifTrue: [ self organization allMethodSelectors ] ifFalse: [ self organization listAtCategoryNamed: aSymbol ]. + selectors := selectors select: [:each | (self includesLocalSelector: each)]. - selectors := selectors select: [:each | - (self includesLocalSelector: each) or: [(self methodDict at: each) sendsToSuper]]. "Overridden to preserve author stamps in sources file regardless" selectors do: [:sel | self printMethodChunk: sel withPreamble: true on: aFileStream moveSource: moveSource toFile: fileIndex]. ^ self! Item was added: + ----- Method: ClassDescription class>>newTraitComposition (in category 'traits') ----- + newTraitComposition + "Answer a new trait composition. If no current trait implementation + is installed, return an empty array" + ^TraitImpl ifNil:[#()] ifNotNil:[TraitImpl newTraitComposition].!

1 0

Daily Commit Log
by commits＠source.squeak.org 28 Dec '09

28 Dec '09

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2009-December/002153.h… Name: XML-Parser-nice.22 Ancestors: XML-Parser-nice.21 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002154.h… Name: Balloon-nice.15 Ancestors: Balloon-nice.14 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002155.h… Name: XML-Parser-nice.23 Ancestors: XML-Parser-nice.22 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002156.h… Name: TrueType-nice.12 Ancestors: TrueType-nice.11 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002157.h… Name: Traits-nice.250 Ancestors: Traits-nice.249 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002158.h… Name: Tools-nice.151 Ancestors: Tools-nice.150 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002159.h… Name: VersionNumberTests-nice.3 Ancestors: VersionNumberTests-it.2 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002160.h… Name: ToolBuilder-Morphic-nice.47 Ancestors: ToolBuilder-Morphic-ar.46 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002161.h… Name: Tests-nice.40 Ancestors: Tests-ul.39 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002162.h… Name: System-nice.203 Ancestors: System-nice.202 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002163.h… Name: Sound-nice.12 Ancestors: Sound-nice.11 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002164.h… Name: ShoutCore-nice.7 Ancestors: ShoutCore-nice.6 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002165.h… Name: Services-Base-nice.40 Ancestors: Services-Base-ul.39 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002166.h… Name: ScriptLoader-nice.328 Ancestors: ScriptLoader-nice.327 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002167.h… Name: SUnitGUI-nice.46 Ancestors: SUnitGUI-ul.45 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002168.h… Name: ST80-nice.79 Ancestors: ST80-nice.78 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002169.h… Name: SMLoader-nice.38 Ancestors: SMLoader-gk.37 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002170.h… Name: SMBase-nice.94 Ancestors: SMBase-ul.93 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002171.h… Name: ReleaseBuilder-nice.42 Ancestors: ReleaseBuilder-ul.41 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002172.h… Name: Protocols-nice.15 Ancestors: Protocols-nice.14 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002173.h… Name: PreferenceBrowser-nice.41 Ancestors: PreferenceBrowser-ul.40 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002174.h… Name: PackageInfo-Base-nice.35 Ancestors: PackageInfo-Base-ar.34 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002175.h… Name: NetworkTests-nice.11 Ancestors: NetworkTests-ar.10 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002176.h… Name: Nebraska-nice.23 Ancestors: Nebraska-ar.22 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002177.h… Name: MultilingualTests-nice.5 Ancestors: MultilingualTests-nice.4 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002178.h… Name: Multilingual-nice.78 Ancestors: Multilingual-nice.77 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002179.h… Name: Network-nice.44 Ancestors: Network-ul.43 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002180.h… Name: MorphicExtras-nice.64 Ancestors: MorphicExtras-nice.63 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002181.h… Name: Collections-nice.265 Ancestors: Collections-nice.264 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002182.h… Name: Compiler-nice.111 Ancestors: Compiler-nice.110 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002183.h… Name: Kernel-nice.346 Ancestors: Kernel-nice.345 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002184.h… Name: MonticelloConfigurations-nice.69 Ancestors: MonticelloConfigurations-ul.68 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002185.h… Name: Graphics-nice.95 Ancestors: Graphics-nice.94 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002186.h… Name: Collections-ar.266 Ancestors: Collections-nice.265 Allow implicit coercion to string when using string concatenation, i.e, Transcript cr; show: 'The value is: ', 3. instead of Transcript cr; show: 'The value is: ', 3 printString. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002187.h… Name: MonticelloConfigurations-ar.70 Ancestors: MonticelloConfigurations-nice.69 Faster initial feedback when updating. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002188.h… Name: System-ar.204 Ancestors: System-nice.203 Let users know when update is completed. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002189.h… Name: Files-dtl.62 Ancestors: Files-dtl.61 Add ExpandedSourceFileArray and ExpandedSourceFileArrayTest to support larger sources and changes file sizes, backward compatible with StandardSourceFileArray. Uses new CompiledMethodTrailer to permit large addresses. Move #checkOKToAdd:at: implementation from CompiledMethod to SourceFileArray subclasses. Add SourceFileArray class>>concreteClass to specify default source file array. Set default to ExpandedSourceFileArray. SourceFiles will be an ExpandedSourceFileArray after the next image restart. To change to another SourceFileArray implementation, or to revert to StandardSourceFileArray as default, update the SourceFileArray class>>concreteClass method. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002190.h… Name: Kernel-dtl.347 Ancestors: Kernel-nice.346 CompiledMethod>>checkOKToAdd:at: defers to SourceFiles instance because no end of changes check is needed for ExpandedSourceFileArray. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002191.h… Name: System-dtl.205 Ancestors: System-ar.204 Change #openSourceFiles to open the default kind of SourceFileArray. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002192.h… Name: Morphic-nice.276 Ancestors: Morphic-nice.275 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002193.h… Name: EToys-nice.42 Ancestors: EToys-nice.41 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002194.h… Name: Files-nice.63 Ancestors: Files-dtl.62 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002195.h… Name: FlexibleVocabularies-nice.10 Ancestors: FlexibleVocabularies-nice.9 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002196.h… Name: GraphicsTests-nice.18 Ancestors: GraphicsTests-nice.17 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002197.h… Name: Compression-nice.13 Ancestors: Compression-nice.12 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002198.h… Name: KernelTests-nice.126 Ancestors: KernelTests-nice.125 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002199.h… Name: CollectionsTests-nice.128 Ancestors: CollectionsTests-nice.127 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002200.h… Name: Installer-Core-nice.92 Ancestors: Installer-Core-ul.91 Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002201.h… Name: Monticello-nice.342 Ancestors: Monticello-bf.341 change #findSnapshotWithVersionInfo: to silently ignore a missing ancestor rather than sending #snapshot to nil. This happens for example when merging Pharo/CollectionTests. Don't know if this is the good strategy though (maybe a notification could be signalled) + Cosmetic: move or remove a few temps inside closures ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002202.h… Name: Exceptions-nice.17 Ancestors: Exceptions-ar.16 Cosmetic: move or remove a few temps inside closures =============================================

1 0

Method 'saveAsEmbeddedImage'
by Ang BeePeng 28 Dec '09

28 Dec '09

Hi. I saw a method under class SmalltalkImage, named 'saveAsEmbeddedImage'. How is the method work, and what? And what should be its input? (I go through the code but do not really understand). There's no sender found, so should I debug 'SmalltalkImage current saveAsEmbeddedImage' to learn more about it? About 'snapshotEmbeddedPrimitive', primitive 247? Thanks. Ang Beepeng -- View this message in context: http://n4.nabble.com/Method-saveAsEmbeddedImage-tp979124p979124.html Sent from the Squeak - Dev mailing list archive at Nabble.com.

2 1

The Trunk: Exceptions-nice.17.mcz
by commits＠source.squeak.org 27 Dec '09

27 Dec '09

Nicolas Cellier uploaded a new version of Exceptions to project The Trunk: http://source.squeak.org/trunk/Exceptions-nice.17.mcz ==================== Summary ==================== Name: Exceptions-nice.17 Author: nice Time: 27 December 2009, 9:09:19 am UUID: e82085dd-d10b-4ea4-b0cc-0e49f423dcfa Ancestors: Exceptions-ar.16 Cosmetic: move or remove a few temps inside closures =============== Diff against Exceptions-ar.16 =============== Item was changed: ----- Method: ExceptionTester>>simpleResumeTest (in category 'signaledException tests') ----- simpleResumeTest - "see if we can resume twice" + + [ | it | + self doSomething. - - | it | - [self doSomething. it := MyResumableTestError signal. it = 3 ifTrue: [self doSomethingElse]. it := MyResumableTestError signal. it = 3 ifTrue: [self doSomethingElse]. ] on: MyResumableTestError do: [:ex | self doYetAnotherThing. ex resume: 3]! Item was changed: ----- Method: ProgressInitiationException>>defaultMVCAction (in category 'as yet unclassified') ----- defaultMVCAction + | delta savedArea captionText textFrame barFrame outerFrame result range lastW | - | delta savedArea captionText textFrame barFrame outerFrame result range lastW w | barFrame := aPoint - (75@10) corner: aPoint + (75@10). captionText := DisplayText text: progressTitle asText allBold. captionText foregroundColor: Color black backgroundColor: Color white. textFrame := captionText boundingBox insetBy: -4. textFrame := textFrame align: textFrame bottomCenter with: barFrame topCenter + (0@2). outerFrame := barFrame merge: textFrame. delta := outerFrame amountToTranslateWithin: Display boundingBox. barFrame := barFrame translateBy: delta. textFrame := textFrame translateBy: delta. outerFrame := outerFrame translateBy: delta. savedArea := Form fromDisplay: outerFrame. Display fillBlack: barFrame; fillWhite: (barFrame insetBy: 2). Display fillBlack: textFrame; fillWhite: (textFrame insetBy: 2). captionText displayOn: Display at: textFrame topLeft + (4@4). range := maxVal = minVal ifTrue: [1] ifFalse: [maxVal - minVal]. "Avoid div by 0" lastW := 0. [result := workBlock value: "Supply the bar-update block for evaluation in the work block" [:barVal | + | w | w := ((barFrame width-4) asFloat * ((barVal-minVal) asFloat / range min: 1.0)) asInteger. w ~= lastW ifTrue: [ Display fillGray: (barFrame topLeft + (2@2) extent: w@16). lastW := w]]] ensure: [savedArea displayOn: Display at: outerFrame topLeft]. self resume: result!

1 0

The Trunk: Monticello-nice.342.mcz
by commits＠source.squeak.org 27 Dec '09

27 Dec '09

Nicolas Cellier uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-nice.342.mcz ==================== Summary ==================== Name: Monticello-nice.342 Author: nice Time: 27 December 2009, 9:03:54 am UUID: ead29222-29d3-421a-8d89-08d667014c1c Ancestors: Monticello-bf.341 change #findSnapshotWithVersionInfo: to silently ignore a missing ancestor rather than sending #snapshot to nil. This happens for example when merging Pharo/CollectionTests. Don't know if this is the good strategy though (maybe a notification could be signalled) + Cosmetic: move or remove a few temps inside closures =============== Diff against Monticello-bf.341 =============== Item was changed: ----- Method: MCFtpRepository>>readStreamForFileNamed:do: (in category 'required') ----- readStreamForFileNamed: aString do: aBlock + - | stream | ^ self clientDo: + [:client | | stream | - [:client | client binary. stream := RWBinaryOrTextStream on: String new. stream nextPutAll: (client getFileNamed: aString). aBlock value: stream reset]! Item was changed: ----- Method: MCVersion>>allDependenciesNotIn:do:ifUnresolved: (in category 'enumerating') ----- allDependenciesNotIn: aDictionary do: aBlock ifUnresolved: failBlock + - | version | self dependencies do: + [:ea | | version | - [:ea | version := aDictionary at: ea ifAbsent: [ea resolve]. version ifNil: [failBlock value: ea] ifNotNil: [(aDictionary includes: version) ifFalse: [aDictionary at: ea put: version. version allDependenciesNotIn: aDictionary do: aBlock ifUnresolved: failBlock. aBlock value: version]]]! Item was changed: ----- Method: MCSnapshotBrowserTest>>assertAListMatches: (in category 'asserting') ----- assertAListMatches: strings + | listMorphs | - | listMorphs list | listMorphs := self listMorphs. listMorphs + detect: [:m | | list | + list := m getList. (list size = strings size) and: [list includesAllOf: strings]] - detect: [:m | list := m getList. (list size = strings size) and: [list includesAllOf: strings]] ifNone: [self assert: false].! Item was changed: ----- Method: MCVersion>>allAvailableDependenciesDo: (in category 'enumerating') ----- allAvailableDependenciesDo: aBlock + - | version | self dependencies do: [:ea | + [ | version | + version := ea resolve. - [version := ea resolve. version allAvailableDependenciesDo: aBlock. aBlock value: version] on: Error do: []]! Item was changed: ----- Method: MCFileBasedRepository>>versionWithInfo:ifAbsent: (in category 'as yet unclassified') ----- versionWithInfo: aVersionInfo ifAbsent: errorBlock + - | version | (self allFileNamesForVersionNamed: aVersionInfo name) do: + [:fileName | | version | - [:fileName | version := self versionFromFileNamed: fileName. version info = aVersionInfo ifTrue: [^ version]]. ^ errorBlock value! Item was changed: ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'as yet unclassified') ----- testKindOfSubclass + | classes | - | classes d | classes := {self mockClassA. String. MethodContext. WeakArray. Float}. + classes do: [:c | | d | - classes do: [:c | d := c asClassDefinition. self assert: d kindOfSubclass = c kindOfSubclass. ].! Item was changed: ----- Method: MCToolWindowBuilder>>buttonRow: (in category 'as yet unclassified') ----- buttonRow: specArray + | panel | - | panel button | panel := builder pluggablePanelSpec new. panel children: OrderedCollection new. specArray do: + [:spec | | button | - [:spec | button := builder pluggableButtonSpec new. button model: tool. button label: spec first asString. button action: spec second. button help: spec third. button enabled: (spec at: 4 ifAbsent: [#buttonEnabled]). button state: (spec at: 5 ifAbsent: [#buttonSelected]). panel children add: button]. panel layout: #horizontal. panel frame: currentFrame. window children add: panel! Item was changed: ----- Method: MCWorkingCopyTest>>testSelectiveBackport (in category 'tests') ----- testSelectiveBackport + | inst base intermediate final | - | inst base intermediate final patch selected | inst := self mockInstanceA. base := self snapshot. self assert: inst one = 1. self change: #one toReturn: 2. intermediate := self snapshot. self change: #two toReturn: 3. final := self snapshot. [workingCopy backportChangesTo: base info] on: MCChangeSelectionRequest + do: [:e | | selected patch | - do: [:e | patch := e patch. selected := patch operations select: [:ea | ea definition selector = #two]. e resume: (MCPatch operations: selected)]. self assert: inst one = 1. self assert: inst two = 3. self assert: workingCopy ancestry ancestors size = 1. self assert: workingCopy ancestry ancestors first = base info. self assert: workingCopy ancestry stepChildren size = 1. self assert: workingCopy ancestry stepChildren first = final info! Item was changed: ----- Method: MCMethodDefinition>>scanForPreviousVersion (in category 'installing') ----- scanForPreviousVersion + | sourceFilesCopy method position | - | position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp method file methodCategory | method := self actualClass compiledMethodAt: selector ifAbsent: [^ nil]. position := method filePosition. sourceFilesCopy := SourceFiles collect: [:x | x isNil ifTrue: [ nil ] ifFalse: [x readOnlyCopy]]. + [ | file prevPos tokens preamble methodCategory stamp prevFileIndex | + method fileIndex == 0 ifTrue: [^ nil]. - [method fileIndex == 0 ifTrue: [^ nil]. file := sourceFilesCopy at: method fileIndex. [position notNil & file notNil] whileTrue: [file position: (0 max: position-150). "Skip back to before the preamble" [file position < (position-1)] "then pick it up from the front" whileTrue: [preamble := file nextChunk]. "Preamble is likely a linked method preamble, if we're in a changes file (not the sources file). Try to parse it for prior source position and file index" prevPos := nil. stamp := ''. (preamble findString: 'methodsFor:' startingAt: 1) > 0 ifTrue: [tokens := Scanner new scanTokens: preamble] ifFalse: [tokens := Array new "ie cant be back ref"]. ((tokens size between: 7 and: 8) and: [(tokens at: tokens size-5) = #methodsFor:]) ifTrue: [(tokens at: tokens size-3) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp := tokens at: tokens size-2. prevPos := tokens last. prevFileIndex := sourceFilesCopy fileIndexFromSourcePointer: prevPos. prevPos := sourceFilesCopy filePositionFromSourcePointer: prevPos] ifFalse: ["Old format gives no stamp; prior pointer in two parts" prevPos := tokens at: tokens size-2. prevFileIndex := tokens last]. (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos := nil]]. ((tokens size between: 5 and: 6) and: [(tokens at: tokens size-3) = #methodsFor:]) ifTrue: [(tokens at: tokens size-1) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp := tokens at: tokens size]]. methodCategory := tokens after: #methodsFor: ifAbsent: ['as yet unclassifed']. methodCategory = category ifFalse: [methodCategory = (Smalltalk at: #Categorizer ifAbsent: [Smalltalk at: #ClassOrganizer]) default ifTrue: [methodCategory := methodCategory, ' ']. ^ ChangeRecord new file: file position: position type: #method class: className category: methodCategory meta: classIsMeta stamp: stamp]. position := prevPos. prevPos notNil ifTrue: [file := sourceFilesCopy at: prevFileIndex]]. ^ nil] ensure: [sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]] ! Item was changed: ----- Method: MCFileRepositoryInspector>>refresh (in category 'as yet unclassified') ----- refresh + | packageNames | - | packageNames name latest av | packageNames := Set new. packageList := nil. + versions := repository readableFileNames collect: [ :each | | name | - versions := repository readableFileNames collect: [ :each | name := (each copyUpToLast: $.) copyUpTo: $(. name last isDigit ifFalse: [Array with: name with: '' with: '' with: each] ifTrue: [Array with: (packageNames add: (name copyUpToLast: $-)) "pkg name" with: ((name copyAfterLast: $-) copyUpTo: $.) "user" with: ((name copyAfterLast: $-) copyAfter: $.) asInteger "version" with: each]]. versions := versions select: [:each | (each at: 3) isNumber]. newer := Set new. inherited := Set new. loaded := Set new. (MCWorkingCopy allManagers " select: [ :each | packageNames includes: each packageName]") + do: [:each | | latest | - do: [:each | each ancestors do: [ :ancestor | loaded add: ancestor name. ancestor ancestorsDoWhileTrue: [:heir | (inherited includes: heir name) ifTrue: [false] ifFalse: [inherited add: heir name. true]]]. latest := (versions select: [:v | v first = each package name]) detectMax: [:v | v third]. (latest notNil and: [ + each ancestors allSatisfy: [:ancestor | | av | - each ancestors allSatisfy: [:ancestor | av := ((ancestor name copyAfterLast: $-) copyAfter: $.) asInteger. av < latest third or: [ av = latest third and: [((ancestor name copyAfterLast: $-) copyUpTo: $.) ~= latest second]]]]) ifTrue: [newer add: each package name ]]. self changed: #packageList; changed: #versionList! Item was changed: + ----- Method: MCClassTraitDefinition class>>baseTraitName:classTraitComposition: (in category 'instance creation') ----- - ----- Method: MCClassTraitDefinition class>>baseTraitName:classTraitComposition: (in category 'as yet unclassified') ----- baseTraitName: aString classTraitComposition: classTraitCompositionString ^self instanceLike: ( self new initializeWithBaseTraitName: aString classTraitComposition: classTraitCompositionString).! Item was changed: ----- Method: MCSubDirectoryRepository>>findFullNameForWriting: (in category 'as yet unclassified') ----- findFullNameForWriting: aBaseName + | possible split prefix fpattern now | - | possible split dirScore fileScore prefix fpattern parts now | split := directory splitNameVersionExtensionFor: aBaseName. fpattern := split first, '*'. possible := SortedCollection sortBlock: [ :a :b | a first = b first ifTrue: [ a second = b second ifFalse: [ a second < b second ] ifTrue: [ a third fullName size < b third fullName size ]] ifFalse: [ a first > b first ] ]. now := Time totalSeconds. prefix := directory pathParts size. + self allDirectories do: [:dir | | parts dirScore fileScore | - self allDirectories do: [:dir | parts := dir pathParts allButFirst: prefix. dirScore := (parts select: [ :part | fpattern match: part ]) size. fileScore := (dir entries collect: [ :ent | (ent isDirectory not and: [ fpattern match: ent name ]) ifFalse: [ SmallInteger maxVal ] ifTrue: [ now - ent modificationTime ]]). "minimum age" fileScore := fileScore isEmpty ifTrue: [ SmallInteger maxVal ] ifFalse: [ fileScore min ]. possible add: { dirScore. fileScore. dir } ]. ^ (possible first third) fullNameFor: aBaseName! Item was changed: ----- Method: MCWorkingCopy>>findSnapshotWithVersionInfo: (in category 'private') ----- findSnapshotWithVersionInfo: aVersionInfo ^ aVersionInfo ifNil: [MCSnapshot empty] + ifNotNil: [(self repositoryGroup versionWithInfo: aVersionInfo) + ifNil: [MCSnapshot empty] + ifNotNil: [:aVersion | aVersion snapshot]]! - ifNotNil: [(self repositoryGroup versionWithInfo: aVersionInfo) snapshot]! Item was changed: ----- Method: MCVersionMerger>>addVersion: (in category 'as yet unclassified') ----- addVersion: aVersion + - | dep | records add: (MCMergeRecord version: aVersion). aVersion dependencies do: + [:ea | | dep | - [:ea | dep := ea resolve. (records anySatisfy: [:r | r version = dep]) ifFalse: [self addVersion: dep]]! Item was changed: ----- Method: MCHttpRepository>>userAndPasswordFromSettingsDo: (in category 'as yet unclassified') ----- userAndPasswordFromSettingsDo: aBlock "The mcSettings file in ExternalSettings preferenceDirectory should contain entries for each account: account1: *myhost.mydomain* user:password account2: *otherhost.mydomain/somerep* dXNlcjpwYXNzd29yZA== That is it must start with 'account', followed by anything to distinguish accounts, and a colon. Then comes a match expression for the repository url, and after a space the user:password string. To not have the clear text password on your disc, you can base64 encode it: (Base64MimeConverter mimeEncode: 'user:password' readStream) contents " + - | entry userAndPassword | Settings ifNotNil: [ + Settings keysAndValuesDo: [:key :value | | userAndPassword entry | - Settings keysAndValuesDo: [:key :value | (key asLowercase beginsWith: 'account') ifTrue: [ entry := value findTokens: ' '. (entry first match: location) ifTrue: [ userAndPassword := entry second. (userAndPassword includes: $:) ifFalse: [ userAndPassword := (Base64MimeConverter mimeDecodeToChars: userAndPassword readStream) contents]. userAndPassword := userAndPassword findTokens: $:. ^aBlock value: userAndPassword first value: userAndPassword second ] ] ] ]. ^nil! Item was changed: ----- Method: MCAncestry>>topologicalAncestors (in category 'ancestry') ----- topologicalAncestors + - | frontier f | ^ Array streamContents: + [:s | | frontier f | - [:s | frontier := MCFrontier frontierOn: self. [f := frontier frontier. s nextPutAll: f. frontier removeAll: f. f isEmpty] whileFalse] ! Item was changed: ----- Method: MCTool>>buttonRow: (in category 'morphic ui') ----- buttonRow: specArray + | aRow | - | aRow aButton state | aRow := AlignmentMorph newRow. aRow color: (Display depth <= 8 ifTrue: [Color transparent] ifFalse: [Color gray alpha: 0.2]); borderWidth: 0. aRow hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true. aRow clipSubmorphs: true. aRow layoutInset:2@2; cellInset: 1; color: Color white. aRow wrapCentering: #center; cellPositioning: #leftCenter. specArray do: + [:triplet | | aButton state | - [:triplet | state := triplet at: 4 ifAbsent: [#buttonState]. aButton := PluggableButtonMorph on: self getState: state action: #performButtonAction:enabled:. aButton hResizing: #spaceFill; vResizing: #spaceFill; label: triplet first asString; arguments: (Array with: triplet second with: state); onColor: Color white offColor: Color white. aRow addMorphBack: aButton. aButton setBalloonText: triplet third]. ^ aRow!

1 0

The Trunk: Installer-Core-nice.92.mcz
by commits＠source.squeak.org 27 Dec '09

27 Dec '09

Nicolas Cellier uploaded a new version of Installer-Core to project The Trunk: http://source.squeak.org/trunk/Installer-Core-nice.92.mcz ==================== Summary ==================== Name: Installer-Core-nice.92 Author: nice Time: 27 December 2009, 8:54:47 am UUID: 8b0c6ca0-63ee-4725-825e-bc3a82a14784 Ancestors: Installer-Core-ul.91 Cosmetic: move or remove a few temps inside closures =============== Diff against Installer-Core-ul.91 =============== Item was changed: ----- Method: Installer>>newChangeSetFromStream:named: (in category 'mantis') ----- newChangeSetFromStream: aStream named: aName "This code is based upon ChangeSet-c-#newChangesFromStream:named: which is in 3.9, implemented here for previous versions. The second branch is for 3.8, where ChangeSets are loaded by ChangeSorter. " + | oldChanges newName newSet | - | oldChanges newName newSet newStream | (self classChangeSet respondsTo: #newChangesFromStream:named:) ifTrue: [ ^self classChangeSet newChangesFromStream: aStream named:aName ]. (self classChangeSorter respondsTo: #newChangesFromStream:named:) ifTrue: [ ^self classChangeSorter newChangesFromStream: aStream named: aName ]. oldChanges := ChangeSet current. "so a Bumper update can find it" newName := aName sansPeriodSuffix. newSet := self classChangeSet basicNewNamed: newName. + [ | newStream | + newSet - [newSet ifNotNil: [(aStream respondsTo: #converter:) ifTrue: [newStream := aStream] ifFalse: [newStream := self classMultiByteBinaryOrTextStream with: aStream contentsOfEntireFile. newStream reset]. self classChangeSet newChanges: newSet. newStream setConverterForCode. newStream fileInAnnouncing: 'Loading ' , newName , '...'. Transcript cr; show: 'File ' , aName , ' successfully filed in to change set ' , newName]. aStream close] ensure: [self classChangeSet newChanges: oldChanges]. ^ newSet!

1 0

The Trunk: CollectionsTests-nice.128.mcz
by commits＠source.squeak.org 27 Dec '09

27 Dec '09

Nicolas Cellier uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-nice.128.mcz ==================== Summary ==================== Name: CollectionsTests-nice.128 Author: nice Time: 27 December 2009, 8:53:04 am UUID: 4e5cafc2-cfe9-4d20-93e9-92ed055e9387 Ancestors: CollectionsTests-nice.127 Cosmetic: move or remove a few temps inside closures =============== Diff against CollectionsTests-nice.127 =============== Item was changed: ----- Method: IntegerArrayTest>>testStoreNegativeOutOfRange (in category 'tests') ----- testStoreNegativeOutOfRange "A value too small for a 32-bit signed integer should raise an error." + | ia val | - | ia val storedValue | ia := IntegerArray new: 1. val := (2 raisedTo: 31) negated - 1. " -16r80000001 of range for 32-bit twos complement integer" + self should: [ | storedValue | + ia at: 1 put: val. "should raise error here" - self should: [ia at: 1 put: val. "should raise error here" storedValue := ia at: 1. "lack of range check leads to value of 16r7FFFFFFF" self assert: val = storedValue "fail here"] raise: Error ! Item was changed: ----- Method: IntegerArrayTest>>testStorePositiveOutOfRange (in category 'tests') ----- testStorePositiveOutOfRange "A value too large for a 32-bit signed integer should raise an error." + | ia val | - | ia val storedValue | ia := IntegerArray new: 1. val := 2 raisedTo: 31. "16r80000000 is out of range for 32-bit twos complement" + self should: [ | storedValue | + ia at: 1 put: val. "should raise error here" - self should: [ia at: 1 put: val. "should raise error here" storedValue := ia at: 1. "lack of range check leads to value of 16r-80000000" self assert: val = storedValue "fail here"] raise: Error ! Item was changed: ----- Method: CollectionTest>>testPrintOnDelimiterLast (in category 'testing') ----- testPrintOnDelimiterLast + | delim last | - | delim emptyStream last oneItemStream multiItemStream | delim := ', '. last := ' & '. {OrderedCollection new. Set new.} do: + [ :coll | | emptyStream oneItemStream multiItemStream | - [ :coll | emptyStream := ReadWriteStream on: ''. coll printOn: emptyStream delimiter: delim last: last. self assert: emptyStream contents = ''. coll add: 1. oneItemStream := ReadWriteStream on: ''. coll printOn: oneItemStream delimiter: delim last: last. self assert: oneItemStream contents = '1'. coll add: 2; add: 3. multiItemStream := ReadWriteStream on: ''. coll printOn: multiItemStream delimiter: ', ' last: last. self assert: multiItemStream contents = '1'', ''2'' & ''3'.]! Item was changed: ----- Method: CollectionTest>>testAsStringOnDelimiter (in category 'testing') ----- testAsStringOnDelimiter + | delim | - | delim emptyStream oneItemStream multiItemStream | delim := ', '. {OrderedCollection new. Set new.} do: + [ :coll | | oneItemStream emptyStream multiItemStream | - [ :coll | emptyStream := ReadWriteStream on: ''. coll asStringOn: emptyStream delimiter: delim. self assert: emptyStream contents = ''. coll add: 1. oneItemStream := ReadWriteStream on: ''. coll asStringOn: oneItemStream delimiter: delim. self assert: oneItemStream contents = '1'. coll add: 2; add: 3. multiItemStream := ReadWriteStream on: ''. coll asStringOn: multiItemStream delimiter: ', '. self assert: multiItemStream contents = '1, 2, 3'.]! Item was changed: ----- Method: CollectionTest>>testAsStringOnDelimiterLast (in category 'testing') ----- testAsStringOnDelimiterLast + | delim last | - | delim emptyStream last oneItemStream multiItemStream | delim := ', '. last := ' & '. {OrderedCollection new. Set new.} do: + [ :coll | | multiItemStream emptyStream oneItemStream | - [ :coll | emptyStream := ReadWriteStream on: ''. coll asStringOn: emptyStream delimiter: delim last: last. self assert: emptyStream contents = ''. coll add: 1. oneItemStream := ReadWriteStream on: ''. coll asStringOn: oneItemStream delimiter: delim last: last. self assert: oneItemStream contents = '1'. coll add: 2; add: 3. multiItemStream := ReadWriteStream on: ''. coll asStringOn: multiItemStream delimiter: ', ' last: last. self assert: multiItemStream contents = '1, 2 & 3'.]! Item was changed: ----- Method: HeapTest>>test1 (in category 'testing') ----- test1 + | data | - | data h | "The first element of each array is the sort value, and the second will be updated by the heap with the index of the element within the heap." data := (1 to: 8) collect: [:i | {i*2. 0}]. "Repeat with different data ordering." + 5 timesRepeat: [ | h | - 5 timesRepeat: [ h := Heap new sortBlock: [:e1 :e2 | e1 first < e2 first]. h indexUpdateBlock: [:array :index | array at: 2 put: index]. data shuffled do: [:d | h add: d]. data do: [:d | self should: (h at: d second) == d]. ]! Item was changed: ----- Method: CollectionTest>>testPrintOnDelimiter (in category 'testing') ----- testPrintOnDelimiter + | delim | - | delim emptyStream oneItemStream multiItemStream | delim := ', '. {OrderedCollection new. Set new.} do: + [ :coll | | emptyStream oneItemStream multiItemStream | - [ :coll | emptyStream := ReadWriteStream on: ''. coll printOn: emptyStream delimiter: delim. self assert: emptyStream contents = ''. coll add: 1. oneItemStream := ReadWriteStream on: ''. coll printOn: oneItemStream delimiter: delim. self assert: oneItemStream contents = '1'. coll add: 2; add: 3. multiItemStream := ReadWriteStream on: ''. coll printOn: multiItemStream delimiter: ', '. self assert: multiItemStream contents = '1'', ''2'', ''3'.]!

1 0

The Trunk: KernelTests-nice.126.mcz
by commits＠source.squeak.org 27 Dec '09

27 Dec '09

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.126.mcz ==================== Summary ==================== Name: KernelTests-nice.126 Author: nice Time: 27 December 2009, 8:50:28 am UUID: 83798bee-e21e-4aaf-ae60-1bcf2c7a4f9a Ancestors: KernelTests-nice.125 Cosmetic: move or remove a few temps inside closures =============== Diff against KernelTests-nice.125 =============== Item was changed: ----- Method: IntegerTest>>testBitAt (in category 'tests - bitLogic') ----- testBitAt + | trials bitSequence2 | - | trials aNumber bitSequence2 bitInvert | self assert: ((1 to: 100) allSatisfy: [:i | (0 bitAt: i) = 0]) description: 'all bits of zero are set to zero'. self assert: ((1 to: 100) allSatisfy: [:i | (-1 bitAt: i) = 1]) description: 'In two complements, all bits of -1 are set to 1'. trials := #( '2r10010011' '2r11100100' '2r10000000' '2r0000101011011001' '2r1000101011011001' '2r0101010101011000' '2r0010011110110010' '2r0010011000000000' '2r00100111101100101000101011011001' '2r01110010011110110010100110101101' '2r10101011101011001010000010110110' '2r10101000000000000000000000000000' '2r0010101110101001110010100000101101100010011110110010100010101100' '2r1010101110101100101000001011011000100111101100101000101011011001' '2r1010101110101000000000000000000000000000000000000000000000000000'). + trials do: [:bitSequence | | aNumber | - trials do: [:bitSequence | aNumber := Number readFrom: bitSequence. bitSequence2 := (bitSequence size - 2 to: 1 by: -1) inject: '2r' into: [:string :i | string copyWith: (Character digitValue: (aNumber bitAt: i))]. self assert: bitSequence2 = bitSequence]. + trials do: [:bitSequence | | bitInvert | - trials do: [:bitSequence | bitInvert := -1 - (Number readFrom: bitSequence). bitSequence2 := (bitSequence size - 2 to: 1 by: -1) inject: '2r' into: [:string :i | string copyWith: (Character digitValue: 1 - (bitInvert bitAt: i))]. self assert: bitSequence2 = bitSequence description: '-1-x is similar to a bitInvert operation in two complement']! Item was changed: ----- Method: InstVarRefLocatorTest>>testInstructions (in category 'tests') ----- testInstructions + - | scanner end printer | + Object methodDict do: [:method | | scanner printer end | - Object methodDict do: [:method | scanner := InstructionStream on: method. printer := InstVarRefLocator new. end := scanner method endPC. [scanner pc <= end] whileTrue: [ self shouldnt: [printer interpretNextInstructionUsing: scanner] raise: Error. ]. ].! Item was changed: ----- Method: InstructionClientTest>>testInstructions (in category 'tests') ----- testInstructions "just interpret all of methods of Object" + | client | - | client scanner | client := InstructionClient new. Object methodDict do: [:method | + | scanner | scanner := (InstructionStream on: method). [scanner pc <= method endPC] whileTrue: [ self shouldnt: [scanner interpretNextInstructionFor: client] raise: Error. ]. ]. !

1 0

← Newer
1
...
7
8
9
10
11
12
13
...
56
Older →

Jump to page: