Squeak-dev July 2021

squeak-dev@lists.squeakfoundation.org

25 participants
180 discussions

The Inbox: System-ct.1236.mcz
by commits＠source.squeak.org 30 Aug '21

30 Aug '21

A new version of System was added to project The Inbox: http://source.squeak.org/inbox/System-ct.1236.mcz ==================== Summary ==================== Name: System-ct.1236 Author: ct Time: 15 June 2021, 4:00:40.522222 pm UUID: f7bb410f-d6de-b242-b769-a558aa5a4254 Ancestors: System-dtl.1235 Fixes RealEstateAgent intolerance with a nil world which must be handled according to senders. Document the fact that world can be nil in all relevant senders. I struggled about this when I encountered a recursive project error. See StandardSystemView >> #initialFrame. =============== Diff against System-dtl.1235 =============== Item was changed: ----- Method: RealEstateAgent class>>initialFrameAtPointerFor:initialExtent:world: (in category 'framing - private') ----- + initialFrameAtPointerFor: aView initialExtent: scaledExtent world: aWorldOrNil + ^((aWorldOrNil ifNil: [0 @ 0] ifNotNil: [aWorldOrNil cursorPoint - (50@10) "puts use with the mouse ptr just to the right of the menu button"]) - initialFrameAtPointerFor: aView initialExtent: scaledExtent world: aWorld - ^(aWorld cursorPoint - (50@10) "puts use with the mouse ptr just to the right of the menu button" extent: scaledExtent) + translatedAndSquishedToBeWithin: (self maximumUsableAreaInWorld: aWorldOrNil)! - translatedAndSquishedToBeWithin: (self maximumUsableAreaInWorld: aWorld)! Item was changed: ----- Method: RealEstateAgent class>>initialFrameFor:initialExtent:world: (in category 'framing') ----- + initialFrameFor: aView initialExtent: initialExtent world: aWorldOrNil - initialFrameFor: aView initialExtent: initialExtent world: aWorld | scaledExtent | scaledExtent := (initialExtent * self scaleFactor) rounded. self placeWindowsAtPointer ifTrue: + [^self initialFrameAtPointerFor: aView initialExtent: scaledExtent world: aWorldOrNil]. - [^self initialFrameAtPointerFor: aView initialExtent: scaledExtent world: aWorld]. ^ Preferences reverseWindowStagger + ifTrue: [self strictlyStaggeredInitialFrameFor: aView initialExtent: scaledExtent world: aWorldOrNil] + ifFalse: [self normalInitialFrameFor: aView initialExtent: scaledExtent world: aWorldOrNil]! - ifTrue: [self strictlyStaggeredInitialFrameFor: aView initialExtent: scaledExtent world: aWorld] - ifFalse: [self normalInitialFrameFor: aView initialExtent: scaledExtent world: aWorld]! Item was changed: ----- Method: RealEstateAgent class>>initialFrameFor:world: (in category 'framing') ----- + initialFrameFor: aView world: aWorldOrNil - initialFrameFor: aView world: aWorld "Find a plausible initial screen area for the supplied view. See called method." + ^ self initialFrameFor: aView initialExtent: aView initialExtent world: aWorldOrNil! - ^ self initialFrameFor: aView initialExtent: aView initialExtent world: aWorld! Item was changed: ----- Method: RealEstateAgent class>>normalInitialFrameFor:initialExtent:world: (in category 'framing - private') ----- + normalInitialFrameFor: aView initialExtent: initialExtent world: aWorldOrNil - normalInitialFrameFor: aView initialExtent: initialExtent world: aWorld "Find a plausible initial screen area for the supplied view, which should be a StandardSystemView, taking into account the 'reverseWindowStagger' Preference, the size needed, and other windows currently on the screen." | allOrigins screenRight screenBottom putativeOrigin putativeFrame allowedArea staggerOrigin otherFrames | + allowedArea := self maximumUsableAreaInWorld: aWorldOrNil. - allowedArea := self maximumUsableAreaInWorld: aWorld. screenRight := allowedArea right. screenBottom := allowedArea bottom. otherFrames := Smalltalk isMorphic + ifTrue: [(SystemWindow windowsIn: aWorldOrNil satisfying: [:w | w isCollapsed not]) - ifTrue: [(SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not]) collect: [:w | w bounds]] ifFalse: [ScheduledControllers scheduledWindowControllers select: [:aController | aController view ~~ nil] thenCollect: [:aController | aController view isCollapsed ifTrue: [aController view expandedFrame] ifFalse: [aController view displayBox]]]. allOrigins := otherFrames collect: [:f | f origin]. + (self standardPositionsInWorld: aWorldOrNil) do: "First see if one of the standard positions is free" - (self standardPositionsInWorld: aWorld) do: "First see if one of the standard positions is free" [:aPosition | (allOrigins includes: aPosition) ifFalse: [^ (aPosition extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]]. + staggerOrigin := (self standardPositionsInWorld: aWorldOrNil) first. "Fallback: try offsetting from top left" - staggerOrigin := (self standardPositionsInWorld: aWorld) first. "Fallback: try offsetting from top left" putativeOrigin := staggerOrigin. [putativeOrigin := putativeOrigin + StaggerOffset. putativeFrame := putativeOrigin extent: initialExtent. (putativeFrame bottom < screenBottom) and: [putativeFrame right < screenRight]] whileTrue: [(allOrigins includes: putativeOrigin) ifFalse: [^ (putativeOrigin extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]]. ^ (self scrollBarSetback @ self screenTopSetback extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea! Item was changed: ----- Method: RealEstateAgent class>>strictlyStaggeredInitialFrameFor:initialExtent:world: (in category 'framing - private') ----- + strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent world: aWorldOrNil - strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent world: aWorld "This method implements a staggered window placement policy that I (di) like. Basically it provides for up to 4 windows, staggered from each of the 4 corners. The windows are staggered so that there will always be a corner visible." | allowedArea grid initialFrame otherFrames cornerSel corner delta putativeCorner free maxLevel | + allowedArea :=(self maximumUsableAreaInWorld: aWorldOrNil) - allowedArea :=(self maximumUsableAreaInWorld: aWorld) insetBy: (self scrollBarSetback @ self screenTopSetback extent: 0@0). "Number to be staggered at each corner (less on small screens)" maxLevel := allowedArea area > 300000 ifTrue: [3] ifFalse: [2]. "Amount by which to stagger (less on small screens)" grid := allowedArea area > 500000 ifTrue: [40] ifFalse: [20]. initialFrame := 0@0 extent: ((initialExtent "min: (allowedArea extent - (grid*(maxLevel+1*2) + (grid//2)))) min: 600@400")). otherFrames := Smalltalk isMorphic + ifTrue: [(SystemWindow windowsIn: aWorldOrNil satisfying: [:w | w isCollapsed not]) - ifTrue: [(SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not]) collect: [:w | w bounds]] ifFalse: [ScheduledControllers scheduledWindowControllers select: [:aController | aController view ~~ nil] thenCollect: [:aController | aController view isCollapsed ifTrue: [aController view expandedFrame] ifFalse: [aController view displayBox]]]. 0 to: maxLevel do: [:level | 1 to: 4 do: [:ci | cornerSel := #(topLeft topRight bottomRight bottomLeft) at: ci. corner := allowedArea perform: cornerSel. "The extra grid//2 in delta helps to keep title tabs distinct" delta := (maxLevel-level*grid+(grid//2)) @ (level*grid). 1 to: ci-1 do: [:i | delta := delta rotateBy: #right centerAt: 0@0]. "slow way" putativeCorner := corner + delta. free := true. otherFrames do: [:w | free := free & ((w perform: cornerSel) ~= putativeCorner)]. free ifTrue: [^ (initialFrame align: (initialFrame perform: cornerSel) with: putativeCorner) translatedAndSquishedToBeWithin: allowedArea]]]. "If all else fails..." ^ (self scrollBarSetback @ self screenTopSetback extent: initialFrame extent) translatedAndSquishedToBeWithin: allowedArea!

3 4

The Inbox: Collections-ct.947.mcz
by commits＠source.squeak.org 30 Aug '21

30 Aug '21

A new version of Collections was added to project The Inbox: http://source.squeak.org/inbox/Collections-ct.947.mcz ==================== Summary ==================== Name: Collections-ct.947 Author: ct Time: 10 June 2021, 8:40:58.780588 pm UUID: cb2cdf00-2a3a-5d46-bf15-60255480c1fa Ancestors: Collections-eem.944 Proposal: Adds sort function that uses a boolean compare block such as [:a :b | a <= b]. Usage examples: squotVersions sorted: [:a :b | historyWalker shouldVisit: a before: b] asCompareSortFunction. #(true nil 42) sorted: #compareSafely: asCompareSortFunction. =============== Diff against Collections-eem.944 =============== Item was added: + ----- Method: BlockClosure>>asCompareSortFunction (in category '*Collections-SortFunctions-converting') ----- + asCompareSortFunction + + ^ CompareBlockFunction usingBlock: self! Item was changed: SortFunction subclass: #CollatorBlockFunction instanceVariableNames: 'collatorBlock' classVariableNames: '' poolDictionaries: '' category: 'Collections-SortFunctions'! + !CollatorBlockFunction commentStamp: 'ct 6/10/2021 20:38' prior: 0! - !CollatorBlockFunction commentStamp: 'nice 11/5/2017 22:57' prior: 0! A CollatorBlockFunction is a special SortFunction using a dyadic block to collate objects. Instance Variables + collatorBlock <Block> a dyadic block that must return a -1, 0, or 1.! - collator <Block> a dyadic block that must return a -1, 0, or 1.! Item was added: + SortFunction subclass: #CompareBlockFunction + instanceVariableNames: 'compareBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-SortFunctions'! + + !CompareBlockFunction commentStamp: 'ct 6/10/2021 20:38' prior: 0! + A CompareBlockFunction is a special SortFunction using a dyadic block to compare objects. The default compare logic is the lower-equals function (#<=). + + Instance Variables + + compareBlock <Block> a dyadic block that must return true iff the first argument should not appear after the second , otherwise false.! Item was added: + ----- Method: CompareBlockFunction class>>usingBlock: (in category 'instance creation') ----- + usingBlock: twoArgsBlock + + ^ self new compareBlock: twoArgsBlock! Item was added: + ----- Method: CompareBlockFunction>>collate:with: (in category 'evaluating') ----- + collate: anObject with: anotherObject + + ^ (compareBlock value: anObject value: anotherObject) + ifTrue: [-1] + ifFalse: [1]! Item was added: + ----- Method: CompareBlockFunction>>compareBlock (in category 'accessing') ----- + compareBlock + + ^ compareBlock! Item was added: + ----- Method: CompareBlockFunction>>compareBlock: (in category 'accessing') ----- + compareBlock: aBlock + + compareBlock := aBlock.! Item was added: + ----- Method: Symbol>>asCompareSortFunction (in category '*Collections-SortFunctions-converting') ----- + asCompareSortFunction + + ^ CompareBlockFunction usingBlock: self!

3 4

Trouble running OSProcess on smalltalkCI for Windows/mingw
by Thiede, Christoph 30 Aug '21

30 Aug '21

Hi all, while setting up smalltalkCI for a project, I am having troubles getting OSProcess to run on a GitHub Actions runner for Windows. My test is as simple as: OSProcess waitForCommand: 'whoami' Which, normally, should print a small string to stdout and return after no longer than a few decisonds. However, in my smalltalkCI test for Windows, I just keep getting timeouts, even though the username is output correctly to the CI log. I am installing OSProcess using: MCMcmUpdater updateFromRepository: 'http://www.squeaksource.com/OSProcess' baseName: MCMcmUpdater defaultBaseName interactive: false. <http://www.hpi.de/> I have ensured (via good old Transcript debugging) that the grimReaperProcess is running and not suspended. Also, there is not any other error message visible in the Transcript. How could that be? As far as I know, the GitHub runner for Windows uses the git bash (mingw), so Windows executables and APIs are still available, but the shell is a different one. I could also reproduce the issue when running smalltalkCI from my local git bash (mingw). Interestingly, when using the "--headful" option to inspect the image manually, I can run all tests successfully, but when the tests are run automatically in the squeak::run_tests stage, they fail again. What is going on here?? At the moment, I feel somehow like at my wit's end ... Did anyone of you already encountered a similar problem, or do you have any idea how to debug/solve the problem? Thanks in advance! :-) Best, Christoph

3 8

The Trunk: Collections-mt.945.mcz
by commits＠source.squeak.org 23 Aug '21

23 Aug '21

Marcel Taeumel uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-mt.945.mcz ==================== Summary ==================== Name: Collections-mt.945 Author: mt Time: 18 June 2021, 8:02:50.788904 am UUID: d551c74f-90b4-400a-8952-d9d4ff31e3bb Ancestors: Collections-eem.944 Extends constant character names to support #return. Fixes constant character names to work with all current constants, which, e.g., includes #arrowUp etc. Drop #newPage in favor of #pageDown (and #pageUp). Note that #newPage still works as a constant. It will just not show up when you print a non-printable character. =============== Diff against Collections-eem.944 =============== Item was changed: ----- Method: Character class>>constantNames (in category 'private') ----- constantNames + ^ #( backspace delete return lf enter delete escape null space tab arrowDown arrowUp arrowLeft arrowRight end home pageDown pageUp euro insert )! - ^ #( backspace cr delete escape lf null newPage space tab ).! Item was added: + ----- Method: Character class>>return (in category 'accessing untypeable characters') ----- + return + "Answer the Character representing a carriage return." + + ^self value: 13!

3 2

Announcement: Spelling services
by Tim Felgentreff 23 Aug '21

23 Aug '21

Hi Once upon a time, John M. McIntosh built a spellchecker plugin for the MacVM and there was a fileout that added a spelling service class to use it from Squeak. We have added code to provide the same API (for now) to windows and linux users that have ispell (or a compatible program, like aspell) installed on their systems using system callouts. A metacello configuration is available from the MetacelloRepository on Squeaksource, ConfigurationOfSpellingServices. The development repository is at http://www.hpi.uni-potsdam.de/hirschfeld/squeaksource/SpellingServices.html, the repo has global read+write, so if anybody finds this useful and has changes, feel free to commit to that repository. -Tim

6 8

Debian tarball updates?
by tim Rowledge 13 Aug '21

13 Aug '21

Is anyone out there interested in, and able to spend the time, to try to sort out an update of the Debian tarball stuff? A long time ago we went through some considerable effort to get Squeak into the system and it seems to have languished ever since. It would make us look somewhat more contemporary if we could get an updated package built and inserted. Please, if you can help, let us know. tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Strange OpCodes: RWD: Rewind Disk

6 15

Website VM Downloads Link Broken
by Eric Gade 05 Aug '21

05 Aug '21

