Squeak-dev December 2021

squeak-dev@lists.squeakfoundation.org

30 participants
391 discussions

The Trunk: Morphic-mt.1812.mcz
by commits＠source.squeak.org 11 Jan '22

11 Jan '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1812.mcz ==================== Summary ==================== Name: Morphic-mt.1812 Author: mt Time: 4 December 2021, 12:26:07.860493 pm UUID: 89876df1-baaa-314b-9274-bc585d62f388 Ancestors: Morphic-mt.1811 Removes US-layout specific keyboard shortcuts for 'Enclose selection' in favor of the cross-platform compatible preference 'Enclose selection with brackets'. Just type the bracket character like you would in normal text editing. No extra shortcut to remember. Note that the "replace expression" operation needs an extra Del/Backspace hit if "Enclose selection with brackets" is enabled (by default). Note that dead keys might be an issue when the second key press yields two characters, which effectively toggles the brackets around the selection twice. I did observe that with the single-quote/double-quote key in an US-layout on Windows 10. =============== Diff against Morphic-mt.1811 =============== Item was changed: ----- Method: TextEditor class>>encloseSelection (in category 'preferences') ----- encloseSelection <preference: 'Enclose selection with brackets () {} [] '''' "" || <>' categoryList: #('Morphic' 'editing') description: 'When true, selecting text and typing an opening parenthesis, bracket, square-bracket, single quote, or double quote will add corresponding character around the selection without requiring a cmd key.' type: #Boolean> + ^ EncloseSelection ifNil: [ true ]! - ^ EncloseSelection ifNil: [ false ]! Item was changed: ----- Method: TextEditor class>>initializeCmdKeyShortcuts (in category 'keyboard shortcut tables') ----- initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "TextEditor initialize" | cmdMap cmds | cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdMap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key" '0123456789-=' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:]. - - '([<{|"''' do: [:char | cmdMap at: char asciiValue + 1 put: #enclose:]. cmds := #($a #selectAll: $c #copySelection: $e #exchange: $f #find: $g #findAgain: $j #doAgain: $k #offerFontMenu: $u #align: $v #paste: $w #backWord: $x #cut: $y #swapChars: $z #undo:). 1 to: cmds size by: 2 do: [:i | cmdMap at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)]. cmdActions := cmdMap! Item was changed: ----- Method: TextEditor class>>initializeShiftCmdKeyShortcuts (in category 'keyboard shortcut tables') ----- initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values." "TextEditor initialize" | cmdMap cmds | "shift-command and control shortcuts" cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" cmdMap at: (32 + 1) put: #selectWord:. "space bar key" cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" cmdMap at: (127 + 1) put: #forwardDelete:. "del key" - "On some keyboards, these characters require a shift" - '([<{|"''9' do: [:char | cmdMap at: char asciiValue + 1 put: #enclose:]. - - "NB: sw 12/9/2001 commented out the idiosyncratic line just below, which was grabbing shift-esc in the text editor and hence which argued with the wish to have shift-esc be a universal gesture for escaping the local context and calling up the desktop menu." - "cmdMap at: (27 + 1) put: #shiftEnclose:." "ctrl-[" - - "'""''(' do: [ :char | cmdMap at: (char asciiValue + 1) put: #enclose:]." - cmds := #( $c compareToClipboard: $h cursorTopHome: $j doAgainUpToEnd: $k changeStyle: $m selectCurrentTypeIn: $s findAgain: $u changeLfToCr: $x makeLowercase: $y makeUppercase: $z redo: "makeCapitalized:" ). 1 to: cmds size by: 2 do: [ :i | cmdMap at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1). "plain keys" cmdMap at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1). "shifted keys" cmdMap at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1). "ctrl keys" ]. shiftCmdActions := cmdMap! Item was changed: ----- Method: TextEditor>>enclose: (in category 'editing keys') ----- enclose: aKeyboardEvent "Insert or remove bracket characters around the current selection." | character left right startIndex stopIndex oldSelection which t | + character := aKeyboardEvent keyCharacter. - character := aKeyboardEvent shiftPressed - ifTrue: ['{}|"<>' at: ('[]\'',.' indexOf: aKeyboardEvent keyCharacter) ifAbsent: [aKeyboardEvent keyCharacter]] - ifFalse: [aKeyboardEvent keyCharacter]. self closeTypeIn. startIndex := self startIndex. stopIndex := self stopIndex. oldSelection := self selection. + which := '([<{|"''' indexOf: character ifAbsent: [ ^ false ]. + left := '([<{|"''' at: which. + right := ')]>}|"''' at: which. - which := '([<{|"''9' indexOf: character ifAbsent: [ ^ false ]. - "Allow Control key in lieu of Alt+Shift for (, {, and double-quote." - left := ((Preferences cmdKeysInText and: [ aKeyboardEvent controlKeyPressed ]) - ifTrue: [ '({<{|""(' ] - ifFalse: ['([<{|"''(']) at: which. - right := ((Preferences cmdKeysInText and: [ aKeyboardEvent controlKeyPressed ]) - ifTrue: [ ')}>}|"")' ] - ifFalse: [')]>}|"'')']) at: which. t := self text. ((startIndex > 1 and: [stopIndex <= t size]) and: [ (t at: startIndex-1) = left and: [(t at: stopIndex) = right]]) ifTrue: ["already enclosed; strip off brackets" self selectFrom: startIndex-1 to: stopIndex. self replaceSelectionWith: oldSelection] ifFalse: ["not enclosed; enclose by matching brackets" self replaceSelectionWith: (Text string: (String with: left), oldSelection string, (String with: right) attributes: emphasisHere). self selectFrom: startIndex+1 to: stopIndex]. ^true! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'Editor initialize. "Removes US-layout specific keyboard shortcuts for ''Enclose selection'' in favor of the cross-platform compatible preference ''Enclose selection with brackets''."'! - (PackageInfo named: 'Morphic') postscript: 'SystemProgressMorph reset. "New layer number" - - "Morphic-ct.1796 - Inverts the preference ''halo encloses full bounds'' by pressing the control key while invocating a halo." - (Preferences preferenceAt: #haloEnclosesFullBounds) instVarNamed: ''helpString'' put: ''If enabled, halos will enclose the full bounds of the target morph, rather than just the bounds. You can also invert this behavior temporarily by holding down Ctrl while invoking a halo on a morph.''.'!

5 7

deprecation policy
by Nicolas Cellier 10 Jan '22

10 Jan '22

Hi all, 60Deprecated refers to WindowColorSpec But WindowColorSpec was in 51Deprecated which is no more in the update map. So we must clarify a bit... Deprecated(n) cannot refer to Deprecated(n-1), otherwise we can never remove the deprecated packages... I suggest we move WindoColorSpec from 51Deprecated to 60Deprecated and emit a new version for each of these... Thoughts? Nicolas

3 2

The Inbox: SUnit-ct.132.mcz
by commits＠source.squeak.org 10 Jan '22

10 Jan '22

A new version of SUnit was added to project The Inbox: http://source.squeak.org/inbox/SUnit-ct.132.mcz ==================== Summary ==================== Name: SUnit-ct.132 Author: ct Time: 6 March 2021, 12:35:33.710439 am UUID: 98d667df-13be-d148-9117-0b214c9adb3f Ancestors: SUnit-nice.124 Refactors and completes equality assertions - Add #deny:equals:description:, #deny:identical:, and #deny:identical:description: - Revise default description message for #deny:equals:, aligning it to #assert:equals: description - Make equality assertions capable of lazy descriptions (aStringOrBlock), aligning them to #assert:description: etc. - Add multilingual support for default description messages - Some internal refactoring - Improve test coverage of these assertions in SUnitTest Thanks to Marcel for pointing to the idea! Uploaded again to resolve conflicts with SUnit-pre.122 (recategorization). Replaces SUnit-ct.126 which can be moved into the treated inbox. :-) =============== Diff against SUnit-nice.124 =============== Item was added: + ----- Method: SUnitTest>>testAssertEquals (in category 'tests') ----- + testAssertEquals + + | a b | + a := 'foo'. + b := 'bar'. + + self shouldnt: [self assert: a equals: a copy] raise: TestFailure. + + self should: [self assert: a equals: b] raise: TestFailure. + + [self assert: a equals: b] + on: TestFailure do: [:ex | + | error | + error := ex messageText. + self + assert: (error includesSubstring: a) + description: 'Error message doesn''t include the expected value'. + self + assert: (error includesSubstring: b) + description: 'Error message doesn''t include the actual value'].! Item was added: + ----- Method: SUnitTest>>testAssertEqualsDescription (in category 'tests') ----- + testAssertEqualsDescription + + | a b called | + a := 'foo'. + b := 'bar'. + + self shouldnt: [self assert: a equals: a copy description: 'A description42'] raise: TestFailure. + + self should: [self assert: a equals: b description: 'A description42'] raise: TestFailure. + + [self assert: a equals: b description: 'A description42'] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'A description42') + description: 'Error message doesn''t give you the description']. + + called := false. + self shouldnt: [self assert: a equals: a description: [called := true]] raise: TestFailure. + self deny: called description: 'Description block was evaluated prematurely'. + + [self assert: a equals: b description: ['A generated description' asUppercase]] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'A generated description' asUppercase) + description: 'Error message doesn''t give you the generated description'].! Item was changed: ----- Method: SUnitTest>>testAssertIdentical (in category 'tests') ----- testAssertIdentical + | a b | a := 'foo'. b := 'bar'. + + self shouldnt: [self assert: a identical: a] raise: TestFailure. + self should: [self assert: a identical: b] raise: TestFailure. + + [self assert: a identical: b] + on: TestFailure do: [:ex | + | error | + error := ex messageText. + self + assert: (error includesSubstring: a) + description: 'Error message doesn''t include the expected value'. + self + assert: (error includesSubstring: b) + description: 'Error message doesn''t include the actual value'].! - [self assert: a identical: b] on: TestFailure do: [:e | |error| - error := e messageText. - self assert: (error includesSubstring: a) description: 'Error message doesn''t include the expected value'. - self assert: (error includesSubstring: b) description: 'Error message doesn''t include the expected value'].! Item was changed: ----- Method: SUnitTest>>testAssertIdenticalDescription (in category 'tests') ----- testAssertIdenticalDescription + + | a b called | - | a b | a := 'foo'. b := a copy. + + self shouldnt: [self assert: a identical: a description: 'A description42'] raise: TestFailure. + + self should: [self assert: a identical: b description: 'A description42'] raise: TestFailure. + + [self assert: a identical: b description: 'A description42'] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'A description42') + description: 'Error message doesn''t give you the description']. + + called := false. + self shouldnt: [self assert: a identical: a description: [called := true]] raise: TestFailure. + self deny: called description: 'Description block was evaluated prematurely'. + + [self assert: a identical: b description: ['A generated description' asUppercase]] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'A generated description' asUppercase) + description: 'Error message doesn''t give you the generated description'].! - self should: [self assert: a identical: b description: 'A desciption'] raise: TestFailure. - [self assert: a identical: b description: 'A desciption'] on: TestFailure do: [:e | |error| - error := e messageText. - self assert: (error includesSubstring: 'A desciption') description: 'Error message doesn''t give you the description'].! Item was changed: ----- Method: SUnitTest>>testAssertIdenticalWithEqualObjects (in category 'tests') ----- testAssertIdenticalWithEqualObjects + | a b | a := 'foo'. b := a copy. + self should: [self assert: a identical: b] raise: TestFailure. + + [self assert: a identical: b] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'not identical') + description: 'Error message doesn''t say the two things aren''t identical'].! - [self assert: a identical: b] on: TestFailure do: [:e | |error| - error := e messageText. - self assert: (error includesSubstring: 'not identical') description: 'Error message doesn''t say the two things aren''t identical'].! Item was added: + ----- Method: SUnitTest>>testDenyEquals (in category 'tests') ----- + testDenyEquals + + | a b | + a := 'foo'. + b := 'bar'. + + self shouldnt: [self deny: a equals: b] raise: TestFailure. + + self should: [self deny: a equals: a copy] raise: TestFailure. + + [self deny: a equals: a] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: a) + description: 'Error message doesn''t include the unexpected value'].! Item was added: + ----- Method: SUnitTest>>testDenyEqualsDescription (in category 'tests') ----- + testDenyEqualsDescription + + | a b called | + a := 'foo'. + b := 'bar'. + + self shouldnt: [self deny: a equals: b description: 'A description42'] raise: TestFailure. + + self should: [self deny: a equals: a copy description: 'A description42'] raise: TestFailure. + + [self deny: a equals: a description: 'A description42'] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'A description42') + description: 'Error message doesn''t give you the description']. + + called := false. + self shouldnt: [self deny: a equals: b description: [called := true]] raise: TestFailure. + self deny: called description: 'Description block was evaluated prematurely'. + + [self deny: a equals: a description: ['A generated description' asUppercase]] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'A generated description' asUppercase) + description: 'Error message doesn''t give you the generated description'].! Item was added: + ----- Method: SUnitTest>>testDenyIdentical (in category 'tests') ----- + testDenyIdentical + + | a b | + a := 'foo'. + b := 'bar'. + self shouldnt: [self deny: a identical: b] raise: TestFailure. + self should: [self deny: a identical: a] raise: TestFailure. + [self deny: a identical: a] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: a) + description: 'Error message doesn''t include the unexpected value'].! Item was added: + ----- Method: SUnitTest>>testDenyIdenticalDescription (in category 'tests') ----- + testDenyIdenticalDescription + + | a b called | + a := 'foo'. + b := a copy. + + self shouldnt: [self deny: a identical: b description: 'A description42'] raise: TestFailure. + + self should: [self deny: a identical: a description: 'A description42'] raise: TestFailure. + + [self deny: a identical: a description: 'A description42'] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'A description42') + description: 'Error message doesn''t give you the description']. + + called := false. + self shouldnt: [self deny: a identical: b description: [called := true]] raise: TestFailure. + self deny: called description: 'Description block was evaluated prematurely'. + + [self deny: a identical: a description: ['A generated description' asUppercase]] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'A generated description' asUppercase) + description: 'Error message doesn''t give you the description'].! Item was added: + ----- Method: SUnitTest>>testDenyIdenticalWithEqualObjects (in category 'tests') ----- + testDenyIdenticalWithEqualObjects + + | a b | + a := 'foo'. + b := a copy. + self should: [self deny: a identical: a] raise: TestFailure. + [self deny: a identical: a] + on: TestFailure do: [:ex | + self + assert: (ex messageText includesSubstring: 'identical') + description: 'Error message doesn''t say the two things are identical'].! Item was changed: ----- Method: TestCase>>assert:equals: (in category 'asserting') ----- assert: expected equals: actual + ^ self + assert: expected + equals: actual + description: nil - ^self - assert: expected = actual - description: [ self comparingStringBetween: expected and: actual ] ! Item was changed: ----- Method: TestCase>>assert:equals:description: (in category 'asserting') ----- + assert: expected equals: actual description: aStringOrBlock - assert: expected equals: actual description: aString + ^ self - ^self assert: expected = actual + description: [self + description: aStringOrBlock + with: (self comparingStringBetween: expected and: actual)]! - description: [ aString , ': ', (self comparingStringBetween: expected and: actual) ]! Item was changed: ----- Method: TestCase>>assert:identical: (in category 'asserting') ----- assert: expected identical: actual + ^ self + assert: expected + identical: actual + description: nil! - ^self - assert: expected == actual - description: [ self comparingStringBetweenIdentical: expected and: actual ] - ! Item was changed: ----- Method: TestCase>>assert:identical:description: (in category 'asserting') ----- + assert: expected identical: actual description: aStringOrBlock - assert: expected identical: actual description: aString + ^ self - ^self assert: expected == actual + description: [self + description: aStringOrBlock + with: (self comparingStringBetween: expected andIdentical: actual)]! - description: [ aString , ': ', (self comparingStringBetweenIdentical: expected and: actual) ]! Item was changed: ----- Method: TestCase>>comparingStringBetween:and: (in category 'private') ----- comparingStringBetween: expected and: actual + + ^ 'Expected {1} but was {2}.' translated + format: { + expected printStringLimitedTo: 10. + actual printStringLimitedTo: 10 }! - ^ String streamContents: [:stream | - stream - nextPutAll: 'Expected '; - nextPutAll: (expected printStringLimitedTo: 10); - nextPutAll: ' but was '; - nextPutAll: (actual printStringLimitedTo: 10); - nextPutAll: '.' - ]! Item was added: + ----- Method: TestCase>>comparingStringBetween:andIdentical: (in category 'private') ----- + comparingStringBetween: expected andIdentical: actual + + ^ 'Expected {1} and actual {2} are not identical.' translated + format: { + expected printStringLimitedTo: 10. + actual printStringLimitedTo: 10 }! Item was changed: ----- Method: TestCase>>comparingStringBetweenIdentical:and: (in category 'private') ----- comparingStringBetweenIdentical: expected and: actual + + self deprecated. + ^ self comparingStringBetween: expected andIdentical: actual! - ^ 'Expected {1} and actual {2} are not identical.' format: { - expected printStringLimitedTo: 10. - actual printStringLimitedTo: 10. - }! Item was added: + ----- Method: TestCase>>comparingStringBetweenUnexpected:and: (in category 'private') ----- + comparingStringBetweenUnexpected: unexpected and: actual + + ^ 'Did not expect {1} but was {2}.' translated + format: { + unexpected printStringLimitedTo: 10. + actual printStringLimitedTo: 10 }! Item was added: + ----- Method: TestCase>>comparingStringBetweenUnexpected:andIdentical: (in category 'private') ----- + comparingStringBetweenUnexpected: expected andIdentical: actual + + ^ 'Unexpected {1} and actual {2} are identical.' translated + format: { + expected printStringLimitedTo: 10. + actual printStringLimitedTo: 10 }! Item was changed: ----- Method: TestCase>>deny:equals: (in category 'asserting') ----- deny: unexpected equals: actual + ^ self + deny: unexpected + equals: actual + description: nil! - ^self - deny: unexpected = actual - description: 'Actual equals unexpected' - ! Item was added: + ----- Method: TestCase>>deny:equals:description: (in category 'asserting') ----- + deny: unexpected equals: actual description: aStringOrBlock + + ^ self + deny: unexpected = actual + description: [self + description: aStringOrBlock + with: (self comparingStringBetweenUnexpected: unexpected and: actual)]! Item was added: + ----- Method: TestCase>>deny:identical: (in category 'asserting') ----- + deny: unexpected identical: actual + + ^ self + deny: unexpected + identical: actual + description: nil! Item was added: + ----- Method: TestCase>>deny:identical:description: (in category 'asserting') ----- + deny: unexpected identical: actual description: aStringOrBlock + + ^ self + deny: unexpected == actual + description: [self + description: aStringOrBlock + with: (self comparingStringBetweenUnexpected: unexpected andIdentical: actual)]! Item was added: + ----- Method: TestCase>>description:with: (in category 'private') ----- + description: aStringOrBlock with: reason + + | description | + description := aStringOrBlock value. + ^ description + ifNil: [reason] + ifNotNil: ['{1}: {2}' translated format: {description. reason}]!

4 5

The Inbox: SUnitTools-ct.5.mcz
by commits＠source.squeak.org 10 Jan '22

10 Jan '22

A new version of SUnitTools was added to project The Inbox: http://source.squeak.org/inbox/SUnitTools-ct.5.mcz ==================== Summary ==================== Name: SUnitTools-ct.5 Author: ct Time: 31 May 2019, 2:15:36.714053 pm UUID: 397d3b85-7ac5-3645-baa9-b9f848d90880 Ancestors: SUnitTools-tcj.4 Change CodeHolder>>testRunSuite: -- if multiple tests fail, instead of a UIManager dialog, open a TestRunner window that provides specific information. Depends on SUnitGUI-ct.70. =============== Diff against SUnitTools-tcj.4 =============== Item was changed: ----- Method: CodeHolder>>testRunSuite: (in category '*SUnitTools-running') ----- testRunSuite: suite + | runner result | + (suite isKindOf: TestCase) + ifFalse: [ + runner := TestRunner newForSuite: suite. + result := runner runAll; result] + ifTrue: [result := suite run]. - | result | - result := suite run. (result respondsTo: #dispatchResultsIntoHistory) ifTrue: [result dispatchResultsIntoHistory]. result hasPassed ifTrue: [^ self]. + result defects size = 1 + ifTrue: [result defects anyOne debug] + ifFalse: [runner open]! - (result defects size = 1 - ifTrue: [result defects anyOne] - ifFalse: [UIManager default - chooseFrom: (result defects collect: [:each | each class name , '>>' , each selector printString]) - values: result defects - title: ('{1} passes, {2} failures, {3} errors\\Debug a failure or error?' format: { - result runCount . result failureCount . result errorCount}) withCRs] - ) ifNotNil: [:defect | defect debug]. - !

4 3

The Trunk: Sound-ct.71.mcz
by commits＠source.squeak.org 10 Jan '22

10 Jan '22

David T. Lewis uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-ct.71.mcz ==================== Summary ==================== Name: Sound-ct.71 Author: ct Time: 1 September 2020, 2:07:15.07999 am UUID: 0d91a1bf-41cb-834c-ab0c-fa2ad832e408 Ancestors: Sound-nice.69 Fixes wave sound streaming on non-filestream objects. The endianness was inverted because #int16: already uses Big Endian. This did not sound well - listen yourself in an unpatched image: :-) array := ByteArray streamContents: [:stream | PluckedSound bachFugue storeWAVSamplesOn: stream]. (FileStream fileNamed: 'bachFugue.wav') binary in: [:stream | [array do: [:ea | stream nextPut: ea]] ensure: [stream close]]. (SampledSound fromWaveFileNamed: 'bachFugue.wav') play. Please review in detail as this is one of my first contacts to the Sound system! =============== Diff against Sound-nice.69 =============== Item was changed: ----- Method: AbstractSound>>storeSampleCount:bigEndian:on: (in category 'file i/o') ----- storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files). If self isStereo is true, both channels are stored, creating a stereo file. Otherwise, only the left channel is stored, creating a mono file." + | bufSize stereoBuffer reverseBytes streamDirect | - | bufSize stereoBuffer reverseBytes | self reset. bufSize := (2 * self samplingRate rounded) min: samplesToStore. "two second buffer" stereoBuffer := SoundBuffer newStereoSampleCount: bufSize. + streamDirect := aBinaryStream isKindOf: StandardFileStream. + reverseBytes := (bigEndianFlag xor: Smalltalk isBigEndian) xor: streamDirect not. - reverseBytes := bigEndianFlag ~= (Smalltalk isBigEndian). 'Storing audio...' displayProgressFrom: 0 to: samplesToStore during: [:bar | | remaining out | remaining := samplesToStore. [remaining > 0] whileTrue: [ bar value: samplesToStore - remaining. stereoBuffer primFill: 0. "clear the buffer" self playSampleCount: (bufSize min: remaining) into: stereoBuffer startingAt: 1. out := self isStereo ifTrue: [stereoBuffer] ifFalse: [stereoBuffer extractLeftChannel]. reverseBytes ifTrue: [out reverseEndianness]. + streamDirect - (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ "optimization for files: write sound buffer directly to file" aBinaryStream next: (out size // 2) putAll: out startingAt: 1] "size in words" ifFalse: [ "for non-file streams:" 1 to: out monoSampleCount do: [:i | aBinaryStream int16: (out at: i)]]. + remaining := remaining - bufSize]].! - remaining := remaining - bufSize]]. - !

4 5

Process #suspend / #resume semantics
by mail＠jaromir.net 07 Jan '22

07 Jan '22

Hi all, What is the desirable semantics of resuming a previously suspended process? #resume's comment says: "Allow the process that the receiver represents to continue. Put the receiver in *line to become the activeProcess*." The side-effect of this is that a terminating process can get resumed (unless suspendedContext is set to nil - see test KernelTests-jar.417 / Inbox - which has the unfortunate side-effect of #isTerminated answer true during termination). A similar side-effect: a process originally waiting on a semaphore and then suspended can be resumed into the runnable state and get scheduled, effectively escaping the semaphore wait. Is this an expected behavior or a bug? If a bug, should a suspended process somehow remember its previous state and/or queue and return to the same one if resumed? Sorry if I'm missing something :) Best, ~~~ ^[^ Jaromir Sent from Squeak Inbox Talk

3 19

[Discussion] GIF and Animated GIF Refactoring
by Eric Gade 06 Jan '22

06 Jan '22

Hi all, I am responsible for the re-implementation of GIFReadWriter in Pharo from a few years ago (see this PR <https://github.com/pharo-project/pharo/pull/1666>). Earlier this week I was able to successfully port most of that work to Cuis, so I thought I'd take a stab at Squeak too. Unlike Pharo and Cuis, however, Squeak already has a class `AnimatedImageMorph`. I wanted to discuss my proposed changes here for this reason, prior to submitting any formal changes to the inbox. So here's what I've done so far: First, as with Pharo and Cuis, `GIFReadWriter` has been completely refactored to have a more clear and more complete implementation of the GIF format. This includes separating out the compression activity into two helper classes (`LzwGifEncoder` and `LzwGifDecoder`), as well as completely removing the existing `AnimatedGIFReadWriter` class. I have also added the `AnimatedImageFrame` class for composing GIF frame information that can be used by other classes -- both for writing and for displaying. Second, I have refactored the existing `AnimatedImageMorph` in Squeak to better deal with displaying real-life animated GIFs. Prior to this, many GIFs would display incorrectly due to the nature of GIF frame compositing and disposal. All of the test GIFs I've tried so far (and there have been a lot) seem to be working well with this class. Third, I have created an alternative class -- presumptuously named `BetterAnimatedImageMorph` -- that has some optimizations. The regular `AnimatedImageMorph` does the GIF frame/form compositing "on the fly," which results in a lot of extra computation each time the animation loops. The upshot here is that we cannot achieve real framerates for some GIFs -- they always play slower in Squeak than they would in a browser regardless of how low one sets the stepTime/delay. `BetterAnimatedImageMorph` takes a different approach: it loops through all the GIFReadWriter's read-in frames and first creates a collection of fully composited Forms. It then simply changes the current form to be displayed at each step. In my tests this has resulted in much more performant playback, of which I have provided examples (see below). One issue with `BetterAnimatedImageMorph` is that the original information about the constituent forms of the GIF is "lost". Attempting to write it back to a GIF file will necessarily result in a larger file than the original, because most animated GIFs are made of frames that are "diffed" in a sense. There are a couple of ways to deal with this though, such as caching the original frame data etc. My concrete proposals, then, would be the following: 1. Remove AnimatedGIFReadWriter and replace GIFReadWriter with my updated version (along with helper classes) 2. Replace AnimatedImageMorph with my new BetterAnimatedImageMorph If you've read this far and have the patience to try it out, I have my working code up online at https://gitlab.com/darth-cheney/squeak-animated-gif Load this code in Squot and check it out. Try some of the examples in the FunGIFExamples class (on the class side). In particular, any class method starting with `example` should be good fun. For a live comparison of the performance between my `BetterAnimatedImageMorph` and the current `AnimatedImageMorph`, do `FunGIFExamples animatedImageMorphComparison` and you should be able to see the issue right away. Any feedback is greatly appreciated here, and hopefully we can get this or something like it into the main image. GIFs are too fun to leave out! -- Eric

4 16

Re: [squeak-dev] ExtendedClipboardInterface and ClipboardExtendedPlugin state?
by Bernhard Pieber 03 Jan '22

03 Jan '22

Hi, Maybe this question is better asked on the vm-dev list. Does anyone know the status of the ClipboardExtendedPlugin? Happy New Year! Bernhard > Am 20.12.2021 um 09:38 schrieb Bernhard Pieber <bernhard(a)pieber.com>: > > Hi everyone, > > I tried to copy a form as PNG to the clipboard like this: > ExtendedClipboardInterface current addClipboardDataConvertFormToPNG: self imageForm > > This seems not to work correctly. If I paste it to TextEdit I get the binary data starting with PNG instead of the image itself. It looks as if the ClipboardExtendedPlugin is not loaded. The plugin seems to be in the current VM source (src/pugins/ClipboardExtendedPlugin), though. I am on macOS Big Sur 11.6.1. > > Should this work? I tried on Squeak 3.4, 4.6 and 5.3 but the ExtendedClipboardInterface is not loaded in these images. > > Cheers, > Bernhard

3 3

The Inbox: Monticello-ct.729.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

A new version of Monticello was added to project The Inbox: http://source.squeak.org/inbox/Monticello-ct.729.mcz ==================== Summary ==================== Name: Monticello-ct.729 Author: ct Time: 17 September 2020, 7:04:53.385813 pm UUID: 5eea47cc-405e-7841-9544-0f57a9b92fa0 Ancestors: Monticello-cmm.726 Proposal: Enhance truncation of "newer versions avaiable" warning (and make it multilingual-ready) =============== Diff against Monticello-cmm.726 =============== Item was changed: ----- Method: MCWorkingCopyBrowser>>checkForNewerVersions (in category 'actions') ----- checkForNewerVersions + "Answer true if there are no newer versions preventing us from saving a version." + | newer | newer := workingCopy possiblyNewerVersionsIn: self repository. + + newer ifEmpty: [^ true]. + + ^ self confirm: ('CAUTION!! {1}:\{2}\Do you really want to save this version?' withCRs translated format: { + newer size = 1 + ifTrue: ['This version in the repository may be newer' translated] + ifFalse: ['These {1} versions in the repository may be newer' translated format: {newer size}]. + (newer size > 3 + ifFalse: [newer] + ifTrue: [(newer first: 3) , {'...'} , {newer last}]) asCommaString withNoLineLongerThan: 150 + })! - ^ newer isEmpty or: [ - self confirm: 'CAUTION!! These versions in the repository may be newer:', - String cr, ((newer asCommaString withNoLineLongerThan: 150) truncateWithElipsisTo: 5 * 149), String cr, - 'Do you really want to save this version?'].!

4 4

KernelTests-ct.409
by christoph.thiede＠student.hpi.uni-potsdam.de 03 Jan '22

03 Jan '22

Note that these tests cause multiple failures in a recent VM at the time of writing: - #testPrimitive100/{'not a selector'. {}. Object}: The VM sends #doesNotUnderstand: to the receiver with an invalid selector whereas the simulator has the primitive failed as expected in Object>>perform:withArguments:inSuperclass:. What behavior do we want? (I would opt for the latter one.) - #testPrimitive118/{6. 'not a primitive'. {7}},{6. 9. 'not an array'}: The VM returns an error code of -3 whereas the simulator returns no error code (nil). I have adjust this behavior in the simulator via Kernel-ct.1420. - #testPrimitive118/{6. 118. {9. {7. 13}}}: The VM does not check the number of arguments but ignores the first one whereas the simulator has the primitive failed with #'bad number of arguments'. What behavior do we want? (I would opt for the latter one.) - #testPrimitive118/2: Context>>receiver:tryPrimitive:withArgs: seems pretty buggy; not all arguments are popped from the stack and there occur several serious stack invalidations. In my opinion most of these issues need to be addressed in the VM; if a new release wasn't just around the corner, it would be my pleasure to use these failures as some good starter entrypoints into the VMMaker project during Christmas or so. But if we are in a hurry, probably someone else wants to fix these issues earlier. Or we just mark the relevant tests as expected failures for now. PS: Please don't ask me why the diff was not sent to the list this time. There should not be any special characters! ==================== Summary ==================== Name: KernelTests-ct.409 Author: ct Time: 10 November 2021, 1:45:40.105242 am UUID: ab3db7b1-d980-5b4b-80a2-8c08bef9b23b Ancestors: KernelTests-mt.407 Adds new simulation tests for the reflection primitives 117 (primitiveExternalCall), 118 (primitiveDoPrimitiveWithArgs), and 218 (primitiveDoNamedPrimitiveWithArgs) and revises existing tests for the primitives 83 (primitivePerform), 84 (primitivePerformWithArgs), and 100 (primitivePerformInSuperclass) which do not need to be dispatched via primitive 118. =============== Diff against KernelTests-mt.407 =============== ContextTest>>testPrimitive100 {tests} · ct 11/10/2021 00:38 (changed) testPrimitive100 { {#isNil. {}. Object}. "valid 0-arg message" {#=. {true}. UndefinedObject}. "valid unary message" {#ifNil:ifNotNil:. {[2]. [:x | x]}. Object}. "valid binary message" {{}. #=. {true}. SequenceableCollection}. "mirror primitive" - {#isNil}. "missing arguments" - {#isNil. 'not an array'}. "invalid arguments" - {#isNil. {}}. "missing lookupClass" + {'not a selector'. {}. Object}. "invalid selector" + {#isNil. 'not an array'. Object}. "invalid arguments" {#isNil. {'excess arg'}. Object}. "too many arguments" {#=. {}. UndefinedObject}. "missing argument" + {#isNil. {}. 'not a class'}. "invalid lookupClass" {#isNil. {}. Boolean}. "lookupClass not in inheritance chain" - } do: [:args | + } do: [:args | | block | + block := [[nil + perform: args first + withArguments: args second + inSuperclass: args third] + on: Error do: [:ex | ex messageText]]. self - assert: (nil tryPrimitive: 100 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 100 withArgs: args])]. + assert: block value + equals: (Context runSimulated: block). + + block := [[thisContext + object: nil + perform: args first + withArguments: args second + inClass: args third] + on: Error do: [:ex | ex messageText]]. + self + assert: block value + equals: (Context runSimulated: block)]. ContextTest>>testPrimitive117 {tests} · ct 11/10/2021 00:10 + testPrimitive117 + + | input1 input2 | + "valid 0-arg primitive" + self + assert: #isNil size + equals: (Context runSimulated: [#isNil size]). + + "valid unary primitive" + self + assert: 6 + 9 + equals: (Context runSimulated: [6 + 9]). + + "superfluous arguments" + self "cascade!" + assert: 6 + 9 + equals: (Context runSimulated: [6 + 9]); + assert: true. + + self + assert: ((input1 := {1. 2. 3}) at: 2 put: 4) + equals: (Context runSimulated: [(input2 := {1. 2. 3}) at: 2 put: 4]); + assert: input1 + equals: input2. ContextTest>>testPrimitive118 {tests} · ct 11/10/2021 00:56 + testPrimitive118 + + self testPrimitive118: [:receiver :primitiveIndex :arguments | + receiver tryPrimitive: primitiveIndex withArgs: arguments]. + + self testPrimitive118: [:receiver :primitiveIndex :arguments | + thisContext receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments]. ContextTest>>testPrimitive118: {tests} · ct 11/10/2021 01:23 + testPrimitive118: primitiveBlock + + | input1 input2 | + { + {#isNil. 62. {}}. "valid 0-arg primitive" + {6. 9. {7}}. "valid unary primitive" + {6. 62. {7}}. "failing primitive" + {6. 'not a primitive'. {7}}. "invalid primitive" + {6. 9. 'not an array'}. "invalid arguments" + {#isNil. 62. {1}}. "too many arguments" + {6. 9. {}}. "missing argument" + + {nil. 83. {#=. true}}. "primitivePerform" + {nil. 83. {#isNil. 'excess arg'}}. "primitivePerform - too many arguments" + {nil. 84. {#=. {true}}}. "primitivePerformWithArgs" + {nil. 84. {#isNil. 'excess arg'}}. "primitivePerformWithArgs - invalid arguments" + {nil. 100. {#=. true. Object}}. "primitivePerformInSuperclass" + {nil. 100. {#isNil. {'excess arg'}. Object}}. "primitivePerformInSuperclass - too many arguments" + + {6. 118. {9. {7}}}. "primitiveDoPrimitiveWithArgs" + {6. 118. {9. {7. 13}}}. "primitiveDoPrimitiveWithArgs - superfluous arguments" + {6. 118. {118. {9. {7}}}}. "primitiveDoPrimitiveWithArgs - M3" + {thisContext. 218. {Float32Array >> #sum. Float32Array withAll: {2.0. 3.0}. {}}}. "primitiveDoNamedPrimitiveWithArgs" + {thisContext. 218. {Float32Array >> #sum. Float32Array withAll: {2.0. 3.0}. {4.0}}}. "primitiveDoNamedPrimitiveWithArgs - superfluous arguments" + } do: [:args | | block | + block := [primitiveBlock valueWithArguments: args]. + self + assert: block value + equals: (Context runSimulated: block)]. + + self + assert: (primitiveBlock value: (input1 := {1. 2. 3}) value: 61 value: {2. 4}) + equals: (Context runSimulated: [primitiveBlock value: (input2 := {1. 2. 3}) value: 61 value: {2. 4}]); + assert: input1 + equals: input2. ContextTest>>testPrimitive218 {tests} · ct 11/10/2021 00:13 + testPrimitive218 + + "valid 0-arg primitive" + self + assert: (Float32Array withAll: {2.0. 3.0}) sum + equals: (Context runSimulated: [(Float32Array withAll: {2.0. 3.0}) sum]). + + "valid unary primitive" + self + assert: 'wiffy' = 'wiffy' copy + equals: (Context runSimulated: ['wiffy' = 'wiffy' copy]); + assert: 'wiffy' = 'ziffy' + equals: (Context runSimulated: ['wiffy' = 'ziffy']). + + "superfluous arguments" + self "cascade!" + assert: 'wiffy' = 'wiffy' copy + equals: (Context runSimulated: ['wiffy' = 'wiffy' copy]); + assert: true. ContextTest>>testPrimitive83 {tests} · ct 11/10/2021 00:24 (changed) testPrimitive83 { - {#isNil}. "valid 0-arg message" - {#=. true}. "valid unary message" - {#ifNil:ifNotNil:. [2]. [:x | x]}. "valid binary message" - {#isNil. 'excess arg'}. "too many arguments" - {#=}. "missing argument" - } do: [:args | + [nil perform: #isNil]. "valid 0-arg message" + [nil perform: #= with: true]. "valid unary message" + [nil perform: #ifNil:ifNotNil: with: [2] with: [:x | x]]. "valid binary message" + [nil perform: #isNil with: 'excess arg']. "too many arguments" + [nil perform: #=] + } do: [:block | self - assert: (nil tryPrimitive: 83 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 83 withArgs: args])]. + assert: (block on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [block on: Error do: [:ex | ex messageText]])]. ContextTest>>testPrimitive84 {tests} · ct 11/10/2021 00:21 (changed) testPrimitive84 { {#isNil. {}}. "valid 0-arg message" {#=. {true}}. "valid unary message" {#ifNil:ifNotNil:. {[2]. [:x | x]}}. "valid binary message" - {#isNil}. "missing arguments" {#isNil. 'not an array'}. "invalid arguments" {#isNil. {'excess arg'}}. "too many arguments" {#=. {}}. "missing argument" } do: [:args | self - assert: (nil tryPrimitive: 84 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 84 withArgs: args])]. + assert: ([nil perform: args first withArguments: args second] on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [[nil perform: args first withArguments: args second] on: Error do: [:ex | ex messageText]])]. --- Sent from Squeak Inbox Talk

1 1

← Newer
1
...
5
6
7
8
9
10
11
...
40
Older →

Jump to page: