December 2010 - Pharo-dev - lists.pharo.org

Re: [Pharo-project] New SqueakSource (was good news of the year)

by Janko MivÅ¡ek

It would be nice to take an oportunity and think long-term about Smalltalk-wide hub but for now implement a MC one for Squeak/Pharo for a start. Later we can nad other repositories like VW Store, even SqueakMap, etc., with a long-term goal to have all Smalltalk code accessible from one place. Geert will love a proposed link: http://source.world.st :) or maybe: http://code.world.st ? And name: SmalltalkHub, SmalltalkSource? Having Smalltalk in the name is good from SEO standpoint, much better than MonticelloHub, for guys outside Smalltalk community to recognise soon what it is about. Best regards Janko On 14. 12. 2010 10:03, Geert Claes wrote: > StÃ©phane Ducasse wrote: >> >> For SqueakSource, ESUG is paying the iliad guys to show that their >> technology is cool and they will rewrite from scratch. We are negociating >> since a couple of months with inria to have a web-dav server so that we >> can host all the monticello related host. > More great news then! Since its a complete re-write and assuming it will > serve for both Squeak and Pharo projects alike, I am wondering if its just > me but I reckon it could do with a nice new name too :) If so it probably > deserves a separate thread -- Janko MivÅ¡ek AIDA/Web Smalltalk Web Application Server http://www.aidaweb.si

Dec. 14, 2010

[Pharo-project] Issue 3430 in pharo: SystemProgressMorph possible enh

by pharo＠googlecode.com

Status: FixedWaitingToBePharoed Owner: stephane.ducasse Labels: Milestone-1.3 New issue 3430 by stephane.ducasse: SystemProgressMorph possible enh http://code.google.com/p/pharo/issues/detail?id=3430 Alexander Lazarević uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-laza.488.mcz ==================== Summary ==================== Name: Morphic-laza.488 Author: laza Time: 8 December 2010, 1:24:52.251 pm UUID: 51a452ef-b931-4d4a-9d66-b8bc829fad99 Ancestors: Morphic-laza.487 Try to prevent empty progress morphs after updates when SystemProgressMorph reset is used in a Postscript =============== Diff against Morphic-mha.486 =============== Item was changed: ----- Method: SystemProgressMorph class>>close: (in category 'instance creation') ----- close: aBlock + | slot | + slot := aBlock value: SmallInteger maxVal. "This should prevent a redraw" + aBlock receiver freeSlot: slot. + + ! - UniqueInstance ifNotNil: [UniqueInstance close: aBlock]! Item was removed: - ----- Method: SystemProgressMorph>>close: (in category 'initialization') ----- - close: aBlock - | slot | - slot := aBlock value: SmallInteger maxVal. "This should prevent a redraw" - self freeSlot: slot - - ! Item was changed: ----- Method: SystemProgressMorph>>freeSlot: (in category 'private') ----- freeSlot: number + number > 0 ifFalse: [^self]. + lock critical: [| label | + label := labels at: number. + (label isNil or: [label owner isNil]) ifTrue: [^self]. "Has been freed before" + label delete. + (bars at: number) delete. + activeSlots := activeSlots - 1. + activeSlots = 0 + ifTrue: [self delete] + ifFalse: [self recenter]]! - number > 0 ifTrue: [ - lock critical: [ - (bars at: number) delete. - (labels at: number) delete. - activeSlots := activeSlots - 1. - activeSlots = 0 - ifTrue: [self delete] - ifFalse: [self recenter]]]! Item was changed: (PackageInfo named: 'Morphic') postscript: '(Preferences dictionaryOfPreferences at: #alternativeWindowBoxesLook) defaultValue: false. + "Force SystemProgressMorph to be reset" SystemProgressMorph initialize; reset. TextEditor initialize. SmalltalkEditor initialize. TheWorldMainDockingBar updateInstances'!

Dec. 14, 2010

[Pharo-project] Issue 3429 in pharo: Better Number performance

by pharo＠googlecode.com