Hi all, The link at squeak.org/downloads for trunk VMs appears to be broken ( https://bintray.com/opensmalltalk/vm/cog/_latestVersion#files) -- apparently bintray no longer offers whatever specific service was being used -- Eric

6 8

The Trunk: MonticelloConfigurations-eem.167.mcz
by commits＠source.squeak.org 28 Jul '21

28 Jul '21

Eliot Miranda uploaded a new version of MonticelloConfigurations to project The Trunk: http://source.squeak.org/trunk/MonticelloConfigurations-eem.167.mcz ==================== Summary ==================== Name: MonticelloConfigurations-eem.167 Author: eem Time: 28 July 2021, 11:57:05.293004 am UUID: e4621e20-5599-455c-be27-a80129b16abc Ancestors: MonticelloConfigurations-mt.166 Include the repository name in the Update completed messaeg logged to the Transcript. This because we have multiple update streams (e.g. trunk, 5.x, VMMaker, etc), and knowing which was updated is useful when looking back at the transcript. =============== Diff against MonticelloConfigurations-mt.166 =============== Item was changed: ----- Method: MCMcmUpdater>>doUpdate: (in category 'updating') ----- doUpdate: interactive "Update the image by loading all pending updates from the server. If this is the default updater for the system, update the system version when complete. If interteractive use a modal notifier, otherwise only update the transcript. Flush all caches. If a previous download failed this is often helpful" + | previousUpdateLevel ensureTranscriptSetting | - | config previousUpdateLevel ensureTranscriptSetting | previousUpdateLevel := SystemVersion current highestUpdate. MCFileBasedRepository flushAllCaches. ensureTranscriptSetting := MCConfiguration ensureOpenTranscript. + [MCConfiguration ensureOpenTranscript: interactive. + self updateFromRepository + ifNil: + [interactive ifTrue: [ ^self inform: 'Unable to retrieve updates from remote repository.' translated ]. + Transcript cr; show: '========== Unable to retrieve updates from remote repository. ==========' translated; cr. + ^ self ] + ifNotNil: [:config| self logUpdateOf: config previousUpdateLevel: previousUpdateLevel interactive: interactive]] + ensure: + [MCConfiguration ensureOpenTranscript: ensureTranscriptSetting]! - [ MCConfiguration ensureOpenTranscript: interactive. - config := self updateFromRepository. - config ifNil: [ - interactive ifTrue: [ ^self inform: 'Unable to retrieve updates from remote repository.' translated ]. - Transcript cr; show: '========== Unable to retrieve updates from remote repository. ==========' translated; cr. - ^ self ]. - MCMcmUpdater default == self - ifTrue: [ - config setSystemVersion. - interactive ifTrue: [ - self inform: (self updateMessageFor: previousUpdateLevel)]. - Transcript cr; - show: '========== Update completed: ' translated; - show: previousUpdateLevel; - show: ' -> ' ; - show: SystemVersion current highestUpdate; - show: ' =========='; cr ] - ifFalse: [ - interactive - ifTrue: [ self inform: 'Update completed.' ]. - Transcript cr; show: '========== Update completed. ==========' translated; cr ] ] - ensure: [ MCConfiguration ensureOpenTranscript: ensureTranscriptSetting]. - - ! Item was changed: ----- Method: MCMcmUpdater>>doUpdate:upTo: (in category 'updating') ----- doUpdate: interactive upTo: versionNumber "Update the image by loading all pending updates from the server. If this is the default updater for the system, update the system version when complete. If interteractive use a modal notifier, otherwise only update the transcript. Flush all caches. If a previous download failed this is often helpful" | config previousUpdateLevel | previousUpdateLevel := SystemVersion current highestUpdate. MCFileBasedRepository flushAllCaches. config := self updateFromRepositories: { self repository } upTo: versionNumber. config ifNil: [ interactive ifTrue: [ ^self inform: 'Unable to retrieve updates from remote repository.' translated ]. Transcript cr; show: '========== Unable to retrieve updates from remote repository. ==========' translated; cr. ^ self ]. + self logUpdateOf: config previousUpdateLevel: previousUpdateLevel interactive: interactive - MCMcmUpdater default == self - ifTrue: [ - config setSystemVersion. - interactive ifTrue: [ - self inform: (self updateMessageFor: previousUpdateLevel)]. - Transcript cr; - show: '========== Update completed: ' translated; - show: previousUpdateLevel; - show: ' -> ' ; - show: SystemVersion current highestUpdate; - show: ' =========='; cr ] - ifFalse: [ - interactive - ifTrue: [ self inform: 'Update completed.' ]. - Transcript cr; show: '========== Update completed. ==========' translated; cr ] ! Item was added: + ----- Method: MCMcmUpdater>>logUpdateOf:previousUpdateLevel:interactive: (in category 'updating') ----- + logUpdateOf: config previousUpdateLevel: previousUpdateLevel interactive: interactive + MCMcmUpdater default == self + ifTrue: [ + config setSystemVersion. + interactive ifTrue: [ + self inform: (self updateMessageFor: previousUpdateLevel)]. + Transcript cr; + show: '========== Update of ' translated, self repositoryName, ' completed: ' translated; + show: previousUpdateLevel; + show: ' -> ' ; + show: SystemVersion current highestUpdate; + show: ' =========='; cr ] + ifFalse: [ + interactive + ifTrue: [ self inform: 'Update of ', self repositoryName, ' completed.' ]. + Transcript cr; show: '========== Update of ' translated, self repositoryName, ' completed. ==========' translated; cr ] + + ! Item was added: + ----- Method: MCMcmUpdater>>repositoryName (in category 'private') ----- + repositoryName + ^repository allButFirst: (repository lastIndexOf: $/ ifAbsent: [0])!

1 0

The Inbox: Network-EG.246.mcz
by commits＠source.squeak.org 28 Jul '21

28 Jul '21

A new version of Network was added to project The Inbox: http://source.squeak.org/inbox/Network-EG.246.mcz ==================== Summary ==================== Name: Network-EG.246 Author: EG Time: 20 July 2021, 2:16:51.031725 pm UUID: 286844ab-38ff-4f7d-97a4-37d69eda41e5 Ancestors: Network-ct.245 Adding methods and helpers for: 1. Converting from an IPv6 string to an IPv6 ByteArray; 2. Converting from an IPv6 ByteArray to a valid IPv6 string. Note that the complexity here is mostly taken up in dealing with the IPv6 "feature" of compressing the longest consecutive series of 0 values to the string '::'. I have also updated the plain #addressFromString: and #stringFromAddress: methods to first try and see if they are dealing with what appears to be and IPv6 string/bytes and to call the IPv6 specialized versions of the method if so. =============== Diff against Network-ct.245 =============== Item was added: + ----- Method: NetNameResolver class>>addressFromIPv6String: (in category 'address string utils') ----- + addressFromIPv6String: aString + "Return a ByteArray corresponding to an IPv6 address in text format" + | stream headStream headBytes tailStream tailBytes hextets | + headStream := WriteStream on: ByteArray new. + tailStream := WriteStream on: ByteArray new. + + "Obtain a collection of the string hextets from the + original IPv6 string. Any instance of a double colon (::) + will be present in the list as an empty string." + hextets := self splitIPv6HextetsOn: aString. + Transcript show: hextets; cr. + stream := hextets readStream. + (stream upTo: '') do: [ :hextet | + headStream nextPutAll: (ByteArray readHexFrom: hextet) ]. + (stream upToEnd) do: [ :hextet | + tailStream nextPutAll: (ByteArray readHexFrom: hextet) ]. + headBytes := headStream contents. + tailBytes := tailStream contents. + + "If the total number of bytes is less than 16, that means + we have a compressed range of 0-value hextets specified + using the double colon (::). We add these at the end of + the headBytes collection" + (16 - (headBytes size + tailBytes size)) timesRepeat: [ + headBytes := headBytes,#[0] ]. + + ^ headBytes,tailBytes! Item was changed: ----- Method: NetNameResolver class>>addressFromString: (in category 'address string utils') ----- addressFromString: addressString "Return the internet address represented by the given string. The string should contain four positive decimal integers delimited by periods, commas, or spaces, where each integer represents one address byte. Return nil if the string is not a host address in an acceptable format." "NetNameResolver addressFromString: '1.2.3.4'" "NetNameResolver addressFromString: '1,2,3,4'" "NetNameResolver addressFromString: '1 2 3 4'" | newAddr s byte delimiter | + "If the address string contains a colon, then we + consider it an IPv6 address" + (addressString includes: $:) ifTrue: [ ^ self addressFromIPv6String: addressString ]. + + "Otherwise parse as a normal IPv4 string" newAddr := ByteArray new: 4. s := ReadStream on: addressString. s skipSeparators. 1 to: 4 do: [:i | byte := self readDecimalByteFrom: s. byte = nil ifTrue: [^ nil]. newAddr at: i put: byte. i < 4 ifTrue: [ delimiter := s next. ((delimiter = $.) or: [(delimiter = $,) or: [delimiter = $ ]]) ifFalse: [^ nil]]]. ^ newAddr ! Item was added: + ----- Method: NetNameResolver class>>findLongestIPv6ZerosIn: (in category 'private') ----- + findLongestIPv6ZerosIn: aCollection + "Given a collection of Integers, find the longest (or leftmost) + range of contiguous consecutive zero values (if any). + Respond with a size 2 array corresponding to the start + and end index, or nil if there are no zero ranges at all" + | active start end cursor ranges largest firstLargest | + active := false. "Whether or not the beginning of some range has been found" + start := 0. + end := 0. + ranges := OrderedCollection new. + cursor := 1. + [ cursor < aCollection size ] whileTrue: [ + | current next isConsecutive | + current := aCollection at: cursor. + next := aCollection at: cursor + 1. + isConsecutive := (current = 0) and: [ next = 0]. + + isConsecutive + ifTrue: [ + active + ifFalse: [ + "If the current values are consecutive zeros, + and we are not active, set active to true and update + the start and end values." + start := cursor. + end := cursor + 1. + active := true ] + ifTrue: [ + "If the current values are consecutive zeros, + and we _are_ active, this means we need to just + update the end" + end := cursor + 1 ] ]. + + + "If we are active, but the values are _not_ consecutive, + it means we've reached the end of a range" + ((active and: [ isConsecutive not ]) or: [ (active and: [ (cursor + 1) = aCollection size ])]) + ifTrue: [ + active := false. + ranges add: { start. end }. + start := 0. + end := 0 ]. + + "Increment the cursor" + cursor := cursor + 1. + ]. + + "If there are no zero ranges, return nil." + ranges ifEmpty: [ ^ nil ]. + + "Otherwise, return the longest range. + If there are multiple ranges with the same size, + return the first (leftmost) encountered." + largest := 0. + firstLargest := 1. "index of the first instance of the largest value, in case there are multiple with same size" + (ranges collect: [ :range | + (range last - range first )]) doWithIndex: [ :rangeSize :index | + rangeSize > largest ifTrue: [ + largest := rangeSize. + firstLargest := index ] ]. + + ^ ranges at: firstLargest! Item was added: + ----- Method: NetNameResolver class>>putIPv6HexIntegers:on: (in category 'private') ----- + putIPv6HexIntegers: aCollection on: aWriteStream + "Given a collection of Integers, convert them to + hex strings and join them with the ':' separator + on the given write stream" + aCollection + do: [ :integer | + aWriteStream nextPutAll: (integer printStringBase: 16) asLowercase ] + separatedBy: [ aWriteStream nextPut: $: ] + + ! Item was added: + ----- Method: NetNameResolver class>>splitIPv6HextetsOn: (in category 'private') ----- + splitIPv6HextetsOn: aString + "Respond with a collection of hextet strings extracted + from a single string in IPv6 format. These are separated + by the $: character. + We avoid using #splitOn: or #splitBy: since they + are not consistent across Smalltalks" + | stream result | + result := OrderedCollection new. + stream := aString readStream. + [ stream atEnd ] whileFalse: [ + "Pad any valid hextets so that they are each length 4, + ie they have the leading zeros. This is so that ByteArray class >> #readFromHex: + will work properly -- it does not correctly parse hextets without the leading zeros." + | next | + next := stream upTo: $:. + (next = '') + ifTrue: [ result add: next ] + ifFalse: [ + (4 - next size) timesRepeat: [ + next := '0',next ]. + result add: next ] ]. + + ^ result! Item was changed: ----- Method: NetNameResolver class>>stringFromAddress: (in category 'address string utils') ----- stringFromAddress: addr "Return a string representing the given host address as four decimal bytes delimited with decimal points." "NetNameResolver stringFromAddress: NetNameResolver localHostAddress" | s | (addr isKindOf: SocketAddress) ifTrue: [^addr printString copyUpTo: $( ]. + "If the incoming addr is a size 16 ByteArray, we assume it is + representing an IPv6 address." + (addr size = 16) ifTrue: [ ^ self stringFromIPv6Address: addr ]. + + "Otherwise write out in IPv4 format" s := WriteStream on: ''. 1 to: 3 do: [ :i | (addr at: i) printOn: s. s nextPut: $.]. (addr at: 4) printOn: s. ^ s contents ! Item was added: + ----- Method: NetNameResolver class>>stringFromIPv6Address: (in category 'address string utils') ----- + stringFromIPv6Address: aByteArray + "Respond with a correctly formatted IPv6 string + parsed from the incoming ByteArray. + Note the 'compressed-zero' rule for IPv6 address strings: + the longest contiguous range of two or more consecutive + 0 values can be compressed to '::'. + If there are two ranges of the same size, use the leftmost" + | readStream integerCollection indices writeStream | + + "If the ByteArray as an Integer is zero (ie, it's all zeros), + then just return the double colon" + aByteArray asInteger = 0 ifTrue: [ ^ '::' ]. + + readStream := aByteArray readStream. + integerCollection := OrderedCollection new. + [ readStream atEnd ] whileFalse: [ + integerCollection add: (readStream next: 2) asInteger ]. + + "Find the start and end indices of the longest + contiguous set of zeroes, if any" + writeStream := WriteStream on: String new. + indices := self findLongestIPv6ZerosIn: integerCollection. + indices ifNil: [ + self putIPv6HexIntegers: integerCollection on: writeStream. + ^ writeStream contents ]. + + "If the start index of the zeros is 1, then there are contiguous + zeros at the beginning of the string" + (indices first = 1) ifTrue: [ + writeStream nextPutAll: '::'. + self + putIPv6HexIntegers: (integerCollection copyFrom: (indices second + 1) to: integerCollection size) + on: writeStream. + ^ writeStream contents ]. + + "If the end index of the zeros is the same as the size + of the collection of integers, then there are contiguous + zeros at the end of the string." + (indices second = integerCollection size) + ifTrue: [ + self + putIPv6HexIntegers: (integerCollection copyFrom: 1 to: (indices first - 1)) + on: writeStream. + writeStream nextPutAll: '::'. + ^ writeStream contents ]. + + "Otherwise, there is a range of zeros somewhere in the middle + of the string that should get compressed. Write normal strings for + each side out of the range of the indices, then join them by the + compression string (::)" + self + putIPv6HexIntegers: (integerCollection copyFrom: 1 to: (indices first - 1)) + on: writeStream. + writeStream nextPutAll: '::'. + self + putIPv6HexIntegers: (integerCollection copyFrom: (indices second + 1) to: integerCollection size) + on: writeStream. + ^ writeStream contents + + + !

4 5

The Trunk: Tests-eem.464.mcz
by commits＠source.squeak.org 27 Jul '21

27 Jul '21

Eliot Miranda uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-eem.464.mcz ==================== Summary ==================== Name: Tests-eem.464 Author: eem Time: 26 July 2021, 9:14:45.156871 pm UUID: 0bae90ef-3457-4e4a-955d-42f207da8dea Ancestors: Tests-jar.463 Have BitmapStreamTests>>testOtherClasses test core Collections RawBitsArray concrete subclasses. =============== Diff against Tests-jar.463 =============== Item was changed: ----- Method: BitmapStreamTests>>testOtherClasses (in category 'tests-misc') ----- testOtherClasses + #(WordArrayForSegment Float32Array Float64Array PointArray IntegerArray SoundBuffer String ShortPointArray ShortIntegerArray WordArray Array ByteArray Bitmap ColorArray ) do: + [:className | | a | + a := (Smalltalk at: className) new: 3. + self assert: a byteSize equals: a basicSize * a bytesPerBasicElement]. + RawBitsArray allSubclassesDo: + [:class| | a | + (class isAbstract or: [class category ~~ RawBitsArray category]) ifFalse: + [a := class new: 3. + self assert: a byteSize equals: a basicSize * a bytesPerBasicElement]] + + "self new testOtherClasses"! - #(WordArrayForSegment FloatArray PointArray IntegerArray SoundBuffer String ShortPointArray ShortIntegerArray WordArray Array ByteArray Bitmap ColorArray ) do: [:s | | a | - a := (Smalltalk at: s) new: 3. - self assert: a byteSize equals: a basicSize * a bytesPerBasicElement. ] - !

1 0

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

Jump to page: