Squeak-dev February 2010

squeak-dev@lists.squeakfoundation.org

89 participants
595 discussions

Sets with nil
by Andreas Raab 03 Feb '10

03 Feb '10

Folks - Since I just integrated Igor's Set with nil support into our production images (after finding a heinous method called setSize in class Bag which people used to write aCollection asBag setSize instead of aCollection asSet size) I did the same in the trunk. I found that the code was already rotten a bit but hopefully the tests account for most of it. Test coverage is probably incomplete in particular for cases involving nil; more tests are definitely helpful. And of course if you find any issues with the changes please report them. Cheers, - Andreas

3 2

The Trunk: Traits-ar.279.mcz
by commits＠source.squeak.org 03 Feb '10

03 Feb '10

Andreas Raab uploaded a new version of Traits to project The Trunk: http://source.squeak.org/trunk/Traits-ar.279.mcz ==================== Summary ==================== Name: Traits-ar.279 Author: ar Time: 2 February 2010, 8:33:55.237 pm UUID: 91a4303d-4277-b74e-a5ff-6af70a550876 Ancestors: Traits-ar.278 Fixes the traits bug masked by the issues with Class>>binding. When recompiling a selector/method pair, the original trait method needs to be preserved if the method came from a trait. Otherwise the method will be considered a locally defined method after the reshape which is incorrect. =============== Diff against Traits-ar.278 =============== Item was added: + ----- Method: ClassDescription>>recompile:from: (in category '*Traits-NanoKernel') ----- + recompile: selector from: oldClass + "Preserve the originalTraitMethod (if any) after recompiling a selector" + | oldMethod | + oldMethod := oldClass compiledMethodAt: selector. + super recompile: selector from: oldClass. + oldMethod originalTraitMethod ifNotNil:[:traitMethod| + (self compiledMethodAt: selector) originalTraitMethod: traitMethod. + ]. + !

1 0

The Trunk: TraitsTests-ar.5.mcz
by commits＠source.squeak.org 03 Feb '10

03 Feb '10

Andreas Raab uploaded a new version of TraitsTests to project The Trunk: http://source.squeak.org/trunk/TraitsTests-ar.5.mcz ==================== Summary ==================== Name: TraitsTests-ar.5 Author: ar Time: 2 February 2010, 8:32:10.854 pm UUID: 2837d2ee-bcc0-4f41-9a71-274f2f6b6143 Ancestors: TraitsTests-ul.4 Improve Traits tests: - Remove a duplicate test - Extend the superclass change test so that it covers the problems encountered with ClassBuilder usage - Add an extra reshape test to avoid side-effects due to superclass involvement in previos test =============== Diff against TraitsTests-ul.4 =============== Item was changed: ----- Method: PureBehaviorTest>>testChangeSuperclass (in category 'testing-applying trait composition') ----- testChangeSuperclass "self run: #testChangeSuperclass" "Test that when the superclass of a class is changed the non-local methods of the class sending super are recompiled to correctly store the new superclass." | aC2 newSuperclass | aC2 := self c2 new. "C1 is current superclass of C2" self assert: aC2 m51. self assert: self c2 superclass == self c1. self deny: (self c2 localSelectors includes: #m51). + self deny: (self c2 >> #m52) == (self t5 >> #m52). "no sharing!!" + self assert: self c2 traitCompositionString = 'T5 - {#m11}'. + self assert: self c2 selectors sort = #(bar foo m12 m13 m21 m22 m51 m52 m53). + self assert: self c2 localSelectors sort = #(bar foo). + + "change superclass of C2 from C1 to X" newSuperclass := self createClassNamed: #X superclass: Object uses: {}. newSuperclass subclass: self c2 name uses: self c2 traitComposition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self c2 category. self assert: self c2 superclass == newSuperclass. newSuperclass compile: 'foo ^17'. self assert: aC2 m51 = 17. self deny: (self c2 localSelectors includes: #m51). self c2 compile: 'm51 ^19'. self assert: aC2 m51 = 19. self deny: (self c2 >> #m52) == (self t5 >> #m52). "no sharing!!" + self assert: self c2 traitCompositionString = 'T5 - {#m11}'. + self assert: self c2 selectors sort = #(bar foo m12 m13 m21 m22 m51 m52 m53). + self assert: self c2 localSelectors sort = #(bar foo m51). + "change superclass of C2 back to C1" + self c1 + subclass: self c2 name + uses: self c2 traitComposition + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self c2 category. + + self assert: (aC2 m51 = 19). + self assert: self c2 superclass == self c1. + self assert: (self c2 localSelectors includes: #m51). + self deny: (self c2 >> #m52) == (self t5 >> #m52). "no sharing!!" + + self assert: self c2 traitCompositionString = 'T5 - {#m11}'. + self assert: self c2 selectors sort = #(bar foo m12 m13 m21 m22 m51 m52 m53). + self assert: self c2 localSelectors sort = #(bar foo m51). + ! - ! Item was added: + ----- Method: PureBehaviorTest>>testReshapeClass (in category 'testing-applying trait composition') ----- + testReshapeClass + "self run: #testReshapeClass" + + "Ensure that reshaping a class has no impact on its traits" + + self assert: self c2 traitCompositionString = 'T5 - {#m11}'. + self assert: self c2 selectors sort = #(bar foo m12 m13 m21 m22 m51 m52 m53). + self assert: self c2 localSelectors sort = #(bar foo). + + self c2 addInstVarName: 'foobar'. + + self assert: self c2 traitCompositionString = 'T5 - {#m11}'. + self assert: self c2 selectors sort = #(bar foo m12 m13 m21 m22 m51 m52 m53). + self assert: self c2 localSelectors sort = #(bar foo). + + self c2 removeInstVarName: 'foobar'. + + self assert: self c2 traitCompositionString = 'T5 - {#m11}'. + self assert: self c2 selectors sort = #(bar foo m12 m13 m21 m22 m51 m52 m53). + self assert: self c2 localSelectors sort = #(bar foo). + ! Item was removed: - ----- Method: TraitsTestCase>>testChangeSuperclass (in category 'testing-applying trait composition') ----- - testChangeSuperclass - "self run: #testChangeSuperclass" - - "Test that when the superclass of a class is changed the non-local methods - of the class sending super are recompiled to correctly store the new superclass." - - | aC2 newSuperclass | - aC2 := self c2 new. - - "C1 is current superclass of C2" - self assert: aC2 m51. - self assert: self c2 superclass == self c1. - self deny: (self c2 localSelectors includes: #m51). - - "change superclass of C2 from C1 to X" - newSuperclass := self createClassNamed: #TraitsTestX superclass: Object uses: {}. - newSuperclass - subclass: self c2 name - uses: self c2 traitComposition - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: self c2 category. - - self assert: self c2 superclass == newSuperclass. - - newSuperclass compile: 'foo ^17'. - self assert: aC2 m51 = 17. - self deny: (self c2 localSelectors includes: #m51). - - self c2 compile: 'm51 ^19'. - self assert: aC2 m51 = 19. - - "no sharing!!" - self deny: (self c2 >> #m52) == (self t5 >> #m52).!