Status: FixedWaitingToBePharoed Owner: stephane.ducasse Labels: Milestone-1.3 New issue 3429 by stephane.ducasse: Better Number performance http://code.google.com/p/pharo/issues/detail?id=3429 Name: Kernel-ul.522 Author: ul Time: 8 December 2010, 4:08:19.384 am UUID: 6927b03c-21df-1746-9a0d-115b717a5e40 Ancestors: Kernel-ul.521 - implemented Fraction >> #negative and ScaledDecimal >> #negative for better performance. These methods don't allocate new objects. - reimplemented SmallInteger printing methods (printOn:base:*) without String allocation. They are as fast as the previous versions were for base 10. - reimplemented ScaledDecimal printing. It avoids object allocations and has better performance than the previous version. ScaledDecimals can also be printed without the scale part by using #printFractionAsDecimalOn:. =============== Diff against Kernel-ul.521 =============== Item was added: + ----- Method: Fraction>>negative (in category 'testing') ----- + negative + + ^numerator negative! Item was added: + ----- Method: ScaledDecimal>>negative (in category 'testing') ----- + negative + + ^fraction negative! Item was added: + ----- Method: ScaledDecimal>>printFractionAsDecimalOn: (in category 'printing') ----- + printFractionAsDecimalOn: stream + + | aFraction integerPart fractionPart | + fraction negative + ifFalse: [ aFraction := fraction ] + ifTrue: [ + aFraction := fraction negated. + stream nextPut: $- ]. + integerPart := aFraction truncated. + integerPart printOn: stream. + scale = 0 ifTrue: [ ^self ]. + stream nextPut: $.. + fractionPart := ((aFraction - integerPart) * (10 raisedToInteger: scale)) truncated. + fractionPart + printOn: stream + base: 10 + length: scale + padded: true! Item was changed: ----- Method: ScaledDecimal>>printOn: (in category 'printing') ----- + printOn: stream + + self + printFractionAsDecimalOn: stream; + printScaleOn: stream! - printOn: aStream - "Reimplementation - Object 'printing' method." - | aFraction tmpFractionPart | - self < 0 ifTrue: [aStream nextPut: $-]. - aFraction := fraction abs. - aStream nextPutAll: aFraction truncated printString. - scale = 0 ifTrue: [^ aStream nextPutAll: 's0']. - aStream nextPut: $.. - tmpFractionPart := aFraction fractionPart. - 1 to: scale - do: - [:dummy | - tmpFractionPart := tmpFractionPart * 10. - aStream nextPut: (Character digitValue: tmpFractionPart truncated). - tmpFractionPart := tmpFractionPart fractionPart]. - aStream nextPut: $s. - scale printOn: aStream! Item was added: + ----- Method: ScaledDecimal>>printScaleOn: (in category 'printing') ----- + printScaleOn: stream + + stream nextPut: $s. + scale printOn: stream! Item was changed: ----- Method: SmallInteger>>printOn:base: (in category 'printing') ----- + printOn: stream base: base - printOn: aStream base: b "Append a representation of this number in base b on aStream." + self printOn: stream base: base length: 0 padded: false! - self < 0 - ifTrue: [aStream nextPut: $-. - aStream nextPutAll: (self negated printStringBase: b). - ^self]. - - "allocating a String seems faster than streaming for SmallInteger" - aStream nextPutAll: (self printStringBase: b)! Item was added: + ----- Method: SmallInteger>>printOn:base:length:padded: (in category 'printing') ----- + printOn: stream base: base length: minimumLength padded: padWithZeroes + + | n numberOfDigits totalLength divisor | + self < 0 + ifTrue: [ + n := self negated. + totalLength := 1 ] + ifFalse: [ + n := self. + totalLength := 0 ]. + numberOfDigits := n numberOfDigitsInBase: base. + totalLength := totalLength + numberOfDigits. + padWithZeroes ifFalse: [ + [ totalLength < minimumLength ] whileTrue: [ + stream space. + totalLength := totalLength + 1 ] ]. + n = self ifFalse: [ stream nextPut: $- ]. + padWithZeroes ifTrue: [ + [ totalLength < minimumLength ] whileTrue: [ + stream nextPut: $0. + totalLength := totalLength + 1 ] ]. + divisor := (base raisedToInteger: numberOfDigits - 1). + [ divisor > 0 ] whileTrue: [ + | digit | + digit := n // divisor. + stream nextPut: ('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' at: digit + 1). + n := n - (digit * divisor). + divisor := divisor // base ]! Item was changed: ----- Method: SmallInteger>>printOn:base:nDigits: (in category 'printing') ----- printOn: aStream base: b nDigits: n "Append a representation of this number in base b on aStream using nDigits. self must be positive." + self printOn: aStream base: b length: n padded: true! - "allocating a String seems faster than streaming for SmallInteger" - aStream nextPutAll: (self printStringBase: b nDigits: n)!

Dec. 14, 2010

[Pharo-project] Issue 3428 in pharo: Semaphore Enh

by pharo＠googlecode.com

Status: FixedWaitingToBePharoed Owner: stephane.ducasse CC: siguctua Labels: Milestone-1.3 New issue 3428 by stephane.ducasse: Semaphore Enh http://code.google.com/p/pharo/issues/detail?id=3428 Name: Kernel-ul.520 Author: ul Time: 8 December 2010, 3:19:51.682 am UUID: da185163-27f6-6a47-8ecb-e00f9fd8dd3a Ancestors: Kernel-ul.519 A few changes to Semaphore: - save a block creation + activation + a possible context switch in #critical:ifCurtailed: - save a block creation + activation in #critical:ifError:, this changes the behavior when mutuallyExcludedBlock doesn't understand #ifError: - #critical:ifLocked: is guaranteed to not get locked. The earlier implementation sent #critical: which could cause a context switch, so another process could enter the critical section before the current. Also fixed the comments of this method. =============== Diff against Kernel-ul.519 =============== Item was changed: ----- Method: Semaphore>>critical:ifCurtailed: (in category 'mutual exclusion') ----- critical: mutuallyExcludedBlock ifCurtailed: terminationBlock "Evaluate mutuallyExcludedBlock only if the receiver is not currently in the process of running the critical: message. If the receiver is, evaluate mutuallyExcludedBlock after the other critical: message is finished." + ^self critical: [ mutuallyExcludedBlock ifCurtailed: terminationBlock ] - ^self critical:[[mutuallyExcludedBlock value] ifCurtailed: terminationBlock] ! Item was changed: ----- Method: Semaphore>>critical:ifError: (in category 'mutual exclusion') ----- critical: mutuallyExcludedBlock ifError: errorBlock "Evaluate mutuallyExcludedBlock only if the receiver is not currently in the process of running the critical: message. If the receiver is, evaluate mutuallyExcludedBlock after the other critical: message is finished." | blockValue hasError errMsg errRcvr | hasError := false. blockValue := self critical:[ + mutuallyExcludedBlock ifError: [ :msg :rcvr | - [mutuallyExcludedBlock value] ifError:[:msg :rcvr| hasError := true. errMsg := msg. errRcvr := rcvr ]. ]. hasError ifTrue:[ ^errorBlock value: errMsg value: errRcvr]. ^blockValue! Item was changed: ----- Method: Semaphore>>critical:ifLocked: (in category 'mutual exclusion') ----- critical: mutuallyExcludedBlock ifLocked: alternativeBlock "Evaluate mutuallyExcludedBlock only if the receiver is not currently in + the process of running the critical: message. If the receiver is, then evaluate + alternativeBlock and return." + "See the comment of #critical: for the explanation how this pattern works + before changing the code." + + | caught | + caught := false. + ^[ + "We're using #== here instead of #=, because it won't introduce a + suspension point, while #= may do that." + excessSignals == 0 + ifTrue: [ alternativeBlock value ] + ifFalse: [ + excessSignals := excessSignals - 1. + caught := true. + mutuallyExcludedBlock value ] ] + ensure: [ caught ifTrue: [ self signal ] ]! - the process of running the critical: message. If the receiver is, evaluate - mutuallyExcludedBlock after the other critical: message is finished." - - "Note: The following is tricky and depends on the fact that the VM will not switch between processes while executing byte codes (process switches happen only in real sends). The following test is written carefully so that it will result in bytecodes only. - Do not change the following #== for #=, as #== is not a real message send, just a bytecode." - excessSignals == 0 ifTrue: [ - "If we come here, then the semaphore was locked when the test executed. - Evaluate the alternative block and answer its result." - ^alternativeBlock value - ]. - ^self critical: mutuallyExcludedBlock!

Dec. 14, 2010

[Pharo-project] Issue 3427 in pharo: two methods from BlockContext to BlockClosure

by pharo＠googlecode.com

Status: FixedWaitingToBePharoed Owner: stephane.ducasse Labels: Milestone-1.3 New issue 3427 by stephane.ducasse: two methods from BlockContext to BlockClosure http://code.google.com/p/pharo/issues/detail?id=3427 Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.519.mcz ==================== Summary ==================== Name: Kernel-ul.519 Author: ul Time: 8 December 2010, 2:52:41.144 am UUID: 630c1710-46b8-5248-bdb8-e08d99d6d9c0 Ancestors: Kernel-ul.518 - copied another two methods from BlockContext to BlockClosure. One of them fixes http://bugs.squeak.org/view.php?id=7579 . =============== Diff against Kernel-ul.518 =============== Item was added: + ----- Method: BlockClosure>>newProcessWith: (in category 'scheduling') ----- + newProcessWith: anArray + "Answer a Process running the code in the receiver. The receiver's block + arguments are bound to the contents of the argument, anArray. The + process is not scheduled." + <primitive: 19> "Simulation guard" + ^Process + forContext: + [self valueWithArguments: anArray. + Processor terminateActive] asContext + priority: Processor activePriority! Item was added: + ----- Method: BlockClosure>>valueWithExit (in category 'evaluating') ----- + valueWithExit + self value: [ ^nil ]!

Dec. 14, 2010

Re: [Pharo-project] Issue 3426 in pharo: shouldBePrintedAsLiteral instead of isLiteral

by pharo＠googlecode.com

Comment #1 on issue 3426 by stephane.ducasse: shouldBePrintedAsLiteral instead of isLiteral http://code.google.com/p/pharo/issues/detail?id=3426 - use #shouldBePrintedAsLiteral instead of #isLiteral when printing or storing characters and arrays =============== Diff against Collections-ul.410 =============== Item was changed: ----- Method: Array>>printOn: (in category 'printing') ----- printOn: aStream + self shouldBePrintedAsLiteral ifTrue: [^self printAsLiteralFormOn: aStream]. - self isLiteral ifTrue: [^self printAsLiteralFormOn: aStream]. self class = Array ifTrue: [^self printAsBraceFormOn: aStream]. ^super printOn: aStream! Item was added: + ----- Method: Array>>shouldBePrintedAsLiteral (in category 'testing') ----- + shouldBePrintedAsLiteral + + ^self class == Array and: [ self allSatisfy: [ :each | each shouldBePrintedAsLiteral ] ]! Item was changed: ----- Method: Array>>storeOn: (in category 'printing') ----- storeOn: aStream "Use the literal form if possible." + self shouldBePrintedAsLiteral - self isLiteral ifTrue: [aStream nextPut: $#; nextPut: $(. self do: [:element | element storeOn: aStream. aStream space]. aStream nextPut: $)] ifFalse: [super storeOn: aStream]! Item was changed: ----- Method: Array>>storeOnStream: (in category 'filter streaming') ----- storeOnStream:aStream + + self shouldBePrintedAsLiteral + ifTrue: [ super storeOnStream:aStream ] + ifFalse:[ aStream writeCollection:self ] - self isLiteral ifTrue: [super storeOnStream:aStream] ifFalse:[aStream writeCollection:self]. ! Item was changed: + ----- Method: Character>>isLiteral (in category 'testing') ----- - ----- Method: Character>>isLiteral (in category 'printing') ----- isLiteral ^true! Item was added: + ----- Method: Character>>shouldBePrintedAsLiteral (in category 'testing') ----- + shouldBePrintedAsLiteral + + ^value between: 33 and: 255! Item was changed: ----- Method: Character>>storeOn: (in category 'printing') ----- storeOn: aStream "Common character literals are preceded by '$', however special need to be encoded differently: for some this might be done by using one of the shortcut constructor methods for the rest we have to create them by ascii-value." | name | + self shouldBePrintedAsLiteral - (value between: 33 and: 255) ifTrue: [ aStream nextPut: $$; nextPut: self ] ifFalse: [ name := self class constantNameFor: self. name notNil ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ] ifFalse: [ aStream nextPut: $(; nextPutAll: self class name; nextPutAll: ' value: '; print: value; nextPut: $) ] ].!

Dec. 14, 2010

[Pharo-project] Issue 3426 in pharo: shouldBePrintedAsLiteral instead of isLiteral

by pharo＠googlecode.com

Status: Fixed Owner: stephane.ducasse Labels: Milestone-1.3 New issue 3426 by stephane.ducasse: shouldBePrintedAsLiteral instead of isLiteral http://code.google.com/p/pharo/issues/detail?id=3426 Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.518.mcz ==================== Summary ==================== Name: Kernel-ul.518 Author: ul Time: 23 November 2010, 1:54:49.317 pm UUID: b098496d-94bb-f943-9cf9-bd07ab3b0b71 Ancestors: Kernel-dtl.517 - introduced Object >> #shouldBePrintedAsLiteral as a replacement for #isLiteral during printing and storing =============== Diff against Kernel-dtl.517 =============== Item was added: + ----- Method: Object>>shouldBePrintedAsLiteral (in category 'testing') ----- + shouldBePrintedAsLiteral + + ^self isLiteral! Item was changed: ----- Method: ScaledDecimal>>storeOn: (in category 'printing') ----- storeOn: aStream "SxaledDecimal sometimes have more digits than they print (potentially an infinity). In this case, do not use printOn: because it would loose some extra digits" + self shouldBePrintedAsLiteral - self isLiteral ifTrue: [self printOn: aStream] ifFalse: [aStream nextPut: $(; store: fraction numerator; nextPut: $/; store: fraction denominator; nextPut: $s; store: scale; nextPut: $)]!

Dec. 14, 2010

Re: [Pharo-project] Issue 3425 in pharo: Environment related class behavior

by pharo＠googlecode.com

Comment #1 on issue 3425 by stephane.ducasse: Environment related class behavior http://code.google.com/p/pharo/issues/detail?id=3425 see http://forum.world.st/Class-variables-with-the-same-name-as-an-existing-cla…

Dec. 14, 2010

[Pharo-project] Issue 3425 in pharo: Environment related class behavior

by pharo＠googlecode.com

Status: FixedWaitingToBePharoed Owner: stephane.ducasse Labels: Milestone-1.3 New issue 3425 by stephane.ducasse: Environment related class behavior http://code.google.com/p/pharo/issues/detail?id=3425 A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-spd.444.mcz ==================== Summary ==================== Name: Kernel-spd.444 Author: spd Time: 4 December 2010, 1:30:09.425 pm UUID: 571950b9-31b4-4f85-b27f-e4b7e6044b27 Ancestors: Kernel-ar.443 * fixed Class>>canFindWithoutEnvironment: (it was actually checking the environment, making the behavior like bindingOf:) and added test to KernelTests * changed Class>>declare: and Class>>addClassVarName: - no longer check the environment for conflicts - conflict error message clarified * made conflict error in #addClassVarName: resumable to match the behavior of #declare: n.b. no conflicts with trunk as of 12/4/2010 =============== Diff against Kernel-ar.443 =============== Item was removed: - ----- Method: BlockContext>>valueWithEnoughArguments: (in category 'evaluating') ----- - valueWithEnoughArguments: anArray - "call me with enough arguments from anArray" - | args | - (anArray size == self numArgs) - ifTrue: [ ^self valueWithArguments: anArray ]. - - args := Array new: self numArgs. - args replaceFrom: 1 - to: (anArray size min: args size) - with: anArray - startingAt: 1. - - ^ self valueWithArguments: args! Item was changed: ----- Method: Class>>addClassVarName: (in category 'class variables') ----- addClassVarName: aString "Add the argument, aString, as a class variable of the receiver. Signal an error if the first character of aString is not capitalized, or if it is already a variable named in the class." | symbol oldState | oldState := self copy. aString first canBeGlobalVarInitial ifFalse: [^self error: aString, ' class variable name should be capitalized; proceed to include anyway.']. symbol := aString asSymbol. self withAllSubclasses do: [:subclass | + (self canFindWithoutEnvironment: symbol) ifTrue: [ + (DuplicateVariableError new) + superclass: superclass; "fake!!!!!!" + variable: aString; + signal: aString, ' is already defined']]. - (subclass bindingOf: symbol) ifNotNil:[ - ^ self error: aString - , ' is already used as a variable name in class ' - , subclass name]]. classPool == nil ifTrue: [classPool := Dictionary new]. (classPool includesKey: symbol) ifFalse: ["Pick up any refs in Undeclared" classPool declare: symbol from: Undeclared. SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: oldState to: self]! Item was changed: ----- Method: Class>>canFindWithoutEnvironment: (in category 'compiling') ----- canFindWithoutEnvironment: varName "This method is used for analysis of system structure -- see senders." "Look up varName, in the context of the receiver. Return true if it can be found without using the declared environment." "First look in classVar dictionary." (self classPool bindingOf: varName) ifNotNil:[^true]. "Next look in shared pools." self sharedPools do:[:pool | (pool bindingOf: varName) ifNotNil:[^true]. ]. "Finally look higher up the superclass chain and fail at the end." superclass == nil ifTrue: [^ false] + ifFalse: [^ superclass canFindWithoutEnvironment: varName]. - ifFalse: [^ (superclass bindingOf: varName) notNil]. ! Item was changed: ----- Method: Class>>declare: (in category 'initialize-release') ----- declare: varString "Declare class variables common to all instances. Answer whether recompilation is advisable." | newVars conflicts | + newVars := (Scanner new scanFieldNames: varString) collect: [:x | x asSymbol]. newVars do: [:var | var first canBeGlobalVarInitial ifFalse: [self error: var, ' class variable name should be capitalized; proceed to include anyway.']]. conflicts := false. classPool == nil ifFalse: [(classPool keys reject: [:x | newVars includes: x]) do: [:var | self removeClassVarName: var]]. (newVars reject: [:var | self classPool includesKey: var]) do: [:var | "adding" "check if new vars defined elsewhere" + (self canFindWithoutEnvironment: var) ifTrue: [ - (self bindingOf: var) ifNotNil:[ (DuplicateVariableError new) superclass: superclass; "fake!!!!!!" variable: var; + signal: var, ' is already defined'. - signal: var , ' is defined elsewhere'. conflicts := true]]. newVars size > 0 ifTrue: [classPool := self classPool. "in case it was nil" newVars do: [:var | classPool declare: var from: Undeclared]]. ^conflicts! Item was removed: - ----- Method: MessageSend>>valueWithEnoughArguments: (in category 'evaluating') ----- - valueWithEnoughArguments: anArray - "call the selector with enough arguments from arguments and anArray" - | args | - args := Array new: selector numArgs. - args replaceFrom: 1 - to: (arguments size min: args size) - with: arguments - startingAt: 1. - args size > arguments size ifTrue: [ - args replaceFrom: arguments size + 1 - to: (arguments size + anArray size min: args size) - with: anArray - startingAt: 1. - ]. - ^ receiver perform: selector withArguments: args! Item was removed: - ----- Method: Object>>actionsWithReceiver:forEvent: (in category 'events') ----- - actionsWithReceiver: anObject forEvent: anEventSelector - - ^(self actionSequenceForEvent: anEventSelector) - select: [:anAction | anAction receiver == anObject ]! Item was removed: - ----- Method: Object>>assert:description: (in category 'error handling') ----- - assert: aBlock description: aString - "Throw an assertion error if aBlock does not evaluates to true." - - aBlock value ifFalse: [AssertionFailure signal: aString ]! Item was removed: - ----- Method: Object>>assert:descriptionBlock: (in category 'error handling') ----- - assert: aBlock descriptionBlock: descriptionBlock - "Throw an assertion error if aBlock does not evaluate to true." - - aBlock value ifFalse: [AssertionFailure signal: descriptionBlock value asString ]! Item was removed: - ----- Method: Object>>perform:withEnoughArguments: (in category 'message handling') ----- - perform: selector withEnoughArguments: anArray - "Send the selector, aSymbol, to the receiver with arguments in argArray. - Only use enough arguments for the arity of the selector; supply nils for missing ones." - | numArgs args | - numArgs := selector numArgs. - anArray size == numArgs - ifTrue: [ ^self perform: selector withArguments: anArray asArray ]. - - args := Array new: numArgs. - args replaceFrom: 1 - to: (anArray size min: args size) - with: anArray - startingAt: 1. - - ^ self perform: selector withArguments: args! Item was removed: - ----- Method: Object>>renameActionsWithReceiver:forEvent:toEvent: (in category 'events') ----- - renameActionsWithReceiver: anObject forEvent: anEventSelector toEvent: newEvent - - | oldActions newActions | - oldActions := Set new. - newActions := Set new. - (self actionSequenceForEvent: anEventSelector) do: [ :action | - action receiver == anObject - ifTrue: [ oldActions add: anObject ] - ifFalse: [ newActions add: anObject ]]. - self setActionSequence: (ActionSequence withAll: newActions) forEvent: anEventSelector. - oldActions do: [ :act | self when: newEvent evaluate: act ].! Item was changed: ----- Method: StringHolder class>>open (in category 'instance creation') ----- open + ^ (Smalltalk at: #Workspace ifAbsent:[self]) new openLabel: 'Workspace' - (Smalltalk at: #Workspace ifAbsent:[self]) new openLabel: 'Workspace' "Not to be confused with our own class var 'Workspace'"!

Dec. 14, 2010

[Pharo-project] Issue 3424 in pharo: Improved class Tests

by pharo＠googlecode.com

Status: FixedWaitingToBePharoed Owner: stephane.ducasse Labels: Milestone-1.3 Difficulty-Easy New issue 3424 by stephane.ducasse: Improved class Tests http://code.google.com/p/pharo/issues/detail?id=3424 A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-spd.149.mcz ==================== Summary ==================== Name: KernelTests-spd.149 Author: spd Time: 4 December 2010, 1:33:50.265 pm UUID: 89c23bef-103f-4b9d-885c-bcf19d6b6fa9 Ancestors: KernelTests-cmm.148 * refactored and extended ClassTest, including adding a test for Class>>canFindWithoutEnvironment: (fixed in Kernel-spd.444 in inbox) n.b. no conflicts with trunk as of 12/4/2010 =============== Diff against KernelTests-cmm.148 =============== Item was changed: TestCase subclass: #ClassTest + instanceVariableNames: 'className renamedName subClassName anotherClassName class subclass anotherClass' - instanceVariableNames: 'className renamedName' classVariableNames: '' poolDictionaries: '' category: 'KernelTests-Classes'! Item was added: + ----- Method: ClassTest classSide>>deleteClassNamed: (in category 'setup') ----- + deleteClassNamed: aString + | cl | + cl := Smalltalk at: aString ifAbsent: [^self]. + cl removeFromChanges; removeFromSystemUnlogged + ! Item was removed: - ----- Method: ClassTest>>deleteClass (in category 'setup') ----- - deleteClass - | cl | - cl := Smalltalk at: className ifAbsent: [^self]. - cl removeFromChanges; removeFromSystemUnlogged - ! Item was removed: - ----- Method: ClassTest>>deleteRenamedClass (in category 'setup') ----- - deleteRenamedClass - | cl | - cl := Smalltalk at: renamedName ifAbsent: [^self]. - cl removeFromChanges; removeFromSystemUnlogged - ! Item was added: + ----- Method: ClassTest>>deleteTestClasses (in category 'setup') ----- + deleteTestClasses + + self class deleteClassNamed: class name. + self class deleteClassNamed: subclass name. + self class deleteClassNamed: renamedName. + self class deleteClassNamed: anotherClass name. + ! Item was changed: ----- Method: ClassTest>>setUp (in category 'setup') ----- setUp + - className := #TUTU. renamedName := #RenamedTUTU. + + self deleteTestClasses. + + class := Object subclass: #TUTU - self deleteClass. - self deleteRenamedClass. - Object subclass: className instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'KernelTests-Classes'. + + subclass := class subclass: #SubTUTU + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'KernelTests-Classes'. + + anotherClass := Object subclass: #AnotherClass + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'KernelTests-Classes'.! - category: 'KernelTests-Classes'! Item was added: + ----- Method: ClassTest>>superclass (in category 'accessing') ----- + superclass + + ^ class.! Item was changed: ----- Method: ClassTest>>tearDown (in category 'setup') ----- tearDown + + self deleteTestClasses.! - self deleteClass. - self deleteRenamedClass! Item was added: + ----- Method: ClassTest>>testAddClassVarName (in category 'testing') ----- + testAddClassVarName + "self run: #testAddClassVarName" + + class addClassVarName: #MyShinyNewClassVar. + self assert: (class classVarNames anySatisfy: [ :name | name = #MyShinyNewClassVar ]). + + ! Item was added: + ----- Method: ClassTest>>testAddClassVarNameWithSameNameAsAGlobal (in category 'testing') ----- + testAddClassVarNameWithSameNameAsAGlobal + "self run: #testAddClassVarName" + + self shouldnt: [ class addClassVarName: anotherClass name ] raise: Exception. + self assert: (class classVarNames anySatisfy: [ :name | name = anotherClass name ]). + + ! Item was changed: ----- Method: ClassTest>>testAddInstVarName (in category 'testing') ----- testAddInstVarName "self run: #testAddInstVarName" + class addInstVarName: 'x'. + self assert: (class instVarNames = #('x')). + class addInstVarName: 'y'. + self assert: (class instVarNames = #('x' 'y')) - | tutu | - tutu := Smalltalk at: #TUTU. - tutu addInstVarName: 'x'. - self assert: (tutu instVarNames = #('x')). - tutu addInstVarName: 'y'. - self assert: (tutu instVarNames = #('x' 'y')) - ! Item was added: + ----- Method: ClassTest>>testCanFindWithoutEnvironment (in category 'testing') ----- + testCanFindWithoutEnvironment + "self debug: #testCanFindWithoutEnvironment" + "self run: #testCanFindWithoutEnvironment" + + self deny: (subclass canFindWithoutEnvironment: #ClassVarInSuperclass). + self deny: (subclass canFindWithoutEnvironment: #PoolVarInSuperclass). + self deny: (subclass canFindWithoutEnvironment: #ClassVar). + self deny: (subclass canFindWithoutEnvironment: #PoolVar). + + subclass addClassVarName: 'ClassVar'. + self assert: (subclass canFindWithoutEnvironment: #ClassVar). + + subclass addSharedPool: (Dictionary newFromPairs: #(PoolVar->5)). + self assert: (subclass canFindWithoutEnvironment: #PoolVar). + + self superclass addClassVarName: 'ClassVarInSupersubclass'. + self assert: (subclass canFindWithoutEnvironment: #ClassVarInSupersubclass). + + self superclass addSharedPool: (Dictionary newFromPairs: #(PoolVarInSupersubclass->5)). + self assert: (subclass canFindWithoutEnvironment: #PoolVarInSupersubclass).! Item was changed: ----- Method: ClassTest>>testRenaming (in category 'testing') ----- testRenaming "self debug: #testRenaming" "self run: #testRenaming" + | newMetaclassName | - | oldName newMetaclassName class | - oldName := className. newMetaclassName := (renamedName, #' class') asSymbol. - class := Smalltalk at: oldName. class class compile: 'dummyMeth'. class rename: renamedName. self assert: class name = renamedName. self assert: (ChangeSet current changedClassNames includes: renamedName). self assert: (ChangeSet current changedClassNames includes: newMetaclassName). !

Dec. 14, 2010