Squeak-dev December 2018

squeak-dev@lists.squeakfoundation.org

30 participants
115 discussions

Squeak/Software Freedom Conservancy needs donations
by tim Rowledge 05 Dec '18

05 Dec '18

As everyone may already know, we (as in Squeak) are members of the Software Freedom Conservancy (sfconservancy.org) as a way to have a legal existence and so on. Every now and then they try to raise some money to keep operating, and right now they have a big donation matching effort in progress. Please consider tossing a few dollars, euros, yen or what have you their way. tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim We can rescue a hostage or bankrupt a system. Now, what would you like us to do?

2 2

The Inbox: CollectionsTests-ul.297.mcz
by commits＠source.squeak.org 05 Dec '18

05 Dec '18

Levente Uzonyi uploaded a new version of CollectionsTests to project The Inbox: http://source.squeak.org/inbox/CollectionsTests-ul.297.mcz ==================== Summary ==================== Name: CollectionsTests-ul.297 Author: ul Time: 5 December 2018, 7:09:15.652659 pm UUID: d9e8623a-138b-48b5-becd-a18225a4eb4d Ancestors: CollectionsTests-cbc.296 Added tests for OrderedSet forged from SetTest and OrderedDictionaryTest. =============== Diff against CollectionsTests-cbc.296 =============== Item was added: + ClassTestCase subclass: #OrderedSetTest + instanceVariableNames: 'full empty' + classVariableNames: '' + poolDictionaries: '' + category: 'CollectionsTests-Unordered'! + + !OrderedSetTest commentStamp: '<historical>' prior: 0! + This is the unit test for the class Set. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: + - http://www.c2.com/cgi/wiki?UnitTest + - http://minnow.cc.gatech.edu/squeak/1547 + - the sunit class category! Item was added: + ----- Method: OrderedSetTest>>setUp (in category 'running') ----- + setUp + empty := OrderedSet new. + full := OrderedSet with: 5 with: #abc! Item was added: + ----- Method: OrderedSetTest>>tearDown (in category 'running') ----- + tearDown + "I am called whenever your test ends. + I am the place where you release the ressources"! Item was added: + ----- Method: OrderedSetTest>>testAdd (in category 'Sunit original tests') ----- + testAdd + empty add: 5. + self assert: (empty includes: 5).! Item was added: + ----- Method: OrderedSetTest>>testAddWithOccurences (in category 'tests') ----- + testAddWithOccurences + + empty add: 2 withOccurrences: 3. + self assert: (empty includes: 2). + self assert: ((empty occurrencesOf: 2) = 1).! Item was added: + ----- Method: OrderedSetTest>>testAsSet (in category 'tests') ----- + testAsSet + "could be moved in Array or Collection" + + | newFull | + newFull := #(#abc 5) as: OrderedSet. + newFull add: 5. + self assert: (newFull = full).! Item was added: + ----- Method: OrderedSetTest>>testAtIndex (in category 'tests - accessing') ----- + testAtIndex + + 1 to: 10 do: [:ea | + empty add: ea]. + + 1 to: 10 do: [:index | + self assert: index equals: (empty atIndex: index)].! Item was added: + ----- Method: OrderedSetTest>>testAtRandom (in category 'tests') ----- + testAtRandom + | rand | + rand := Random new. + full add: 3. + full add: 2. + full add: 4. + full add: 1. + self assert: (full includes: (full atRandom: rand)). + ! Item was added: + ----- Method: OrderedSetTest>>testCollectAs (in category 'tests') ----- + testCollectAs + | newFull result | + newFull := OrderedSet withAll: (1 to: 10). + result := newFull collect: [:each | each >= 1 ifTrue: [each] ifFalse: ['no']] as: OrderedSet. + self assert: (result = newFull). + result := newFull collect: [:each | each >= 5 ifTrue: [each] ifFalse: ['no']] as: OrderedSet. + self assert: (result = ((OrderedSet withAll: (5 to: 10)) add: 'no'; yourself)).! Item was added: + ----- Method: OrderedSetTest>>testCompact (in category 'tests') ----- + testCompact + "Eager compacting on removal." + + 1 to: 3 do: [:ea | empty add: ea]. + empty remove: 2. + self assert: 2 equals: (empty instVarNamed: #order) size.! Item was added: + ----- Method: OrderedSetTest>>testCopy (in category 'tests - copying') ----- + testCopy + | newFull | + full add: 3. + full add: 2. + newFull := full copy. + self assert: (full size = newFull size). + self assert: ((full select: [:each | (newFull includes: each) not]) isEmpty). + self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty).! Item was added: + ----- Method: OrderedSetTest>>testCopy2 (in category 'tests - copying') ----- + testCopy2 + + empty + add: 1; + add: 2; + add: 3. + + empty copy in: [:copy | + self assert: empty equals: copy. + copy add: 4. + self assert: empty size < copy size]! Item was added: + ----- Method: OrderedSetTest>>testCopyFirst (in category 'tests - accessing') ----- + testCopyFirst + + 1 to: 10 do: [:ea | + empty add: ea]. + + self assert: (1 to: 5) asArray equals: (empty first: 5) asArray.! Item was added: + ----- Method: OrderedSetTest>>testCopyFromTo (in category 'tests - copying') ----- + testCopyFromTo + + 1 to: 10 do: [:index | + empty add: index]. + + (empty copyFrom: 3 to: 5) in: [:copy | + self assert: (3 to: 5) asArray equals: copy asArray. + self assert: 3 equals: copy removeFirst. + self + deny: (copy includes: 3); + assert: (empty includes: 3) ]! Item was added: + ----- Method: OrderedSetTest>>testCopyLast (in category 'tests - accessing') ----- + testCopyLast + + 1 to: 10 do: [:ea | + empty add: ea]. + + self assert: (6 to: 10) asArray equals: (empty last: 5) asArray.! Item was added: + ----- Method: OrderedSetTest>>testCopyWithout (in category 'tests') ----- + testCopyWithout + | newFull | + full add: 3. + full add: 2. + newFull := full copyWithout: 3. + self assert: (newFull size = (full size - 1)). + self deny: (newFull includes: 3). + self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty). + self assert: ((full select: [:each | (newFull includes: each) not]) = (OrderedSet with: 3)). + ! Item was added: + ----- Method: OrderedSetTest>>testDo (in category 'tests') ----- + testDo + | newFull result | + newFull := OrderedSet withAll: (1 to: 5). + result := 0. + newFull do: [:each | result := (result + each)]. + self assert: (result = 15).! Item was added: + ----- Method: OrderedSetTest>>testFirst (in category 'tests - accessing') ----- + testFirst + + 1 to: 10 do: [:ea | + empty add: ea]. + + #(first second third fourth fifth sixth seventh eighth ninth last) withIndexDo: [:selector :index | + self assert: index equals: (empty perform: selector) ].! Item was added: + ----- Method: OrderedSetTest>>testGrow (in category 'Sunit original tests') ----- + testGrow + empty addAll: (1 to: 100). + self assert: (empty size = 100). + ! Item was added: + ----- Method: OrderedSetTest>>testIfAbsentAdd (in category 'Sunit original tests') ----- + testIfAbsentAdd + | it | + it := 5. + self deny: (empty includes: it). + self assert: (empty ifAbsentAdd: it). + self assert: (empty includes: it). + self deny: (empty ifAbsentAdd: it). + self assert: (empty includes: it)! Item was added: + ----- Method: OrderedSetTest>>testIllegal (in category 'Sunit original tests') ----- + testIllegal + self + should: [empty at: 5] raise: TestResult error. + self + should: [empty at: 5 put: #abc] raise: TestResult error. + ! Item was added: + ----- Method: OrderedSetTest>>testIncludes (in category 'Sunit original tests') ----- + testIncludes + self assert: (full includes: 5). + self assert: (full includes: #abc). + self deny: (full includes: 3). + ! Item was added: + ----- Method: OrderedSetTest>>testIntersection (in category 'tests') ----- + testIntersection + | newFull col | + full add: 3; add: 2. + col := full intersection: full. + self assert: (full = col). + + newFull := OrderedSet with: 8 with: 9 with: #z. + col := newFull intersection: full. + self assert: (col isEmpty). + + newFull add: 5; add: #abc; add: 7. + col := newFull intersection: full. + self assert: ((full select: [:each | (newFull includes: each)]) = col). + + + ! Item was added: + ----- Method: OrderedSetTest>>testIsSorted (in category 'tests - sorting') ----- + testIsSorted + + 10 to: 1 by: -1 do: [:ea | + empty add: ea]. + + self deny: empty isSorted. + empty sort. + self assert: empty isSorted! Item was added: + ----- Method: OrderedSetTest>>testLike (in category 'tests') ----- + testLike + self assert: ((full like: 5) = 5). + self assert: ((full like: 8) isNil).! Item was added: + ----- Method: OrderedSetTest>>testOccurrences (in category 'Sunit original tests') ----- + testOccurrences + self assert: ((empty occurrencesOf: 0) = 0). + self assert: ((full occurrencesOf: 5) = 1). + full add: 5. + self assert: ((full occurrencesOf: 5) = 1).! Item was added: + ----- Method: OrderedSetTest>>testOrder (in category 'tests') ----- + testOrder + "We use integers as keys to match hash values." + + | set | + set := Set new. + + 1 to: 10 do: [:ea | + set add: ea. + empty add: ea]. + + self assert: set asArray = empty asArray. + + set remove: 5. + empty remove: 5. + + self assert: set asArray = empty asArray. + + set add: 5. + empty add: 5. + + self + assert: set asArray ~= empty asArray; + assert: #(1 2 3 4 6 7 8 9 10 5) equals: empty asArray; + assert: #(1 2 3 4 5 6 7 8 9 10) equals: set asArray.! Item was added: + ----- Method: OrderedSetTest>>testOverflow (in category 'tests') ----- + testOverflow + "Check whether repeated additions of the same alternating keys causes an error." + + self + shouldnt: [20 timesRepeat: [empty add: 1; remove: 1]] + raise: Error. ! Item was added: + ----- Method: OrderedSetTest>>testOverwriteValue (in category 'tests') ----- + testOverwriteValue + "First write wins wrt. order in the dictionary." + + 1 to: 5 do: [:ea | + empty add: ea]. + + empty add: 3. + + self assert: #(1 2 3 4 5) equals: empty asArray! Item was added: + ----- Method: OrderedSetTest>>testRemove (in category 'Sunit original tests') ----- + testRemove + full remove: 5. + self assert: (full includes: #abc). + self deny: (full includes: 5).! Item was added: + ----- Method: OrderedSetTest>>testRemoveAll (in category 'tests') ----- + testRemoveAll + "Allows one to remove all elements of a collection" + + | c1 c2 s2 | + c1 := full. + c2 := c1 copy. + s2 := c2 size. + + c1 removeAll. + + self assert: c1 size = 0. + self assert: c2 size = s2 description: 'the copy has not been modified'.! Item was added: + ----- Method: OrderedSetTest>>testRemoveIfAbsent (in category 'tests') ----- + testRemoveIfAbsent + | result1 result2 | + result1 := true. + result2 := true. + full remove: 8 ifAbsent: [ result1 := false ]. + self assert: (result1 = false). + full remove: 5 ifAbsent: [ result2 := false ]. + self assert: (result2 = true). + + + ! Item was added: + ----- Method: OrderedSetTest>>testSize (in category 'tests') ----- + testSize + self assert: (empty size = 0). + self assert: (full size = 2). + empty add: 2. + empty add: 1. + full add: 2. + self assert: (empty size = 2). + self assert: (full size = 3). + empty remove: 2. + self assert: (empty size = 1).! Item was added: + ----- Method: OrderedSetTest>>testSort (in category 'tests - sorting') ----- + testSort + + 10 to: 1 by: -1 do: [:ea | + empty add: ea]. + + self assert: (10 to: 1 by: -1) asArray equals: empty asArray. + empty sort. + self assert: (1 to: 10) asArray equals: empty asArray.! Item was added: + ----- Method: OrderedSetTest>>testSortCustom (in category 'tests - sorting') ----- + testSortCustom + + | values | + values := #(The quick brown fox jumps over the lazy dog). + 1 to: 9 do: [:ea | + empty add: (values at: ea)]. + empty sort: [:a1 :a2 | a1 value <= a2 value]. + self assert: values sorted equals: empty asArray! Item was added: + ----- Method: OrderedSetTest>>testSorted (in category 'tests - sorting') ----- + testSorted + + 10 to: 1 by: -1 do: [:ea | + empty add: ea]. + + empty sorted in: [:copy | + self + assert: copy ~~ empty; + assert: copy asArray = empty asArray reversed].! Item was added: + ----- Method: OrderedSetTest>>testUnion (in category 'tests') ----- + testUnion + | newFull col newCol | + full add: 3. + full add: 2. + col := full union: full. + self assert: (full = col). + + newFull := OrderedSet with: 8 with: 9 with: #z. + col := newFull union: full. + self assert: (col size = (full size + newFull size)). + self assert: ((col select: [:each | (full includes: each) not]) = newFull). + self assert: ((col select: [:each | (newFull includes: each) not]) = full). + + full add: 9. + col := newFull union: full. + newCol := newFull copy. + newCol remove: 9. + self assert: (col size = (full size + newFull size - 1)). + self assert: ((col select: [:each | (full includes: each) not]) = newCol). + newCol := full copy. + newCol remove: 9. + self assert: ((col select: [:each | (newFull includes: each) not]) = newCol). + + + ! Item was added: + ----- Method: SetWithNilTest>>testOrderedSetWithNil (in category 'tests') ----- + testOrderedSetWithNil + self runSetWithNilTestOf: [OrderedSet new]!

1 0

The Inbox: Collections-ul.812.mcz
by commits＠source.squeak.org 05 Dec '18

05 Dec '18

Levente Uzonyi uploaded a new version of Collections to project The Inbox: http://source.squeak.org/inbox/Collections-ul.812.mcz ==================== Summary ==================== Name: Collections-ul.812 Author: ul Time: 5 December 2018, 7:11:14.545451 pm UUID: b76e2bfa-1510-4380-8ce6-421c08623ce6 Ancestors: Collections-eem.811 Simple OrderedSet based on OrderedDictionary's implementation, but the order instance variable is an OrderedCollection, which simplifies a few things and makes #removeFirst and #removeLast O(1) (amortized). =============== Diff against Collections-eem.811 =============== Item was added: + Set subclass: #OrderedSet + instanceVariableNames: 'order' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Sequenceable'! + + !OrderedSet commentStamp: 'ul 12/4/2018 23:48' prior: 0! + I am an ordered set. I have an additional index (called 'order') to keep track of the insertion order of my objects. + + Access and insertion time is not affected by the additional index. + + Removal takes O(n) time in general, but it is O(1) to remove the first and last elements via #removeFirst and #removeLast, respectively.! Item was added: + ----- Method: OrderedSet>>atIndex: (in category 'accessing') ----- + atIndex: integer + + ^order at: integer! Item was added: + ----- Method: OrderedSet>>atIndex:ifAbsent: (in category 'accessing') ----- + atIndex: integer ifAbsent: exceptionBlock + "As we are sequenceable, provide index-based access." + + ^order at: integer ifAbsent: exceptionBlock! Item was added: + ----- Method: OrderedSet>>atNewIndex:put: (in category 'private') ----- + atNewIndex: index put: setElement + + super atNewIndex: index put: setElement. + order addLast: setElement enclosedSetElement + ! Item was added: + ----- Method: OrderedSet>>copyFrom:to: (in category 'copying') ----- + copyFrom: startIndex to: endIndex + "Answer a copy of the receiver that contains elements from position + startIndex to endIndex." + + ^ self shallowCopy postCopyFrom: startIndex to: endIndex! Item was added: + ----- Method: OrderedSet>>do: (in category 'enumerating') ----- + do: aBlock + "Iterate over the order instead of the internal array." + + order do: aBlock! Item was added: + ----- Method: OrderedSet>>eighth (in category 'accessing') ----- + eighth + + ^order eighth! Item was added: + ----- Method: OrderedSet>>fifth (in category 'accessing') ----- + fifth + + ^order fifth! Item was added: + ----- Method: OrderedSet>>first (in category 'accessing') ----- + first + "Answer the first element of the receiver" + + ^order first! Item was added: + ----- Method: OrderedSet>>first: (in category 'accessing') ----- + first: n + "Answer the first n elements of the receiver. + Raise an error if there are not enough elements." + + ^ self copyFrom: 1 to: n! Item was added: + ----- Method: OrderedSet>>fourth (in category 'accessing') ----- + fourth + + ^order fourth! Item was added: + ----- Method: OrderedSet>>initialize: (in category 'private') ----- + initialize: n + + super initialize: n. + order := OrderedCollection new: n! Item was added: + ----- Method: OrderedSet>>isSorted (in category 'sorting') ----- + isSorted + "Return true if the receiver is sorted by #<=." + + ^order isSorted! Item was added: + ----- Method: OrderedSet>>last (in category 'accessing') ----- + last + "Answer the last element of the receiver" + + ^order last! Item was added: + ----- Method: OrderedSet>>last: (in category 'accessing') ----- + last: n + "Answer the last n elements of the receiver. + Raise an error if there are not enough elements." + + ^ self copyFrom: tally - n + 1 to: tally! Item was added: + ----- Method: OrderedSet>>ninth (in category 'accessing') ----- + ninth + "Answer the ninth element of the receiver. + Raise an error if there are not enough elements." + + ^ self atIndex: 9! Item was added: + ----- Method: OrderedSet>>postCopy (in category 'copying') ----- + postCopy + + super postCopy. + order := order copy! Item was added: + ----- Method: OrderedSet>>postCopyFrom:to: (in category 'copying') ----- + postCopyFrom: startIndex to: endIndex + "Adapted from SequenceableCollection and OrderedCollection." + + tally := endIndex - startIndex + 1. + array := self class arrayType + new: (self class goodPrimeAtLeast: tally * 4 // 3). "fill up to ~75%" + order := order copyFrom: startIndex to: endIndex. + order do: [ :element | "TODO: do we need #enclosedSetElement?" + array at: (self scanFor: element) put: element]. + + ! Item was added: + ----- Method: OrderedSet>>remove:ifAbsent: (in category 'removing') ----- + remove: anObject ifAbsent: aBlock + + ^order remove: (super remove: anObject ifAbsent: [ ^aBlock value ])! Item was added: + ----- Method: OrderedSet>>removeFirst (in category 'removing') ----- + removeFirst + + ^super remove: order removeFirst ifAbsent: nil! Item was added: + ----- Method: OrderedSet>>removeLast (in category 'removing') ----- + removeLast + + ^super remove: order removeLast ifAbsent: nil! Item was added: + ----- Method: OrderedSet>>second (in category 'accessing') ----- + second + + ^order second! Item was added: + ----- Method: OrderedSet>>seventh (in category 'accessing') ----- + seventh + + ^order seventh! Item was added: + ----- Method: OrderedSet>>sixth (in category 'accessing') ----- + sixth + + ^order sixth! Item was added: + ----- Method: OrderedSet>>sort (in category 'sorting') ----- + sort + + self sort: nil! Item was added: + ----- Method: OrderedSet>>sort: (in category 'sorting') ----- + sort: aSortBlock + "Like in OrderedCollection, sort the associations according to the sort block." + + tally <= 1 ifTrue: [ ^self ]. + order sort: aSortBlock! Item was added: + ----- Method: OrderedSet>>sorted: (in category 'sorting') ----- + sorted: aSortBlockOrNil + + ^ self copy sort: aSortBlockOrNil! Item was added: + ----- Method: OrderedSet>>third (in category 'accessing') ----- + third + + ^order third!

1 0

OrderedSet
by Bernhard Pieber 04 Dec '18

04 Dec '18

Hi Squeakers, Does anyone know of an OrderedSet implementation for Squeak somewhere? Bernhard

9 14

source.squeak.org is currently being upgraded (eom)
by Chris Muller 04 Dec '18

04 Dec '18

3 2

The Trunk: Tools-pre.835.mcz
by commits＠source.squeak.org 03 Dec '18

03 Dec '18

Patrick Rein uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-pre.835.mcz ==================== Summary ==================== Name: Tools-pre.835 Author: pre Time: 3 December 2018, 10:41:37.808597 am UUID: 41d6096e-dc6a-e14e-a821-8a68d70f1098 Ancestors: Tools-pre.834 Pushes the refactoring of FileCOntentsBrowser instance creation methods further to eliminate all duplicate code. =============== Diff against Tools-pre.834 =============== Item was changed: ----- Method: FileContentsBrowser class>>browseFiles: (in category 'instance creation') ----- browseFiles: fileList "Open a browser on the packages found within the files in the list; we expect the list to contain acceptable filename strings. If there is more than one package found the browser will be a full system browser, otherwise it will be a category browser" + ^ (self createBrowserForPackagesFrom: fileList withEach: [:fileName | + FilePackage fromFileNamed: fileName]) buildAndOpenBrowser - | browser organizerAndPackageDict | - Cursor wait showWhile: [ - organizerAndPackageDict := self buildOrganizerWithPackagesFrom: fileList withEach: [:fileName | - FilePackage fromFileNamed: fileName]. - (browser := self systemOrganizer: organizerAndPackageDict first) - packages: organizerAndPackageDict second]. - ^ browser buildAndOpenBrowser ! Item was removed: - ----- Method: FileContentsBrowser class>>buildOrganizerWithPackagesFrom:withEach: (in category 'private') ----- - buildOrganizerWithPackagesFrom: collectionOfPackageSources withEach: filePackageCreation - - | organizer packageDict | - packageDict := Dictionary new. - organizer := SystemOrganizer defaultList: Array new. - - collectionOfPackageSources do: [:src | | package | - package := filePackageCreation value: src. - packageDict - at: package packageName - put: package. - organizer - classifyAll: package classes keys - under: package packageName]. - - ^ {organizer . packageDict}! Item was added: + ----- Method: FileContentsBrowser class>>createBrowserForPackagesFrom:withEach: (in category 'private') ----- + createBrowserForPackagesFrom: collectionOfPackageSources withEach: filePackageCreation + + | browser packageDict organizer | + Cursor wait showWhile: [ + browser := self new. + packageDict := Dictionary new. + organizer := SystemOrganizer defaultList: Array new. + + collectionOfPackageSources do: [:src | | package | + package := filePackageCreation value: src. + packageDict + at: package packageName + put: package. + organizer + classifyAll: package classes keys + under: package packageName]. + + (browser := self systemOrganizer: organizer) + packages: packageDict]. + ^ browser! Item was changed: ----- Method: FileContentsBrowser class>>createBrowserForStream:named: (in category 'private') ----- createBrowserForStream: aStream named: aString + ^ self createBrowserForPackagesFrom: {aStream} withEach: [:stream | + (FilePackage new fullName: aString; fileInFrom: aStream)]! - | browser organizerAndPackageDict | - Cursor wait showWhile: [ - browser := self new. - organizerAndPackageDict := self buildOrganizerWithPackagesFrom: {aStream} withEach: [:stream | - (FilePackage new fullName: aString; fileInFrom: aStream)]. - (browser := self systemOrganizer: organizerAndPackageDict first) - packages: organizerAndPackageDict second]. - ^ browser!

1 0

Named serial port bug and how to contribute
by Ricardo Moran 02 Dec '18

02 Dec '18

Hi, I think I found a bug with the named serial ports in windows. I can open a named port without problem the first time but if I close it and try to open it again it fails until I restart the image. This doesn't happen with numeric ports. I could reproduce this bug in both Squeak5.2 and Pharo6.1 (both using windows 8.1). I think the problem is that SerialPort>>#primClosePortByName: calls the "primitiveSerialPortCloseByName" but I couldn't find this primitive anywhere in the SerialPlugin source ( https://github.com/OpenSmalltalk/opensmalltalk-vm/blob/Cog/src/plugins/Seri…). So I'm guessing that the port is never properly closed. I added the missing primitive (find attached) and recompiled the vm, and now it seems to work. So my question is: how can I contribute this small fix? Should I commit to the VM Maker Inbox repository? Thanks, Richo

3 3

The Trunk: GraphicsTests-mt.50.mcz
by commits＠source.squeak.org 02 Dec '18

02 Dec '18

Marcel Taeumel uploaded a new version of GraphicsTests to project The Trunk: http://source.squeak.org/trunk/GraphicsTests-mt.50.mcz ==================== Summary ==================== Name: GraphicsTests-mt.50 Author: mt Time: 2 December 2018, 11:52:32.350325 am UUID: 47215a6d-cd2c-b749-8e8b-402fef91d861 Ancestors: GraphicsTests-pre.49 Fixes categories for point tests. Adds tests for infix rectangle creation. =============== Diff against GraphicsTests-pre.49 =============== Item was changed: SystemOrganization addCategory: #'GraphicsTests-Files'! SystemOrganization addCategory: #'GraphicsTests-Primitives'! - SystemOrganization addCategory: #'GraphicsTests-Transformations'! SystemOrganization addCategory: #'GraphicsTests-Text'! Item was changed: + ----- Method: PointTest>>testBasicFourDirections (in category 'tests') ----- - ----- Method: PointTest>>testBasicFourDirections (in category 'testing - testing') ----- testBasicFourDirections "fourDirections returns the four rotation of the receiver in counter clockwise order with the receiver appearing last. " | samples results rejects | self assert: (0 asPoint fourDirections) = (Array new: 4 withAll: 0 asPoint) . samples := 0 asPoint eightNeighbors . results := { { 0 @ -1 . -1 @ 0 . 0 @ 1 . 1 @ 0}. { 1 @ -1 . -1 @ -1 . -1 @ 1 . 1 @ 1}. { 1 @ 0 . 0 @ -1 . -1 @ 0 . 0 @ 1}. { 1 @ 1 . 1 @ -1 . -1 @ -1 . -1 @ 1}. { 0 @ 1 . 1 @ 0 . 0 @ -1 . -1 @ 0}. {-1 @ 1 . 1 @ 1 . 1 @ -1 . -1 @ -1}. {-1 @ 0 . 0 @ 1 . 1 @ 0 . 0 @ -1}. {-1 @ -1 . -1 @ 1 . 1 @ 1 . 1 @ -1} } . rejects := (1 to: samples size ) reject: [ :each | (samples at: each) fourDirections = (results at: each) ] . self assert: rejects isEmpty! Item was changed: + ----- Method: PointTest>>testBearingToPoint (in category 'tests') ----- - ----- Method: PointTest>>testBearingToPoint (in category 'tests - testing') ----- testBearingToPoint self assert: (0 @ 0 bearingToPoint: 0 @ 0) = 0. self assert: (0 @ 0 bearingToPoint: 0 @ -1) = 0. self assert: (0 @ 0 bearingToPoint: 1 @ 0) = 90. self assert: (0 @ 0 bearingToPoint: 0 @ 1) = 180. self assert: (0 @ 0 bearingToPoint: -1 @ 0) = 270. self assert: (0 @ 0 bearingToPoint: 1 @ 1) = 135. self assert: (0 @ 0 bearingToPoint: 0.01 @ 0) = 90. self assert: (0 @ 0 bearingToPoint: -2 @ -3) = 326. self assert: (0 @ 0 bearingToPoint: -0 @ 0) = 0. self assert: (-2 @ -3 bearingToPoint: 0 @ 0) = 146.! Item was changed: + ----- Method: PointTest>>testFourDirectionsInvarients (in category 'tests') ----- - ----- Method: PointTest>>testFourDirectionsInvarients (in category 'testing - testing') ----- testFourDirectionsInvarients " fourDirections returns the four rotation of the reciever in counter clockwise order with the reciever appearing last. " | samples rejects | samples := 0 asPoint eightNeighbors . rejects := (1 to: samples size ) reject: [ :each | (samples at: each) fourDirections last = ( samples at: each) ] . self assert: ( rejects isEmpty) . ! Item was changed: + ----- Method: PointTest>>testFourDirectionsRotationInvarients (in category 'tests') ----- - ----- Method: PointTest>>testFourDirectionsRotationInvarients (in category 'testing - testing') ----- testFourDirectionsRotationInvarients " fourDirections returns the four rotation of the reciever in counter clockwise order with the reciever appearing last. " | samples rejects | samples := 0 asPoint eightNeighbors . rejects := (1 to: samples size ) reject: [ :each | | answer | (answer := (samples at: each) fourDirections ) . (1 to: 4) allSatisfy: [ :eachDirIndex | ( answer atWrap: eachDirIndex) leftRotated = (( answer atWrap: eachDirIndex + 1) ) ] ] . self assert: ( rejects isEmpty) . ! Item was changed: + ----- Method: PointTest>>testIsZero (in category 'tests') ----- - ----- Method: PointTest>>testIsZero (in category 'tests - testing') ----- testIsZero self assert: (0@0) isZero. self deny: (0@1) isZero. self deny: (1@0) isZero. self deny: (1@1) isZero.! Item was changed: + ----- Method: PointTest>>testNormal (in category 'tests') ----- - ----- Method: PointTest>>testNormal (in category 'testing - testing') ----- testNormal "quick check of results for #normal." | samples rejects results | samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint) . results := { 0.0 @ 1.0 . -0.707106781186547 @ 0.707106781186547 . -1.0 @ 0.0 . -0.707106781186547 @ -0.707106781186547 . 0.0 @ -1.0 . 0.707106781186547 @ -0.707106781186547 . 1.0 @ 0.0 . 0.707106781186547 @ 0.707106781186547 . -1 @ 0} . rejects := (1 to: samples size ) reject: [ :each | ((samples at: each) normal - (results at: each)) abs < 1e-15 asPoint ] . self assert: rejects isEmpty! Item was changed: + ----- Method: PointTest>>testNormal2 (in category 'tests') ----- - ----- Method: PointTest>>testNormal2 (in category 'testing - testing') ----- testNormal2 "quick check of results for #normal. differs from the other testNormal in the way that the difference is measured." | samples rejects results differences | samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint) . results := { 0.0 @ 1.0 . -0.707106781186547 @ 0.707106781186547 . -1.0 @ 0.0 . -0.707106781186547 @ -0.707106781186547 . 0.0 @ -1.0 . 0.707106781186547 @ -0.707106781186547 . 1.0 @ 0.0 . 0.707106781186547 @ 0.707106781186547 . -1 @ 0} . differences := samples with: results collect: [ :each :eachResult | each normal - eachResult ] . rejects := differences reject: [ :each | (each x closeTo: 0.0) and: [each y closeTo: 0.0] ] . self assert: rejects isEmpty! Item was added: + ----- Method: PointTest>>testRectangleMix (in category 'tests') ----- + testRectangleMix + + { + Rectangle center: 60@60 extent: 100@100. + Rectangle origin: 10@10 extent: 100@100. + Rectangle origin: 10@10 corner: 110@110. + + 60@60 inflate: 100@100. + 10@10 extent: 100@100. + 10@10 corner: 110@110. + } permutationsDo: [:rects | + rects overlappingPairsDo: [:r1 :r2 | + self assert: r1 equals: r2]].! Item was added: + ----- Method: PointTest>>testRectangleWithCorner (in category 'tests') ----- + testRectangleWithCorner + + self + assert: (Rectangle origin: 10@10 corner: 110@110) + equals: (10@10 corner: 110@110).! Item was added: + ----- Method: PointTest>>testRectangleWithExtent (in category 'tests') ----- + testRectangleWithExtent + + self + assert: (Rectangle origin: 50@50 extent: 100@100) + equals: (50@50 extent: 100@100).! Item was added: + ----- Method: PointTest>>testRectangleWithInflate (in category 'tests') ----- + testRectangleWithInflate + + self + assert: (Rectangle center: 50@50 extent: 100@100) + equals: (50@50 inflate: 100@100).! Item was changed: + ----- Method: PointTest>>testRotations (in category 'tests') ----- - ----- Method: PointTest>>testRotations (in category 'testing - testing') ----- testRotations " Here we are testing rightRotated and leftRotated which are new. Because there is really no coverage for point functions this also serves as a tests of sorts for rotateBy:CenterAt:" | samples | samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint) . self assert: (samples allSatisfy: [ :each | each rightRotated leftRotated = each ] ) . self assert: (samples allSatisfy: [ :each | each rightRotated = (each rotateBy: #right centerAt: 0 asPoint)] ) . self assert: (samples allSatisfy: [ :each | each leftRotated = (each rotateBy: #left centerAt: 0 asPoint ) ] ) . self assert: (samples allSatisfy: [ :each | each negated = (each rotateBy: #pi centerAt: 0 asPoint ) ] ) . self assert: (samples allSatisfy: [ :each | each leftRotated leftRotated leftRotated leftRotated = each ]) . self assert: (samples allSatisfy: [ :each | each rightRotated rightRotated rightRotated rightRotated = each ] ) . ! Item was changed: + ----- Method: PointTest>>testSign (in category 'tests') ----- - ----- Method: PointTest>>testSign (in category 'testing - testing') ----- testSign | samples results rejects | samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint). results := samples collect: [ :each | each sign ]. rejects := (1 to: samples size ) reject: [ :each | (samples at: each) = (results at: each) ] . self assert: (rejects isEmpty) ! Item was changed: + ----- Method: PointTest>>testTheta (in category 'tests') ----- - ----- Method: PointTest>>testTheta (in category 'testing - testing') ----- testTheta | result dir tan x y | self assert: ((0 @ 1) theta - 90.0 degreesToRadians) abs < 1e-15. self assert: ((0 @ -1) theta - 270.0 degreesToRadians) abs < 1e-15. " See code of old and new theta" x := 1.0 . y := -1.0. tan := y / x . dir := tan arcTan. result := 360.0 degreesToRadians + dir. self assert: ((x @ y) theta - result) abs < 1e-15. x := -1.0. "Don't reuse old results when you want numeric precision!!" tan := y / x . dir := tan arcTan. result := 180.0 degreesToRadians + dir. self assert: ((x @ y) theta - result) abs < 1e-15. ! Item was changed: + ----- Method: PointTest>>testZeroPointNormal (in category 'tests') ----- - ----- Method: PointTest>>testZeroPointNormal (in category 'testing - testing') ----- testZeroPointNormal "old: normal of zero point raised divide by zero error. new: normal of zero point returns a direction right rotated from zero points direction." self assert: 90 equals: (0 asPoint normal bearingToPoint: 0 asPoint).!

1 0

The Trunk: 60Deprecated-mt.27.mcz
by commits＠source.squeak.org 02 Dec '18

02 Dec '18

Marcel Taeumel uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-mt.27.mcz ==================== Summary ==================== Name: 60Deprecated-mt.27 Author: mt Time: 2 December 2018, 11:11:20.814325 am UUID: 0133c524-d990-db4f-8a76-de226601891d Ancestors: 60Deprecated-pre.26 Deprecations from Morphic-mt.1468 =============== Diff against 60Deprecated-pre.26 =============== Item was added: + ----- Method: BorderedMorph>>setBorderWidth:borderColor: (in category '*60Deprecated-private') ----- + setBorderWidth: w borderColor: bc + + self deprecated: 'mt: Use #borderStyle: or #borderWidth:/Color: directly.'. + + self borderWidth: w. + self borderColor: bc.! Item was added: + ----- Method: BorderedMorph>>setColor:borderWidth:borderColor: (in category '*60Deprecated-private') ----- + setColor: c borderWidth: w borderColor: bc + + self deprecated: 'mt: Use #borderStyle: or #borderWidth:/Color: directly.'. + + self color: c. + self borderWidth: w. + self borderColor: bc.!

1 0

The Trunk: Morphic-mt.1468.mcz
by commits＠source.squeak.org 02 Dec '18

02 Dec '18

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1468.mcz ==================== Summary ==================== Name: Morphic-mt.1468 Author: mt Time: 2 December 2018, 11:09:37.078325 am UUID: f2fb9cd4-6b5a-9941-adf6-0ecba9b669e5 Ancestors: Morphic-mt.1467 Two minor fixes in the realm of BorderedMorph: 1) Fixes a small issue with translucent borders. 2) Deprecates two set* messages. =============== Diff against Morphic-mt.1467 =============== Item was removed: - ----- Method: BorderedMorph>>setBorderWidth:borderColor: (in category 'private') ----- - setBorderWidth: w borderColor: bc - self borderWidth: w. - self borderColor: bc.! Item was removed: - ----- Method: BorderedMorph>>setColor:borderWidth:borderColor: (in category 'private') ----- - setColor: c borderWidth: w borderColor: bc - self color: c. - self borderWidth: w. - self borderColor: bc.! Item was changed: ----- Method: FormCanvas>>frameAndFillRectangle:fillColor:borderWidth:topLeftColor:bottomRightColor: (in category 'drawing-rectangles') ----- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor | w h rect | "First use quick code for top and left borders and fill" self frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: topLeftColor. + + "Return here for duplicate colors. Makes translucent borders work better." + topLeftColor = bottomRightColor ifTrue: [^ self]. "Now use slow code for bevelled bottom and right borders" bottomRightColor isTransparent ifFalse: [ borderWidth isNumber ifTrue: [w := h := borderWidth] ifFalse: [w := borderWidth x. h := borderWidth y]. rect := r translateBy: origin. self setFillColor: bottomRightColor. port frameRectRight: rect width: w; frameRectBottom: rect height: h]. ! Item was changed: ----- Method: MorphHierarchyListMorph>>createContainer (in category 'private') ----- createContainer "Private - Create a container" | container | container := BorderedMorph new. container extent: (self world extent * (1 / 4 @ (2 / 3))) rounded. container layoutPolicy: TableLayout new. container hResizing: #rigid. container vResizing: #rigid. container + color: (Color gray: 0.9); + borderWidth: 1; - setColor: (Color gray: 0.9) - borderWidth: 1 borderColor: Color gray. container layoutInset: 0. "container useRoundedCorners." "" container setProperty: #morphHierarchy toValue: true. container setNameTo: 'Objects Hierarchy' translated. "" ^ container!

1 0