1 0

Daily Commit Log
by commits＠source.squeak.org 03 Feb '10

03 Feb '10

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2010-February/002510.h… Name: Tools-dtl.166 Ancestors: Tools-dtl.165 FileChooser fixes (class examples were broken). Implement FileChooser class>>new to bypass new behavior in superclass FileList, not appropriate for FileChooser. Correct spelling errors in method names. Note: FileChooser is unreferenced in the image. It was introduced in Squeak 3.9, but is not used in Squeak 3.9 or Squeak trunk. It has a rather Etoys look about it, but does not appear to be used in Etoys. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002511.h… Name: Collections-ar.287 Ancestors: Collections-edc.285, Collections-edc.286 Merge Collections-edc.286 with some changes: - Implement both beginsWithAnyOf: as well as endsWithAnyOf: - Push the implementation up to SequenceableCollection - Simplify the implementation (using #anySatisfy:) - Add comments (also in beginsWith: and endsWith:) - Add tests ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002512.h… Name: CollectionsTests-ar.134 Ancestors: CollectionsTests-ul.133 Tests for beginsWithAnyOf: and endsWithAnyOf:. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002513.h… Name: Kernel-ar.384 Ancestors: Kernel-tfel.383 Sets with nil: Merge code from http://bugs.squeak.org/view.php?id=7413 before it rots even more. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002514.h… Name: CollectionsTests-ar.135 Ancestors: CollectionsTests-ar.134 Tests for sets with nil: Documents current behavior including the cases that aren't supported (KeyedSet and WeakSet since they have some additional requirements). ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002515.h… Name: Collections-ar.288 Ancestors: Collections-ar.287 Sets with nil: Merge code from http://bugs.squeak.org/view.php?id=7413 before it rots even more. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002516.h… Name: Collections-ar.289 Ancestors: Collections-ar.288 Complete Set with nil support by providing proper modifications to KeyedSet and WeakSet. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002517.h… Name: CollectionsTests-ar.136 Ancestors: CollectionsTests-ar.135 More tests, including KeyedSet and WeakSet. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002518.h… Name: CollectionsTests-ar.137 Ancestors: CollectionsTests-ar.136 Fixes a typo in SetWithNilTest. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002519.h… Name: CollectionsTests-ar.138 Ancestors: CollectionsTests-ar.137 Remove unnecessary use of traits in ReadStreamTest. Makes it possible to load CollectionTests into images w/o traits support. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002520.h… Name: CollectionsTests-ar.138 Ancestors: CollectionsTests-ar.137 Remove unnecessary use of traits in ReadStreamTest. Makes it possible to load CollectionTests into images w/o traits support. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002521.h… Name: Kernel-ar.385 Ancestors: Kernel-ar.384 Fix handling of Class>>binding: - Verify that the registered class in the environment is the receiver - Install a common binding after recompilation - Add an accessor for installing the binding in CompiledMethod ============================================= http://lists.squeakfoundation.org/pipermail/packages/2010-February/002522.h… Name: Kernel-ar.386 Ancestors: Kernel-ar.385, Kernel-ar.381 Merging Date class>>#readFrom:pattern: one more time (got accidentally replaced by a newer version without being merged). =============================================

1 0

The Trunk: Kernel-ar.386.mcz
by commits＠source.squeak.org 02 Feb '10

02 Feb '10

Andreas Raab uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ar.386.mcz ==================== Summary ==================== Name: Kernel-ar.386 Author: ar Time: 2 February 2010, 10:52:47.731 am UUID: 72d71775-3ee2-bb41-b1db-2a527b7cc25c Ancestors: Kernel-ar.385, Kernel-ar.381 Merging Date class>>#readFrom:pattern: one more time (got accidentally replaced by a newer version without being merged). =============== Diff against Kernel-ar.385 =============== Item was added: + ----- Method: Date class>>readFrom:pattern: (in category 'squeak protocol') ----- + readFrom: inputStream pattern: pattern + "Read a Date from the stream based on the pattern which can include the tokens: + + y = A year with 1-n digits + yy = A year with 2 digits + yyyy = A year with 4 digits + m = A month with 1-n digits + mm = A month with 2 digits + d = A day with 1-n digits + dd = A day with 2 digits + + ...and any other Strings inbetween. Representing $y, $m and $d is done using + \y, \m and \d and slash itself with \\. Simple example patterns: + + 'yyyy-mm-dd' + 'yyyymmdd' + 'yy.mm.dd' + 'y-m-d' + + A year given using only two decimals is considered to be >2000." + + | day month year patternStream char | + patternStream := pattern readStream. + [patternStream atEnd] whileFalse: [ + inputStream atEnd ifTrue: [^nil]. + char := patternStream next. + char = $\ + ifTrue: [inputStream next = patternStream next ifFalse: [^nil]] + ifFalse: [ + char = $y + ifTrue: [ + (patternStream nextMatchAll: 'yyy') + ifTrue: [year := (inputStream next: 4) asInteger] + ifFalse: [ + (patternStream peekFor: $y) + ifTrue: [ + year := (inputStream next: 2) asInteger] + ifFalse: [ + year := Integer readFrom: inputStream]]] + ifFalse: [ + char = $m + ifTrue: [ + (patternStream peekFor: $m) + ifTrue: [ + month := (inputStream next: 2) asInteger] + ifFalse: [ + month := Integer readFrom: inputStream]] + ifFalse: [ + char = $d + ifTrue: [ + (patternStream peekFor: $d) + ifTrue: [ + day := (inputStream next: 2) asInteger] + ifFalse: [ + day := Integer readFrom: inputStream]] + ifFalse: [ + inputStream next = char ifFalse: [^nil]]]]]]. + (year isNil | month isNil | day isNil) ifTrue: [^nil]. + ^self year: year month: month day: day!

1 0

The Trunk: Kernel-ar.385.mcz
by commits＠source.squeak.org 02 Feb '10

02 Feb '10

Andreas Raab uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ar.385.mcz ==================== Summary ==================== Name: Kernel-ar.385 Author: ar Time: 2 February 2010, 10:03:42.112 am UUID: ca133c5e-fb58-834d-aab1-1a61b83d6c3d Ancestors: Kernel-ar.384 Fix handling of Class>>binding: - Verify that the registered class in the environment is the receiver - Install a common binding after recompilation - Add an accessor for installing the binding in CompiledMethod =============== Diff against Kernel-ar.384 =============== Item was changed: ----- Method: Behavior>>compileAllFrom: (in category 'compiling') ----- compileAllFrom: oldClass "Compile all the methods in the receiver's method dictionary. This validates sourceCode and variable references and forces all methods to use the current bytecode set" + | binding | "ar 7/10/1999: Use oldClass selectors not self selectors" + oldClass selectorsDo: [:sel | self recompile: sel from: oldClass]. + "Ensure that we share a common binding after recompilation. + This is so that ClassBuilder reshapes avoid creating new bindings + for every method when recompiling a large class hierarchy." + binding := self binding. + self methodsDo:[:m| + m methodClassAssociation == binding + ifFalse:[m methodClassAssociation: binding]]. + ! - oldClass selectorsDo: [:sel | self recompile: sel from: oldClass].! Item was added: + ----- Method: CompiledMethod>>methodClassAssociation: (in category 'accessing') ----- + methodClassAssociation: aBinding + "sets the association to the class that I am installed in" + ^self literalAt: self numLiterals put: aBinding! Item was changed: ----- Method: Class>>binding (in category 'compiling') ----- binding + "Answer a binding for the receiver, sharing if possible" + | binding | + binding := Smalltalk associationAt: name ifAbsent: [nil -> self]. + ^binding value == self ifTrue:[binding] ifFalse:[nil -> self].! - - ^ Smalltalk associationAt: name ifAbsent: [nil -> self] - !

1 0

The Trunk: CollectionsTests-ar.138.mcz
by commits＠source.squeak.org 02 Feb '10

02 Feb '10

Andreas Raab uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-ar.138.mcz ==================== Summary ==================== Name: CollectionsTests-ar.138 Author: ar Time: 2 February 2010, 1:07:16.819 am UUID: 5f83525f-df0c-5d4a-a7b0-c0a1ede3c8f3 Ancestors: CollectionsTests-ar.137 Remove unnecessary use of traits in ReadStreamTest. Makes it possible to load CollectionTests into images w/o traits support. =============== Diff against CollectionsTests-ar.137 =============== Item was added: + ----- Method: ReadStreamTest>>testUpTo (in category 'tests - accessing') ----- + testUpTo + | returnValue stream | + returnValue := (self emptyStream upTo: nil). + self assert: returnValue isCollection. + self assert: returnValue isEmpty. + + stream := self streamOnArray. + returnValue := stream upTo: #(a b c). + self assert: returnValue = #(1). + self assert: stream peek = false. + + stream := self streamOnArray. + returnValue := stream upTo: true. + self assert: returnValue = #(1 #(a b c) false). + self assert: stream atEnd.! Item was added: + ----- Method: ReadStreamTest>>testReset (in category 'tests - positioning') ----- + testReset + | stream | + + stream := self emptyStream. + stream reset. + self assert: stream position = 0. + + stream := self streamOnArray. + stream reset. + self assert: stream position = 0. + self deny: stream atEnd. + stream position: 3. + self assert: stream atEnd. + stream reset. + self assert: stream position = 0.! Item was added: + ----- Method: ReadStreamTest>>testBackUpToEmptyPattern1 (in category 'tests - positioning') ----- + testBackUpToEmptyPattern1 + "This test represents the current behavior which is not clearly defined and could be revised." + |stream| + stream := ReadStream on: 'abcdabg'. + stream setToEnd. + self should: [stream backUpTo: ''] raise: Error.! Item was added: + ----- Method: ReadStreamTest>>testBackUpTo1 (in category 'tests - positioning') ----- + testBackUpTo1 + |stream| + stream := ReadStream on: 'abcdabg'. + stream setToEnd. + self assert: (stream backUpTo: 'ab'). + self assert: stream peek = $g! Item was added: + ----- Method: ReadStreamTest>>testPeek2 (in category 'tests - accessing') ----- + testPeek2 + | stream | + stream := self streamOn: #(nil nil nil). + + self assert: stream peek isNil. + stream next. + self assert: stream peek isNil. + stream next. + self assert: stream peek isNil. + stream next. + + "Yes, #peek answers nil when there is no more element to read." + self assert: stream peek isNil.! Item was added: + ----- Method: ReadStreamTest>>testNext (in category 'tests - accessing') ----- + testNext + |stream| + + stream := self streamOnArray. + self assert: stream next = 1. + self assert: stream next = #(a b c). + self assert: stream next = false. + + stream := self streamOnString. + self assert: stream next = $a. + self assert: stream next = $b. + self assert: stream next = $c. + self assert: stream next = $d. + self assert: stream next = $e. + ! Item was added: + ----- Method: ReadStreamTest>>testNextMatchFor (in category 'tests - testing') ----- + testNextMatchFor + | stream | + stream := self streamOnArray. + self assert: (stream nextMatchFor: 1). + self assert: (stream nextMatchFor: #(a b c)). + self assert: (stream nextMatchFor: false). + + stream := self streamOnArray. + self deny: (stream nextMatchFor: false). + self assert: (stream nextMatchFor: #(a b c)). + self assert: (stream nextMatchFor: false). + ! Item was added: + ----- Method: ReadStreamTest>>testDo (in category 'tests - enumerating') ----- + testDo + self emptyStream do: [:value | self fail]! Item was added: + ----- Method: ReadStreamTest>>streamOn: (in category 'helpers') ----- + streamOn: aCollection + ^ self classUnderTest on: aCollection! Item was added: + ----- Method: ReadStreamTest>>testDo2 (in category 'tests - enumerating') ----- + testDo2 + | stream string | + stream := self streamOnArray. + string := String new. + + stream do: [:value | string := string, ' ', value asString]. + + self assert: string = (' ', 1 asString, ' ', #(a b c) asString, ' ', false asString)! Item was added: + ----- Method: ReadStreamTest>>testSkipTo (in category 'tests - positionning') ----- + testSkipTo + | stream | + stream := self emptyStream. + self deny: (stream skipTo: nil). + + stream := self streamOnArray. + self deny: stream atEnd. + self deny: (stream skipTo: nil). + self assert: stream atEnd. + + stream := self streamOnArray. + self assert: stream peek = 1. + self assert: (stream skipTo: #(a b c)). + self assert: stream peek = false. + self assert: (stream skipTo: false). + self assert: stream atEnd.! Item was added: + ----- Method: ReadStreamTest>>testPosition (in category 'tests - positioning') ----- + testPosition + | stream | + self assert: self emptyStream position isZero. + + stream := self streamOnArray. + self assert: stream position = 0. + stream next. + self assert: stream position = 1. + stream next. + self assert: stream position = 2. + stream next. + self assert: stream position = 3. + stream next. + self assert: stream position = 3. + stream next. + self assert: stream position = 3.! Item was added: + ----- Method: ReadStreamTest>>testOldBack (in category 'tests - back') ----- + testOldBack + "Test the old behavior of the method back. The method #oldBack is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. The method #oldBack considers that the pointer is *on* an element. (Damien Cassou - 1 August 2007)" + |stream| + stream := self streamOn: 'abc'. + stream next: 2. + self assert: stream oldBack = $a.! Item was added: + ----- Method: ReadStreamTest>>testContents (in category 'tests - accessing') ----- + testContents + | stream | + self assert: self emptyStream contents = ''. + + stream := self streamOnArray. + self assert: stream contents = #(1 #(a b c) false). + stream position: 3. + self assert: stream contents = #(1 #(a b c) false). + + stream := self streamOnString. + self assert: stream contents = 'abcde'. + stream setToEnd. + self assert: stream contents = 'abcde'.! Item was added: + ----- Method: ReadStreamTest>>testNexts2 (in category 'tests - accessing') ----- + testNexts2 + + | stream | + stream := self streamOnArray. + self assert: (stream next: 2) = #(1 #(a b c)). + self assert: (stream next: 1) = #(false).! Item was added: + ----- Method: ReadStreamTest>>testOldBackOnPosition1 (in category 'tests - back') ----- + testOldBackOnPosition1 + "Test the old behavior of the method back. The method #oldBack is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. The method #oldBack considers that the pointer is *on* an element. (Damien Cassou - 1 August 2007)" + |stream| + stream := self streamOn: 'abc'. + stream next. + self assert: stream oldBack = nil.! Item was added: + ----- Method: ReadStreamTest>>testNexts (in category 'tests - accessing') ----- + testNexts + self assert: (self emptyStream next: 0) isEmpty. + self assert: (self streamOnArray next: 0) isEmpty. + self assert: (self streamOnArray next: 1) = #(1). + self assert: (self streamOnArray next: 2) = #(1 #(a b c)). + self assert: (self streamOnArray next: 3) = #(1 #(a b c) false).! Item was changed: + ClassTestCase subclass: #ReadStreamTest - TestCase subclass: #ReadStreamTest - uses: TReadStreamTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CollectionsTests-Streams'! !ReadStreamTest commentStamp: 'tlk 12/5/2004 14:36' prior: 0! I am an SUnit test for ReadStream. I have no test fixtures.! - ReadStreamTest class - uses: TReadStreamTest classTrait - instanceVariableNames: ''! Item was added: + ----- Method: ReadStreamTest>>testSetToEnd (in category 'tests - positioning') ----- + testSetToEnd + | stream | + + stream := self emptyStream. + stream setToEnd. + self assert: stream atEnd. + + stream := self streamOnArray. + stream setToEnd. + self assert: stream atEnd. + stream position: 1. + self deny: stream atEnd. + stream setToEnd. + self assert: stream atEnd.! Item was added: + ----- Method: ReadStreamTest>>testSetPosition (in category 'tests - positioning') ----- + testSetPosition + | stream | + + stream := self emptyStream. + self should: [stream position: -2] raise: Error. + self shouldnt: [stream position: 0] raise: Error. + + stream := self streamOnArray. + self should: [stream position: -1] raise: Error. + self shouldnt: [stream position: 0] raise: Error. + self shouldnt: [stream position: 1] raise: Error. + self shouldnt: [stream position: 2] raise: Error. + + "According to ANSI Smalltalk Standard 1.9 Draft, the following should be tested too: + self should: [stream position: 3] raise: Error. + + However, I don't see the point of raising an error when positioning at the end. + + I prefer testing the absence of error: + " + self shouldnt: [stream position: 3] raise: Error. + self should: [stream position: 4] raise: Error.! Item was added: + ----- Method: ReadStreamTest>>testSkipTo2 (in category 'tests - positionning') ----- + testSkipTo2 + | stream | + + stream := self streamOnString. + self assert: (stream skipTo: $b). + self assert: stream peek = $c. + self assert: (stream skipTo: $d). + self assert: stream peek = $e. + self assert: (stream skipTo: $e). + self assert: stream atEnd.! Item was added: + ----- Method: ReadStreamTest>>testBackOnPosition1 (in category 'tests - back') ----- + testBackOnPosition1 + "Test the new implemtation of the method back." + |stream| + stream := self streamOn: 'abc'. + stream next. + self assert: stream back = $a.! Item was added: + ----- Method: ReadStreamTest>>testAtEnd (in category 'tests - testing') ----- + testAtEnd + | stream | + self assert: self emptyStream atEnd. + + stream := self streamOnArray. + self deny: stream atEnd. + stream next: 3. + self assert: stream atEnd.! Item was added: + ----- Method: ReadStreamTest>>testNew (in category 'tests - instance creation') ----- + testNew + self should: [self classUnderTest new] raise: Error.! Item was added: + ----- Method: ReadStreamTest>>testBack (in category 'tests - back') ----- + testBack + "Test the new implemtation of the method back." + |stream| + stream := self streamOn: 'abc'. + stream next: 2. + self assert: stream back = $b.! Item was added: + ----- Method: ReadStreamTest>>testOn (in category 'tests - instance creation') ----- + testOn + self shouldnt: [self streamOn: ' '] raise: Error. + self assert: (self streamOn: ' ') position isZero.! Item was added: + ----- Method: ReadStreamTest>>testBackUpToPatternNotFound1 (in category 'tests - positioning') ----- + testBackUpToPatternNotFound1 + |stream| + stream := ReadStream on: 'abcdabg'. + stream setToEnd. + self deny: (stream backUpTo: 'zz'). + self assert: stream position = 0! Item was added: + ----- Method: ReadStreamTest>>testUpTo2 (in category 'tests - accessing') ----- + testUpTo2 + | returnValue stream | + + stream := self streamOnString. + returnValue := stream upTo: $d. + self assert: returnValue = 'abc'. + self assert: stream peek = $e.! Item was added: + ----- Method: ReadStreamTest>>testPeekFor2 (in category 'tests - testing') ----- + testPeekFor2 + | stream negative number | + + stream := self streamOn: '- 145'. + negative := stream peekFor: $-. + stream peekFor: Character space. + number := stream next: 3. + self assert: negative. + self assert: number = '145'. + + stream := self streamOn: '-145'. + negative := stream peekFor: $-. + stream peekFor: Character space. + number := stream next: 3. + self assert: negative. + self assert: number = '145'. + + stream := self streamOn: ' 145'. + negative := stream peekFor: $-. + stream peekFor: Character space. + number := stream next: 3. + self deny: negative. + self assert: number = '145'. + + stream := self streamOn: '145'. + negative := stream peekFor: $-. + stream peekFor: Character space. + number := stream next: 3. + self deny: negative. + self assert: number = '145'.! Item was added: + ----- Method: ReadStreamTest>>testContents2 (in category 'tests - accessing') ----- + testContents2 + "From ANSI Smalltalk Standard draft 1.9: + + it is unspecified whether or not the returned collection [using #contents] is the same object as the backing store collection. However, if the returned collection is not the same object as the stream backing store collection then the class of the returned collection is the same class as would be returned if the message #select: was sent to the backing store collection." + + "In Squeak, there is #species to know what class should be used on copy, selection..." + | interval stream streamContents | + interval := 1 to: 32. + stream := self streamOn: interval. + streamContents := stream contents. + + (streamContents == interval) + ifFalse: [self assert: streamContents class = Interval new species]! Item was added: + ----- Method: ReadStreamTest>>testPeek (in category 'tests - accessing') ----- + testPeek + | stream | + stream := self streamOnArray. + + self assert: stream peek = 1. + self deny: stream peek = #(a b c). + self deny: stream peek = false. + + stream next. + + self deny: stream peek = 1. + self assert: stream peek = #(a b c). + self deny: stream peek = false. + + stream next. + + self deny: stream peek = 1. + self deny: stream peek = #(a b c). + self assert: stream peek = false. + + stream next. + + "In ANSI Smalltalk Standard Draft, it is said that nil will return nil at the end when using #peek." + self assert: stream peek isNil.! Item was added: + ----- Method: ReadStreamTest>>testPeekFor (in category 'tests - testing') ----- + testPeekFor + | stream | + + stream := self streamOnArray. + self assert: (stream peekFor: 1). + self assert: (stream peekFor: #(a b c)). + self assert: (stream peekFor: false). + + stream := self streamOnArray. + self deny: (stream peekFor: #(a b c)). + self deny: (stream peekFor: false). + self assert: (stream peekFor: 1). + + self deny: (stream peekFor: 1). + self deny: (stream peekFor: false). + self assert: (stream peekFor: #(a b c)). + + self deny: (stream peekFor: 1). + self deny: (stream peekFor: #(a b c)). + self assert: (stream peekFor: false). + + self assert: (stream atEnd). + self deny: (stream peekFor: nil). + self deny: (stream peekFor: 1). + self deny: (stream peekFor: #(a b c)). + self deny: (stream peekFor: false).! Item was removed: - ----- Method: TGettableStreamTest>>testPeek (in category 'tests - accessing') ----- - testPeek - | stream | - stream := self streamOnArray. - - self assert: stream peek = 1. - self deny: stream peek = #(a b c). - self deny: stream peek = false. - - stream next. - - self deny: stream peek = 1. - self assert: stream peek = #(a b c). - self deny: stream peek = false. - - stream next. - - self deny: stream peek = 1. - self deny: stream peek = #(a b c). - self assert: stream peek = false. - - stream next. - - "In ANSI Smalltalk Standard Draft, it is said that nil will return nil at the end when using #peek." - self assert: stream peek isNil.! Item was removed: - ----- Method: TGettableStreamTest>>testPeekFor (in category 'tests - testing') ----- - testPeekFor - | stream | - - stream := self streamOnArray. - self assert: (stream peekFor: 1). - self assert: (stream peekFor: #(a b c)). - self assert: (stream peekFor: false). - - stream := self streamOnArray. - self deny: (stream peekFor: #(a b c)). - self deny: (stream peekFor: false). - self assert: (stream peekFor: 1). - - self deny: (stream peekFor: 1). - self deny: (stream peekFor: false). - self assert: (stream peekFor: #(a b c)). - - self deny: (stream peekFor: 1). - self deny: (stream peekFor: #(a b c)). - self assert: (stream peekFor: false). - - self assert: (stream atEnd). - self deny: (stream peekFor: nil). - self deny: (stream peekFor: 1). - self deny: (stream peekFor: #(a b c)). - self deny: (stream peekFor: false).! Item was removed: - ----- Method: TGettableStreamTest>>testUpTo (in category 'tests - accessing') ----- - testUpTo - | returnValue stream | - returnValue := (self emptyStream upTo: nil). - self assert: returnValue isCollection. - self assert: returnValue isEmpty. - - stream := self streamOnArray. - returnValue := stream upTo: #(a b c). - self assert: returnValue = #(1). - self assert: stream peek = false. - - stream := self streamOnArray. - returnValue := stream upTo: true. - self assert: returnValue = #(1 #(a b c) false). - self assert: stream atEnd.! Item was removed: - ----- Method: TStreamTest>>classUnderTest (in category 'accessing') ----- - classUnderTest - self explicitRequirement! Item was removed: - Trait named: #TReadStreamTest - uses: TGettableStreamTest + TSequencedStreamTest - category: 'CollectionsTests-Streams'! Item was removed: - TReadStreamTest classTrait - uses: TGettableStreamTest classTrait + TSequencedStreamTest classTrait! Item was removed: - Trait named: #TGettableStreamTest - uses: TStreamTest - category: 'CollectionsTests-Streams'! Item was removed: - ----- Method: TStreamTest>>emptyStream (in category 'accessing - defaults') ----- - emptyStream - ^ self streamOn: String new! Item was removed: - ----- Method: TPuttableStreamTest>>testNextPutAllReplacing (in category 'tests - accessing') ----- - testNextPutAllReplacing - | stream | - stream := self streamOnString. - stream reset. - self shouldnt: [ - stream - nextPutAll: 'abc'. - ] raise: Error.! Item was removed: - ----- Method: TReadStreamTest>>testNew (in category 'tests - instance creation') ----- - testNew - self should: [self classUnderTest new] raise: Error.! Item was removed: - ----- Method: TGettableStreamTest>>testPeek2 (in category 'tests - accessing') ----- - testPeek2 - | stream | - stream := self streamOn: #(nil nil nil). - - self assert: stream peek isNil. - stream next. - self assert: stream peek isNil. - stream next. - self assert: stream peek isNil. - stream next. - - "Yes, #peek answers nil when there is no more element to read." - self assert: stream peek isNil.! Item was removed: - ----- Method: TGettableStreamTest>>testNext (in category 'tests - accessing') ----- - testNext - |stream| - - stream := self streamOnArray. - self assert: stream next = 1. - self assert: stream next = #(a b c). - self assert: stream next = false. - - stream := self streamOnString. - self assert: stream next = $a. - self assert: stream next = $b. - self assert: stream next = $c. - self assert: stream next = $d. - self assert: stream next = $e. - ! Item was removed: - ----- Method: TGettableStreamTest>>testNextMatchFor (in category 'tests - testing') ----- - testNextMatchFor - | stream | - stream := self streamOnArray. - self assert: (stream nextMatchFor: 1). - self assert: (stream nextMatchFor: #(a b c)). - self assert: (stream nextMatchFor: false). - - stream := self streamOnArray. - self deny: (stream nextMatchFor: false). - self assert: (stream nextMatchFor: #(a b c)). - self assert: (stream nextMatchFor: false). - ! Item was removed: - Trait named: #TWriteStreamTest - uses: TPuttableStreamTest + TSequencedStreamTest - category: 'CollectionsTests-Streams'! Item was removed: - ----- Method: TReadStreamTest>>testOn (in category 'tests - instance creation') ----- - testOn - self shouldnt: [self streamOn: ' '] raise: Error. - self assert: (self streamOn: ' ') position isZero.! Item was removed: - ----- Method: TGettableStreamTest>>testOldBack (in category 'tests - back') ----- - testOldBack - "Test the old behavior of the method back. The method #oldBack is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. The method #oldBack considers that the pointer is *on* an element. (Damien Cassou - 1 August 2007)" - |stream| - stream := self streamOn: 'abc'. - stream next: 2. - self assert: stream oldBack = $a.! Item was removed: - ----- Method: TGettableStreamTest>>testDo (in category 'tests - enumerating') ----- - testDo - self emptyStream do: [:value | self fail]! Item was removed: - ----- Method: TPuttableStreamTest>>testNextPutAllAppending (in category 'tests - accessing') ----- - testNextPutAllAppending - | stream | - stream := self emptyStream. - self shouldnt: [ - stream - nextPutAll: 'abc'. - ] raise: Error.! Item was removed: - ----- Method: TSequencedStreamTest>>testBackUpToPatternNotFound1 (in category 'tests - positioning') ----- - testBackUpToPatternNotFound1 - |stream| - stream := ReadStream on: 'abcdabg'. - stream setToEnd. - self deny: (stream backUpTo: 'zz'). - self assert: stream position = 0! Item was removed: - ----- Method: TGettableStreamTest>>testDo2 (in category 'tests - enumerating') ----- - testDo2 - | stream string | - stream := self streamOnArray. - string := String new. - - stream do: [:value | string := string, ' ', value asString]. - - self assert: string = (' ', 1 asString, ' ', #(a b c) asString, ' ', false asString)! Item was removed: - ----- Method: TReadStreamTest>>testContents2 (in category 'tests - accessing') ----- - testContents2 - "From ANSI Smalltalk Standard draft 1.9: - - it is unspecified whether or not the returned collection [using #contents] is the same object as the backing store collection. However, if the returned collection is not the same object as the stream backing store collection then the class of the returned collection is the same class as would be returned if the message #select: was sent to the backing store collection." - - "In Squeak, there is #species to know what class should be used on copy, selection..." - | interval stream streamContents | - interval := 1 to: 32. - stream := self streamOn: interval. - streamContents := stream contents. - - (streamContents == interval) - ifFalse: [self assert: streamContents class = Interval new species]! Item was removed: - ----- Method: TGettableStreamTest>>testSkipTo (in category 'tests - positionning') ----- - testSkipTo - | stream | - stream := self emptyStream. - self deny: (stream skipTo: nil). - - stream := self streamOnArray. - self deny: stream atEnd. - self deny: (stream skipTo: nil). - self assert: stream atEnd. - - stream := self streamOnArray. - self assert: stream peek = 1. - self assert: (stream skipTo: #(a b c)). - self assert: stream peek = false. - self assert: (stream skipTo: false). - self assert: stream atEnd.! Item was removed: - TGettableStreamTest classTrait - uses: TStreamTest classTrait! Item was removed: - ----- Method: TGettableStreamTest>>testNexts2 (in category 'tests - accessing') ----- - testNexts2 - - | stream | - stream := self streamOnArray. - self assert: (stream next: 2) = #(1 #(a b c)). - self assert: (stream next: 1) = #(false).! Item was removed: - ----- Method: TGettableStreamTest>>testOldBackOnPosition1 (in category 'tests - back') ----- - testOldBackOnPosition1 - "Test the old behavior of the method back. The method #oldBack is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. The method #oldBack considers that the pointer is *on* an element. (Damien Cassou - 1 August 2007)" - |stream| - stream := self streamOn: 'abc'. - stream next. - self assert: stream oldBack = nil.! Item was removed: - ----- Method: TGettableStreamTest>>testNexts (in category 'tests - accessing') ----- - testNexts - self assert: (self emptyStream next: 0) isEmpty. - self assert: (self streamOnArray next: 0) isEmpty. - self assert: (self streamOnArray next: 1) = #(1). - self assert: (self streamOnArray next: 2) = #(1 #(a b c)). - self assert: (self streamOnArray next: 3) = #(1 #(a b c) false).! Item was removed: - ----- Method: TStreamTest>>streamOnString (in category 'accessing - defaults') ----- - streamOnString - ^ self streamOn: 'abcde'! Item was removed: - ----- Method: TSequencedStreamTest>>testBackUpToEmptyPattern1 (in category 'tests - positioning') ----- - testBackUpToEmptyPattern1 - "This test represents the current behavior which is not clearly defined and could be revised." - |stream| - stream := ReadStream on: 'abcdabg'. - stream setToEnd. - self should: [stream backUpTo: ''] raise: Error.! Item was removed: - TPuttableStreamTest classTrait - uses: TStreamTest classTrait! Item was removed: - ----- Method: TStreamTest>>streamOn: (in category 'helpers') ----- - streamOn: aCollection - ^ self classUnderTest on: aCollection! Item was removed: - ----- Method: TStreamTest>>streamOnArray (in category 'accessing - defaults') ----- - streamOnArray - ^ self streamOn: (Array with: 1 with: #(a b c) with: false)! Item was removed: - ----- Method: TSequencedStreamTest>>testReset (in category 'tests - positioning') ----- - testReset - | stream | - - stream := self emptyStream. - stream reset. - self assert: stream position = 0. - - stream := self streamOnArray. - stream reset. - self assert: stream position = 0. - self deny: stream atEnd. - stream position: 3. - self assert: stream atEnd. - stream reset. - self assert: stream position = 0.! Item was removed: - ----- Method: TGettableStreamTest>>testSkipTo2 (in category 'tests - positionning') ----- - testSkipTo2 - | stream | - - stream := self streamOnString. - self assert: (stream skipTo: $b). - self assert: stream peek = $c. - self assert: (stream skipTo: $d). - self assert: stream peek = $e. - self assert: (stream skipTo: $e). - self assert: stream atEnd.! Item was removed: - TSequencedStreamTest classTrait - uses: TStreamTest classTrait! Item was removed: - TWriteStreamTest classTrait - uses: TSequencedStreamTest classTrait + TPuttableStreamTest classTrait! Item was removed: - ----- Method: TPuttableStreamTest>>testNextPutReplacing (in category 'tests - accessing') ----- - testNextPutReplacing - | stream | - stream := self streamOnArray. - stream reset. - self shouldnt: [ - stream - nextPut: $a; - nextPut: $b; - nextPut: $c. - ] raise: Error.! Item was removed: - ----- Method: TGettableStreamTest>>testBackOnPosition1 (in category 'tests - back') ----- - testBackOnPosition1 - "Test the new implemtation of the method back." - |stream| - stream := self streamOn: 'abc'. - stream next. - self assert: stream back = $a.! Item was removed: - ----- Method: TSequencedStreamTest>>testBackUpTo1 (in category 'tests - positioning') ----- - testBackUpTo1 - |stream| - stream := ReadStream on: 'abcdabg'. - stream setToEnd. - self assert: (stream backUpTo: 'ab'). - self assert: stream peek = $g! Item was removed: - ----- Method: TGettableStreamTest>>testAtEnd (in category 'tests - testing') ----- - testAtEnd - | stream | - self assert: self emptyStream atEnd. - - stream := self streamOnArray. - self deny: stream atEnd. - stream next: 3. - self assert: stream atEnd.! Item was removed: - ----- Method: TReadStreamTest>>testPosition (in category 'tests - positioning') ----- - testPosition - | stream | - self assert: self emptyStream position isZero. - - stream := self streamOnArray. - self assert: stream position = 0. - stream next. - self assert: stream position = 1. - stream next. - self assert: stream position = 2. - stream next. - self assert: stream position = 3. - stream next. - self assert: stream position = 3. - stream next. - self assert: stream position = 3.! Item was removed: - Trait named: #TStreamTest - uses: {} - category: 'CollectionsTests-Streams'! Item was removed: - ----- Method: TSequencedStreamTest>>testContents (in category 'tests - accessing') ----- - testContents - | stream | - self assert: self emptyStream contents = ''. - - stream := self streamOnArray. - self assert: stream contents = #(1 #(a b c) false). - stream position: 3. - self assert: stream contents = #(1 #(a b c) false). - - stream := self streamOnString. - self assert: stream contents = 'abcde'. - stream setToEnd. - self assert: stream contents = 'abcde'.! Item was removed: - ----- Method: TGettableStreamTest>>testBack (in category 'tests - back') ----- - testBack - "Test the new implemtation of the method back." - |stream| - stream := self streamOn: 'abc'. - stream next: 2. - self assert: stream back = $b.! Item was removed: - Trait named: #TPuttableStreamTest - uses: TStreamTest - category: 'CollectionsTests-Streams'! Item was removed: - ----- Method: TPuttableStreamTest>>testNextPutAppending (in category 'tests - accessing') ----- - testNextPutAppending - | stream | - stream := self emptyStream. - self shouldnt: [ - stream - nextPut: $a; - nextPut: $b; - nextPut: $c. - ] raise: Error.! Item was removed: - ----- Method: TSequencedStreamTest>>testSetToEnd (in category 'tests - positioning') ----- - testSetToEnd - | stream | - - stream := self emptyStream. - stream setToEnd. - self assert: stream atEnd. - - stream := self streamOnArray. - stream setToEnd. - self assert: stream atEnd. - stream position: 1. - self deny: stream atEnd. - stream setToEnd. - self assert: stream atEnd.! Item was removed: - ----- Method: TSequencedStreamTest>>testSetPosition (in category 'tests - positioning') ----- - testSetPosition - | stream | - - stream := self emptyStream. - self should: [stream position: -2] raise: Error. - self shouldnt: [stream position: 0] raise: Error. - - stream := self streamOnArray. - self should: [stream position: -1] raise: Error. - self shouldnt: [stream position: 0] raise: Error. - self shouldnt: [stream position: 1] raise: Error. - self shouldnt: [stream position: 2] raise: Error. - - "According to ANSI Smalltalk Standard 1.9 Draft, the following should be tested too: - self should: [stream position: 3] raise: Error. - - However, I don't see the point of raising an error when positioning at the end. - - I prefer testing the absence of error: - " - self shouldnt: [stream position: 3] raise: Error. - self should: [stream position: 4] raise: Error.! Item was removed: - Trait named: #TSequencedStreamTest - uses: TStreamTest - category: 'CollectionsTests-Streams'! Item was removed: - ----- Method: TGettableStreamTest>>testUpTo2 (in category 'tests - accessing') ----- - testUpTo2 - | returnValue stream | - - stream := self streamOnString. - returnValue := stream upTo: $d. - self assert: returnValue = 'abc'. - self assert: stream peek = $e.! Item was removed: - ----- Method: TGettableStreamTest>>testPeekFor2 (in category 'tests - testing') ----- - testPeekFor2 - | stream negative number | - - stream := self streamOn: '- 145'. - negative := stream peekFor: $-. - stream peekFor: Character space. - number := stream next: 3. - self assert: negative. - self assert: number = '145'. - - stream := self streamOn: '-145'. - negative := stream peekFor: $-. - stream peekFor: Character space. - number := stream next: 3. - self assert: negative. - self assert: number = '145'. - - stream := self streamOn: ' 145'. - negative := stream peekFor: $-. - stream peekFor: Character space. - number := stream next: 3. - self deny: negative. - self assert: number = '145'. - - stream := self streamOn: '145'. - negative := stream peekFor: $-. - stream peekFor: Character space. - number := stream next: 3. - self deny: negative. - self assert: number = '145'.!

1 0

Fix for #7462: in sq 8948 (and before) pane spliters show themselves and are active even when window is collapsed
by Balázs Kósi 02 Feb '10

02 Feb '10

Hi, I uploaded Morphic-kb.316 to The Inbox to fix http://bugs.squeak.org/view.php?id=7462 The fix adds a check to SystemWindow >> activate, to avoid sending #addPaneSplitters if the window isCollapsed. Balázs

1 0

The Trunk: CollectionsTests-ar.138.mcz
by commits＠source.squeak.org 02 Feb '10

02 Feb '10

1 0

Re: [Pharo-project] [squeak-dev] Curl plugin problems
by Lukas Renggli 02 Feb '10

02 Feb '10

The curl plugin works very well and is very fast for the parts that it is supposed to work on. The problem is, that it does not provide a complete API to all the functionality of libcurl. For example, it is impossible to perform more sophisticated operations on protocols other than HTTP (like FTP). Worst of all, there is no way to work around this, because the plugin provides no direct access to the few low-level functions of libcurl (like curl_easy_setopt). Instead it wraps many (but by large not all) possible parameter combinations into an army of rigid primitives :-( I guess I'll to wait for CurlAlien to come alive. Lukas On 1 February 2010 19:21, John M McIntosh <johnmci(a)smalltalkconsulting.com> wrote: >> The Mac CurlPlugin in mac vm is generated at the moment from an older >> version. It is missing functions to add http headers (e.g. to >> authenticate against GData ClientLogin) . > > So is that part fixed now? > > On 2010-02-01, at 4:38 AM, Schmidt, Marco wrote: > >> I began working on an Alien-Curl-Wrapper too. The main problem (for me) was the missing Alien support under WIN32/LINUX. Without Alien support it is easier to use the current CurlPlugin (with the changes to add header fields to the http requests). A long time ago I requested the integration of these changes in the squeak-vm list (see http://n4.nabble.com/CurlPlugin-23-under-Linux-td276117.html#a276117)... >> >> Marco Schmidt > > -- > =========================================================================== > John M. McIntosh <johnmci(a)smalltalkconsulting.com> Twitter: squeaker68882 > Corporate Smalltalk Consulting Ltd. http://www.smalltalkconsulting.com > =========================================================================== > > > > > > _______________________________________________ > Pharo-project mailing list > Pharo-project(a)lists.gforge.inria.fr > http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project > -- Lukas Renggli http://www.lukas-renggli.ch

2 2

Jump to page: