Squeak-dev March 2019

squeak-dev@lists.squeakfoundation.org

26 participants
85 discussions

The Inbox: Morphic-LB.1465.mcz
by commits＠source.squeak.org 21 Mar '19

21 Mar '19

A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-LB.1465.mcz ==================== Summary ==================== Name: Morphic-LB.1465 Author: LB Time: 21 March 2019, 10:29:53.207601 am UUID: 771444aa-6f73-e64a-8111-6af3e69e9525 Ancestors: Morphic-eem.1464 SystemWindow#replacePane:with: had an unexpected side effect changing the color of the pane put in place to transparent. This limited it's use as it is unwanted. =============== Diff against Morphic-eem.1464 =============== Item was changed: ----- Method: SystemWindow>>replacePane:with: (in category 'panes') ----- replacePane: oldPane with: newPane "Make newPane exactly occupy the position and extent of oldPane" | aLayoutFrame hadDep | hadDep := model dependents includes: oldPane. oldPane owner replaceSubmorph: oldPane by: newPane. newPane position: oldPane position; extent: oldPane extent. aLayoutFrame := oldPane layoutFrame. paneMorphs := paneMorphs collect: [:each | each == oldPane ifTrue: [newPane] ifFalse: [each]]. aLayoutFrame ifNotNil: [newPane layoutFrame: aLayoutFrame]. - newPane color: Color transparent. hadDep ifTrue: [model removeDependent: oldPane. model addDependent: newPane]. self changed !

1 0

The Trunk: Collections-pre.822.mcz
by commits＠source.squeak.org 21 Mar '19

21 Mar '19

Patrick Rein uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-pre.822.mcz ==================== Summary ==================== Name: Collections-pre.822 Author: pre Time: 20 March 2019, 8:05:20.383677 pm UUID: 483c4461-cee4-4a4f-82d3-fbc03e7201cc Ancestors: Collections-dtl.821 Adds #isMutator to Symbol which is analogous to asMutator. =============== Diff against Collections-dtl.821 =============== Item was added: + ----- Method: Symbol>>isMutator (in category 'testing') ----- + isMutator + + ^ self isKeyword and: [self numArgs = 1]!

3 3

The Trunk: CollectionsTests-pre.302.mcz
by commits＠source.squeak.org 20 Mar '19

20 Mar '19

Patrick Rein uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-pre.302.mcz ==================== Summary ==================== Name: CollectionsTests-pre.302 Author: pre Time: 20 March 2019, 8:02:15.683677 pm UUID: fea7dc2e-3541-da4d-b68d-87c9ba09cd82 Ancestors: CollectionsTests-nice.301 Adds a test for a new testing method: isMutator which is analoguos to asMutator. Recategorizes some tests while being at it. =============== Diff against CollectionsTests-nice.301 =============== Item was changed: + ----- Method: CharacterTest>>testNew (in category 'tests - Class Methods') ----- - ----- Method: CharacterTest>>testNew (in category 'testing - Class Methods') ----- testNew self should: [Character new] raise: Error.! Item was changed: + ----- Method: CharacterTest>>testPrintString (in category 'tests - printing') ----- - ----- Method: CharacterTest>>testPrintString (in category 'testing-printing') ----- testPrintString self assert: $a printString = '$a'. self assert: $5 printString = '$5'. self assert: $@ printString = '$@'. self assert: Character cr printString = 'Character cr'. self assert: Character lf printString = 'Character lf'. self assert: Character space printString = 'Character space'. self assert: Character null printString = 'Character null'. self assert: (Character value: 17) printString = 'Character value: 17'.! Item was changed: + ----- Method: CharacterTest>>testPrintStringAll (in category 'tests - printing') ----- - ----- Method: CharacterTest>>testPrintStringAll (in category 'testing-printing') ----- testPrintStringAll Character allByteCharacters do: [ :each | self assert: (self class newCompiler evaluate: each printString) = each ].! Item was changed: + ----- Method: CharacterTest>>testStoreString (in category 'tests - printing') ----- - ----- Method: CharacterTest>>testStoreString (in category 'testing-printing') ----- testStoreString self assert: $a storeString = '$a'. self assert: $5 storeString = '$5'. self assert: $@ storeString = '$@'. self assert: Character cr storeString = 'Character cr'. self assert: Character lf storeString = 'Character lf'. self assert: Character space storeString = 'Character space'. self assert: Character null storeString = 'Character null'. self assert: (Character value: 17) storeString = '(Character value: 17)'.! Item was changed: + ----- Method: CharacterTest>>testStoreStringAll (in category 'tests - printing') ----- - ----- Method: CharacterTest>>testStoreStringAll (in category 'testing-printing') ----- testStoreStringAll Character allByteCharacters do: [ :each | self assert: (self class newCompiler evaluate: each storeString) = each ].! Item was changed: + ----- Method: StringTest>>testEmpty (in category 'tests - testing') ----- - ----- Method: StringTest>>testEmpty (in category 'testing') ----- testEmpty self assert: 0 equals: String empty size description: 'The empty String should be empty indeed'; assert: String new species equals: String empty species description: 'The empty String should be a String'; assert: String empty identical: String empty description: 'The empty String should be canonical'; yourself ! Item was changed: + ----- Method: StringTest>>testNumArgs (in category 'tests - accessing') ----- - ----- Method: StringTest>>testNumArgs (in category 'testing') ----- testNumArgs | binary punctuation | binary := '+-*/<=>&|,?\~@'. 1 to: 3 do: [:length | binary combinations: length atATimeDo: [:each | self assert: each numArgs = 1]]. self assert: 'foo' numArgs = 0. self assert: 'bar:' numArgs = 1. self assert: 'foo:bar:' numArgs = 2. self assert: 'foo2:bar1:' numArgs = 2. self assert: '::' numArgs = -1 description: 'empty keywords are forbidden'. punctuation := '.;()[]{}"`''#$'. punctuation , Character separators do: [:letter | self assert: ('foo' copyWith: letter) numArgs = -1 description: 'Smalltalk punctuation and separators are illegal in a selector']. self assert: 'nextPut:andCR' numArgs = -1 description: 'terminal colon is missing'. self assert: 'a0:1:' numArgs = -1 description: 'a keyword cannot begin with a digit'. self assert: '123' numArgs = -1. self assert: '' numArgs = -1.! Item was changed: + ----- Method: SymbolTest>>testIsBinaryReturnsFalseForKeywordSelectors (in category 'tests - testing') ----- - ----- Method: SymbolTest>>testIsBinaryReturnsFalseForKeywordSelectors (in category 'testing - testing') ----- testIsBinaryReturnsFalseForKeywordSelectors self deny: #do: isBinary. self deny: #ifTrue:ifFalse: isBinary. self deny: #with:with:with:with: isBinary.! Item was changed: + ----- Method: SymbolTest>>testIsBinaryReturnsFalseForUnarySelectors (in category 'tests - testing') ----- - ----- Method: SymbolTest>>testIsBinaryReturnsFalseForUnarySelectors (in category 'testing - testing') ----- testIsBinaryReturnsFalseForUnarySelectors self deny: #timesRepeat isBinary. self deny: #once isBinary. self deny: #isBinary isBinary.! Item was changed: + ----- Method: SymbolTest>>testIsBinaryReturnsTrueForOperatorLikeSymbols (in category 'tests - testing') ----- - ----- Method: SymbolTest>>testIsBinaryReturnsTrueForOperatorLikeSymbols (in category 'testing - testing') ----- testIsBinaryReturnsTrueForOperatorLikeSymbols self assert: #+ isBinary. self assert: #>>= isBinary. self assert: #| isBinary.! Item was added: + ----- Method: SymbolTest>>testIsMutator (in category 'tests - testing') ----- + testIsMutator + self + assert: #x: isMutator ; + deny: #x isMutator ; + deny: #+ isMutator ; + deny: #a:b: isMutator! Item was changed: + ----- Method: SymbolTest>>testNumArgs2 (in category 'tests') ----- - ----- Method: SymbolTest>>testNumArgs2 (in category 'as yet unclassified') ----- testNumArgs2 "TODO: need to be extended to support shrinking and for selectors like #+ " self assert: (#test numArgs: 0) = #test. self assert: (#test numArgs: 1) = #test:. self assert: (#test numArgs: 2) = #test:with:. self assert: (#test numArgs: 3) = #test:with:with:. self assert: (#test: numArgs: 0) = #test:. self assert: (#test: numArgs: 1) = #test:. self assert: (#test: numArgs: 2) = #test:with:. self assert: (#test: numArgs: 3) = #test:with:with:. self assert: (#test:with: numArgs: 0) = #test:with:. self assert: (#test:with: numArgs: 1) = #test:with:. self assert: (#test:with: numArgs: 2) = #test:with:. self assert: (#test:with: numArgs: 3) = #test:with:with:. self assert: (#test:with: numArgs: 4) = #test:with:with:with:. self assert: (#test:with:with: numArgs: 0) = #test:with:with:. self assert: (#test:with:with: numArgs: 1) = #test:with:with:. self assert: (#test:with:with: numArgs: 2) = #test:with:with:. self assert: (#test:with:with: numArgs: 3) = #test:with:with:. self assert: (#test:with:with: numArgs: 4) = #test:with:with:with:.! Item was changed: + ----- Method: TextAttributesScanningTest>>doTestTextFontReferenceSerializationFor: (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>doTestTextFontReferenceSerializationFor: (in category 'testing') ----- doTestTextFontReferenceSerializationFor: font | att att3 fontReferenceString stream | att := TextFontReference toFont: font. stream := self streamWithAttribute: att. fontReferenceString := self testScanAttribute: att fromStream: stream encodedWithCharacter: $F decodedWithBlock: [:strm | strm upToEnd]. self assert: font familyName, '#', font height equals: fontReferenceString. stream reset. att3 := TextAttribute newFrom: stream. self assert: att equals: att3.! Item was changed: + ----- Method: TextAttributesScanningTest>>doTestTextFontReferenceTTCFor: (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>doTestTextFontReferenceTTCFor: (in category 'testing') ----- doTestTextFontReferenceTTCFor: font | att att3 fontReferenceString stream | att := TextFontReference toFont: font. stream := self streamWithAttribute: att. fontReferenceString := self testScanAttribute: att fromStream: stream encodedWithCharacter: $F decodedWithBlock: [:strm | strm upToEnd]. self assert: font familyName, '#', font height equals: fontReferenceString. stream reset. att3 := TextAttribute newFrom: stream. "test font height only, see comment above" self assert: att font height equals: att3 font height. "we really want an exact match, which probably requires different implentation of TextFontReference" self assert: att equals: att3. ! Item was changed: + ----- Method: TextAttributesScanningTest>>streamWithAttribute: (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>streamWithAttribute: (in category 'testing') ----- streamWithAttribute: att "Encode a TextAttribute on a Stream, and return a readStream on it" | strm | strm := (String new: 16) writeStream. att writeScanOn: strm. ^strm readStream! Item was changed: + ----- Method: TextAttributesScanningTest>>testPluggableTextAttribute (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testPluggableTextAttribute (in category 'testing') ----- testPluggableTextAttribute | att strm | att := PluggableTextAttribute evalBlock: [ #foo ]. strm := WriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). self should: [att writeScanOn: strm] raise: Error description: 'PluggableTextAttribute are not intended to be serialized'. ! Item was changed: + ----- Method: TextAttributesScanningTest>>testRunArrayScan (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testRunArrayScan (in category 'testing') ----- testRunArrayScan | ra ra2 strm | ra := RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i'). strm := WriteStream on: ''. ra writeScanOn: strm. ra2 := RunArray scanFrom: strm readStream. self assert: ra equals: ra2 ! Item was changed: + ----- Method: TextAttributesScanningTest>>testScanAttribute:encodedWithCharacter: (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testScanAttribute:encodedWithCharacter: (in category 'testing') ----- testScanAttribute: att encodedWithCharacter: aCharacter ^self testScanAttribute: att encodedWithCharacter: aCharacter decodedWithBlock: [:strm | att] ! Item was changed: + ----- Method: TextAttributesScanningTest>>testScanAttribute:encodedWithCharacter:decodedWithBlock: (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testScanAttribute:encodedWithCharacter:decodedWithBlock: (in category 'testing') ----- testScanAttribute: att encodedWithCharacter: aCharacter decodedWithBlock: aBlock "Test official encoding API, internal encoding details, and official decoding API for a specific TextAttribute" | stream att2 att3 | "First encode the TextAttribute on a Stream" stream := self streamWithAttribute: att. "Then test internal encoding" att2 := self testScanAttribute: att fromStream: stream encodedWithCharacter: aCharacter decodedWithBlock: aBlock. self assert: att equals: att2. "Then test normal decoding API" stream reset. att3 := TextAttribute newFrom: stream. self assert: att equals: att3. ! Item was changed: + ----- Method: TextAttributesScanningTest>>testScanAttribute:fromStream:encodedWithCharacter:decodedWithBlock: (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testScanAttribute:fromStream:encodedWithCharacter:decodedWithBlock: (in category 'testing') ----- testScanAttribute: att fromStream: strm encodedWithCharacter: aCharacter decodedWithBlock: aBlock "This is intended to test internal encoding of a TextAttribute. The first char is decoded by this method, the optional parameters by aBlock" | identifierCharacter att2 | identifierCharacter := strm next. self assert: aCharacter equals: identifierCharacter. self assert: att class equals: (TextAttribute classFor: aCharacter). att2 := aBlock value: strm. self assert: strm atEnd. ^att2 ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextAction (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextAction (in category 'testing') ----- testTextAction self assert: true description: 'TextAction is abstract and does not need to support text filein and fileout'. ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextAlignment (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextAlignment (in category 'testing') ----- testTextAlignment #(leftFlush rightFlush centered justified) do: [:alignment | | att | att := TextAlignment perform: alignment. self testScanAttribute: att encodedWithCharacter: $a decodedWithBlock: [:strm | TextAlignment new alignment: (Integer readFrom: strm ifFail: [-1])]. self testScanAttribute: att encodedWithCharacter: $a decodedWithBlock: [:strm | TextAlignment scanFrom: strm]].! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextAnchor (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextAnchor (in category 'testing') ----- testTextAnchor | att strm | att := TextAnchor new anchoredMorph: RectangleMorph new initialize. strm := WriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). att writeScanOn: strm. "FIXME - is TextAnchor used for anything?" ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextAttributeClassFor (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextAttributeClassFor (in category 'testing') ----- testTextAttributeClassFor "Verify class identifiers as used in RunArray class>>scanFrom:" self assert: TextAlignment equals: (TextAttribute classFor: $a). self assert: TextFontChange equals: (TextAttribute classFor: $f). self assert: TextFontReference equals: (TextAttribute classFor: $F). self assert: TextEmphasis equals: (TextAttribute classFor: $b). self assert: TextEmphasis equals: (TextAttribute classFor: $i). self assert: TextEmphasis equals: (TextAttribute classFor: $u). self assert: TextEmphasis equals: (TextAttribute classFor: $=). self assert: TextEmphasis equals: (TextAttribute classFor: $n). self assert: TextKern equals: (TextAttribute classFor: $-). self assert: TextKern equals: (TextAttribute classFor: $+). self assert: TextColor equals: (TextAttribute classFor: $c). self assert: TextLink equals: (TextAttribute classFor: $L). self assert: TextURL equals: (TextAttribute classFor: $R). self assert: TextSqkPageLink equals: (TextAttribute classFor: $q). self assert: TextSqkProjectLink equals: (TextAttribute classFor: $p). self assert: TextPrintIt equals: (TextAttribute classFor: $P). self assert: TextDoIt equals: (TextAttribute classFor: $d). ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextColor (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextColor (in category 'testing') ----- testTextColor | att | att := TextColor color: Color red. self testScanAttribute: att encodedWithCharacter: $c decodedWithBlock: [:strm | TextColor scanFrom: strm]! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextDoIt (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextDoIt (in category 'testing') ----- testTextDoIt | att | att := TextDoIt evalString: 'foo'. self testScanAttribute: att encodedWithCharacter: $d decodedWithBlock: [:strm | TextDoIt scanFrom: strm]! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextEmphasisBold (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextEmphasisBold (in category 'testing') ----- testTextEmphasisBold self testScanAttribute: TextEmphasis bold encodedWithCharacter: $b ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextEmphasisItalic (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextEmphasisItalic (in category 'testing') ----- testTextEmphasisItalic self testScanAttribute: TextEmphasis italic encodedWithCharacter: $i! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextEmphasisNormal (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextEmphasisNormal (in category 'testing') ----- testTextEmphasisNormal self testScanAttribute: TextEmphasis normal encodedWithCharacter: $n! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextEmphasisStruckOut (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextEmphasisStruckOut (in category 'testing') ----- testTextEmphasisStruckOut self testScanAttribute: TextEmphasis struckOut encodedWithCharacter: $=! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextEmphasisUnderlined (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextEmphasisUnderlined (in category 'testing') ----- testTextEmphasisUnderlined self testScanAttribute: TextEmphasis underlined encodedWithCharacter: $u! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextFontChange (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextFontChange (in category 'testing') ----- testTextFontChange | att | att := TextFontChange font3. self testScanAttribute: att encodedWithCharacter: $f decodedWithBlock: [:strm | TextFontChange new fontNumber: (Integer readFrom: strm ifFail: [0])]! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextFontReference (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextFontReference (in category 'testing') ----- testTextFontReference "Test TextFontReference with a StrikeFont" | font | font := TTCFont familyName: 'BitstreamVeraSans' pointSize: 9 emphasis: 0. self doTestTextFontReferenceSerializationFor: font. ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextFontReferenceForBoldFont (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextFontReferenceForBoldFont (in category 'testing') ----- testTextFontReferenceForBoldFont "Test TextFontReference with a StrikeFont" | font | font := TTCFont familyName: 'BitstreamVeraSans' pointSize: 9 emphasis: 1. self doTestTextFontReferenceSerializationFor: font. ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextFontReferenceTTC (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextFontReferenceTTC (in category 'testing') ----- testTextFontReferenceTTC "n.b. A TextFontReference specifies font height only, which is not sufficient to identify a unique TTCFont. Here we test only that the font height of the selected font matches the TextFontReference specification." "(self selector: #testTextFontReferenceTTC) debug" "Test TextFontReference with a TTCFont" | font | font := TTCFont familyName: 'BitstreamVeraSans' pointSize: 9 emphasis: 0. self doTestTextFontReferenceTTCFor: font.! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextFontReferenceTTCForBoldFont (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextFontReferenceTTCForBoldFont (in category 'testing') ----- testTextFontReferenceTTCForBoldFont "n.b. A TextFontReference specifies font height only, which is not sufficient to identify a unique TTCFont. Here we test only that the font height of the selected font matches the TextFontReference specification." "(self selector: #testTextFontReferenceTTC) debug" "Test TextFontReference with a TTCFont" | font | font := TTCFont familyName: 'BitstreamVeraSans' pointSize: 9 emphasis: 1. self doTestTextFontReferenceTTCFor: font.! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextIndent (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextIndent (in category 'testing') ----- testTextIndent "TextIndent is unused and does not have in implemention to support text filein and fileout. See TextAlignment for its likely replacement." self fail: 'TextIndent is apparently unused'! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextKern (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextKern (in category 'testing') ----- testTextKern | att | att := TextKern kern: 5. self testScanAttribute: att encodedWithCharacter: $+ decodedWithBlock: [:strm | strm skip: -1. "The first $+ was consumed by the encoding letter test" 5 timesRepeat: [self assert: $+ equals: strm next]. att]. att := TextKern kern: -5. self testScanAttribute: att encodedWithCharacter: $- decodedWithBlock: [:strm | strm skip: -1. 5 timesRepeat: [self assert: $- equals: strm next]. att].! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextLink (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextLink (in category 'testing') ----- testTextLink | att | att := TextLink new classAndMethod: 'class and method string'. self testScanAttribute: att encodedWithCharacter: $L decodedWithBlock: [:strm | TextLink scanFrom: strm].! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextMessageLink (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextMessageLink (in category 'testing') ----- testTextMessageLink | att strm | att := TextMessageLink message: Message someInstance. strm := WriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). att writeScanOn: strm. "FIXME - is TextMessageLink used for anything?" ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextPlusJumpEnd (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextPlusJumpEnd (in category 'testing') ----- testTextPlusJumpEnd | att strm | att := TextPlusJumpEnd new jumpLabel: 'this is a jump label'. strm := WriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). att writeScanOn: strm. "FIXME - is TextPlusJumpEnd used for anything?" ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextPlusJumpStart (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextPlusJumpStart (in category 'testing') ----- testTextPlusJumpStart | att strm | att := TextPlusJumpStart new jumpLabel: 'this is a jump label'. strm := WriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). att writeScanOn: strm. "FIXME - is TextPlusJumpStart used for anything?" ! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextPrintIt (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextPrintIt (in category 'testing') ----- testTextPrintIt | att | att := TextPrintIt evalString: 'foo'. self testScanAttribute: att encodedWithCharacter: $P decodedWithBlock: [:strm | TextPrintIt scanFrom: strm]! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextSqkPageLink (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextSqkPageLink (in category 'testing') ----- testTextSqkPageLink | att | att := TextSqkPageLink new url: 'a URL string'. self testScanAttribute: att encodedWithCharacter: $q decodedWithBlock: [:strm | TextSqkPageLink scanFrom: strm]! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextSqkProjectLink (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextSqkProjectLink (in category 'testing') ----- testTextSqkProjectLink | att | att := TextSqkProjectLink new url: 'a URL string'. self testScanAttribute: att encodedWithCharacter: $p decodedWithBlock: [:strm | TextSqkProjectLink scanFrom: strm]! Item was changed: + ----- Method: TextAttributesScanningTest>>testTextURL (in category 'tests') ----- - ----- Method: TextAttributesScanningTest>>testTextURL (in category 'testing') ----- testTextURL | att | att := TextURL new url: 'a URL string'. self testScanAttribute: att encodedWithCharacter: $R decodedWithBlock: [:strm | TextURL scanFrom: strm]! Item was changed: + ----- Method: TextTest>>testSetStringSetRunsChecking (in category 'tests - runs checking') ----- - ----- Method: TextTest>>testSetStringSetRunsChecking (in category 'tests runs checking') ----- testSetStringSetRunsChecking "Normal case of creating a Text from a string and a run array with matching size" | aString runs aText newText | aString := 'The best way to predict the future'. runs := (RunArray runs: #(4 4 8 7 5 6) values: ((Array new: 6) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); yourself)). self assert: aString size = runs size. aText := (Text string: 'The best way to predict the future' runs: (RunArray runs: #(4 4 8 7 5 6) values: ((Array new: 6) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); yourself))). newText := Text basicNew setString: aString setRunsChecking: runs. self assert: newText equals: aText. self assert: newText runs size = aString size. self assert: runs equals: newText runs. self assert: 6 equals: aText runs values size. self assert: 6 equals: newText runs values size. ! Item was changed: + ----- Method: TextTest>>testSetStringSetRunsCheckingLongRuns (in category 'tests - runs checking') ----- - ----- Method: TextTest>>testSetStringSetRunsCheckingLongRuns (in category 'tests runs checking') ----- testSetStringSetRunsCheckingLongRuns "Creating text from a string and a long run array should create a valid Text instance, and should retain text styling if possible." | aString aText newText lastRunTooLong oneRunTooMany | aString := 'The best way to predict the future'. lastRunTooLong := (RunArray runs: #(4 4 8 7 5 100) values: ((Array new: 6) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); yourself)). self deny: aString size = lastRunTooLong size. oneRunTooMany := (RunArray runs: #(4 4 8 7 5 6 4) values: ((Array new: 7) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 7 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself)). self deny: aString size = oneRunTooMany size. aText := (Text string: 'The best way to predict the future' runs: (RunArray runs: #(4 4 8 7 5 6) values: ((Array new: 6) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); yourself))). self assert: 6 equals: aText runs values size. newText := Text basicNew setString: aString setRunsChecking: lastRunTooLong. self assert: newText equals: aText. self assert: newText runs size = aString size. self assert: 6 equals: newText runs values size. newText := Text basicNew setString: aString setRunsChecking: oneRunTooMany. self assert: newText equals: aText. self assert: newText runs size = aString size. self assert: 6 equals: newText runs values size. ! Item was changed: + ----- Method: TextTest>>testSetStringSetRunsCheckingShortRuns (in category 'tests - runs checking') ----- - ----- Method: TextTest>>testSetStringSetRunsCheckingShortRuns (in category 'tests runs checking') ----- testSetStringSetRunsCheckingShortRuns "Creating text from a string and a short run array should create a valid Text instance, and should retain text styling if possible." | aString aText newText lastRunTooShort missingLastRun | aString := 'The best way to predict the future'. lastRunTooShort := (RunArray runs: #(4 4 8 7 5 1) values: ((Array new: 6) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); yourself)). self deny: aString size = lastRunTooShort size. missingLastRun := (RunArray runs: #(4 4 8 7 5) values: ((Array new: 5) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); yourself)). self deny: aString size = missingLastRun size. aText := (Text string: 'The best way to predict the future' runs: (RunArray runs: #(4 4 8 7 5 6) values: ((Array new: 6) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); yourself))). self assert: 6 equals: aText runs values size. "Compensate for short run array, either by adding a run or by extending length of the last run. In either case, the run array should have size of 6 or greater, not size 1 as would be the case if the text formatting had been discarded." newText := Text basicNew setString: aString setRunsChecking: lastRunTooShort. self assert: newText equals: aText. self assert: newText runs size = aString size. self assert: newText runs values size >= 6. self assert: 7 equals: newText runs values size. "add one run to account for missing run length" newText := Text basicNew setString: aString setRunsChecking: missingLastRun. self assert: newText equals: aText. "n.b. Two Texts are considered equal if they have the same characters" self assert: newText runs size = aString size. self assert: 6 equals: newText runs values size. ! Item was changed: + ----- Method: TextTest>>testWriteReadChunk (in category 'tests - fileIn/Out') ----- - ----- Method: TextTest>>testWriteReadChunk (in category 'tests fileIn/Out') ----- testWriteReadChunk "Create a text from string and runs with matching lenghts. Verify that writing to chunk format and reading from that chunk results in a copy of the original text." | aString runs aText chunk readFromChunk | aString := 'The best way to predict the future'. runs := (RunArray runs: #(4 4 8 7 5 6) values: ((Array new: 6) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); yourself)). self assert: aString size = runs size. aText := Text basicNew setString: aString setRunsChecking: runs. chunk := '' writeStream nextChunkPutWithStyle: aText; yourself; contents. readFromChunk := UTF8TextConverter new nextChunkTextFromStream: (ReadStream on: chunk). self assert: readFromChunk equals: aText. self assert: readFromChunk runs size = aString size. self assert: runs equals: readFromChunk runs. self assert: 6 equals: aText runs values size. self assert: 6 equals: readFromChunk runs values size. ! Item was changed: + ----- Method: TextTest>>testWriteReadChunkShortRunCount (in category 'tests - fileIn/Out') ----- - ----- Method: TextTest>>testWriteReadChunkShortRunCount (in category 'tests fileIn/Out') ----- testWriteReadChunkShortRunCount "Create a text from string and runs, where the string length is less than the runs length. This is a condition that might occur if a chunk fileout was edited by hand, leaving runs that extend beyond the bounds of the run array. In this case, the fileIn should result in a reasonable Text instance without errors related to the runs that exceed the string length." | aString runs aText chunk readFromChunk | aString := 'The best way to predict'. " the future". runs := (RunArray runs: #(4 4 8 7 5) values: ((Array new: 5) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); yourself)). self deny: aString size = runs size. aText := Text basicNew setString: aString setRunsChecking: runs. chunk := '' writeStream nextChunkPutWithStyle: aText; yourself; contents. readFromChunk := UTF8TextConverter new nextChunkTextFromStream: (ReadStream on: chunk). self assert: readFromChunk equals: aText. self assert: readFromChunk runs size = aString size. self assert: readFromChunk runs size > 1. self assert: 4 equals: aText runs values size. self assert: 4 equals: readFromChunk runs values size. ! Item was changed: + ----- Method: TextTest>>testWriteReadChunkShortRunLength (in category 'tests - fileIn/Out') ----- - ----- Method: TextTest>>testWriteReadChunkShortRunLength (in category 'tests fileIn/Out') ----- testWriteReadChunkShortRunLength "Create a text from string and runs, where the run length is less than the string length. The fileIn should result in a reasonable Text instance without errors related to the run length mismatch." | aString runs aText chunk readFromChunk | aString := 'The best way to predict the future'. runs := (RunArray runs: #(4 4 8 7 5 1) values: ((Array new: 6) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); yourself)). self deny: aString size = runs size. aText := Text basicNew setString: aString setRunsChecking: runs. chunk := '' writeStream nextChunkPutWithStyle: aText; yourself; contents. readFromChunk := UTF8TextConverter new nextChunkTextFromStream: (ReadStream on: chunk). self assert: readFromChunk equals: aText. self assert: readFromChunk runs size = aString size. self assert: readFromChunk runs size > 1. self assert: aText runs values size equals: readFromChunk runs values size. ! Item was changed: + ----- Method: TextTest>>testWriteReadChunkShortString (in category 'tests - fileIn/Out') ----- - ----- Method: TextTest>>testWriteReadChunkShortString (in category 'tests fileIn/Out') ----- testWriteReadChunkShortString "Create a text from string and runs, where the run entries are fewer than required to match the string length. The fileIn should result in a reasonable Text instance without errors related to the run length mismatch." | aString runs aText chunk readFromChunk | aString := 'The best way to predict the future'. runs := (RunArray runs: #(4 4 8 7 5 6) values: ((Array new: 6) at: 1 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 1; yourself); yourself); at: 2 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 3 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 3; yourself); yourself); at: 4 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); at: 5 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 4; yourself); yourself); at: 6 put: ((Array new: 1) at: 1 put: (TextFontChange basicNew instVarAt: 1 put: 2; yourself); yourself); yourself)). self assert: aString size = runs size. aText := Text basicNew setString: aString setRunsChecking: runs. chunk := '' writeStream nextChunkPutWithStyle: aText; yourself; contents. readFromChunk := UTF8TextConverter new nextChunkTextFromStream: (ReadStream on: chunk). self assert: readFromChunk equals: aText. self assert: readFromChunk runs size = aString size. self assert: readFromChunk runs size > 1. self assert: aText runs values size equals: readFromChunk runs values size. ! Item was changed: + ----- Method: WideStringTest>>testAtPut (in category 'tests - accessing') ----- - ----- Method: WideStringTest>>testAtPut (in category 'testing') ----- testAtPut "Non regression test for http://bugs.squeak.org/view.php?id=6998" | w1 | w1 := WideString with: (Unicode value: 402) with: $a with: (Unicode value: 400) with: $b. self assert: (w1 at: 2 put: $b) = $b description: 'at:put: should return the put-object' !

1 0

The Trunk: Compiler-eem.403.mcz
by commits＠source.squeak.org 19 Mar '19

19 Mar '19

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-eem.403.mcz ==================== Summary ==================== Name: Compiler-eem.403 Author: eem Time: 19 March 2019, 11:58:47.238202 am UUID: a0f07dce-0a58-422e-af37-32d5a3bd6546 Ancestors: Compiler-eem.402 Fixed yhree typos in a comment, and improved the class comments for ParseNodeEnumerator & subclass. =============== Diff against Compiler-eem.402 =============== Item was changed: ParseNodeVisitor subclass: #ParseNodeEnumerator instanceVariableNames: 'theBlock theSelectBlock' classVariableNames: '' poolDictionaries: '' category: 'Compiler-Support'! + !ParseNodeEnumerator commentStamp: 'eem 3/19/2019 11:58' prior: 0! - !ParseNodeEnumerator commentStamp: 'eem 8/31/2010 11:41' prior: 0! ParseNodeEnumerator implements ParseNode>>nodesDo:. It can be used to enumerate an entire tree via aParseNode accept: (ParseNodeEnumerator ofBlock: aBlock) or selectively, excluding the node and subnodes for which selectBlock answers false, via aParseNode accept: (ParseNodeEnumerator ofBlock: aBlock select: selectBlock) + Instance Variables + theBlock: <BlockClosure> + theSelectBlock: <BlockClosure | nil> + theBlock + - the block that is evaluated with the parse nodes the receiver visits. + + theSelectBlock + - an optional block used to select blocks to visit and descend into. + Here's a doIt that generates and compiles the visiting methods: self superclass selectors do: [:s| self compile: (String streamContents: [:str| | arg | arg := 'a', (s allButFirst: 5) allButLast. str nextPutAll: s, ' ', arg; crtab; nextPutAll: '(theSelectBlock isNil or: [theSelectBlock value: '; nextPutAll: arg; nextPutAll: ']) ifFalse:'; crtab; tab: 2; nextPutAll: '[^nil].'; crtab; nextPutAll: 'theBlock value: '; nextPutAll: arg; nextPut: $.; crtab; nextPutAll: '^super '; nextPutAll: s, ' ', arg])]! Item was changed: ParseNodeEnumerator subclass: #ParseNodeWithPrecedingStatementEnumerator instanceVariableNames: 'precedingStatement' classVariableNames: '' poolDictionaries: '' category: 'Compiler-Support'! + + !ParseNodeWithPrecedingStatementEnumerator commentStamp: 'eem 3/19/2019 11:55' prior: 0! + A ParseNodeWithPrecedingStatementEnumerator is a ParseNodeEnumerator that accepts a binary block in ofBlock:, and hence enumerates statement nodes with their preceding statement, or nil if they are the first. + + Instance Variables + precedingStatement: <ParseNode | nil> + + precedingStatement + - the preceding statement node, if any + ! Item was changed: ----- Method: ParseNodeWithPrecedingStatementEnumerator>>ofBlock: (in category 'initialize-release') ----- ofBlock: aBlock "N.B. This enumerator visits a node before any of the node's children. + Hence, when enumerating statements in a block, we can ensure that + the second argument to the block, the preceding statement, is non-nil + only for top-level statements in the block by nilling out precedingStatement - Hence, when enumewrating statements in a block, we can ensure that - the second argument to the block, the preceeding statement, is non-nil - only for top-level statements in the block by nilling out preceedingStatement once the block is evaluated. Perhaps stronger would be to capture its value in a temporary and nil it before evaluating, but this is good enough." theBlock := [:node| aBlock value: node value: precedingStatement. precedingStatement := nil]!

4 3

The Trunk: Compiler-ul.401.mcz
by commits＠source.squeak.org 19 Mar '19

19 Mar '19

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-ul.401.mcz ==================== Summary ==================== Name: Compiler-ul.401 Author: ul Time: 16 March 2019, 11:56:29.899053 pm UUID: 395adc27-f48e-484c-9097-5197ea3a0155 Ancestors: Compiler-eem.400 - fixed typo =============== Diff against Compiler-eem.400 =============== Item was changed: ----- Method: ParseNodeWithPrecedingStatementEnumerator>>ofBlock: (in category 'initialize-release') ----- ofBlock: aBlock "N.B. This enumerator visits a node before any of the node's children. Hence, when enumewrating statements in a block, we can ensure that the second argument to the block, the preceeding statement, is non-nil only for top-level statements in the block by nilling out preceedingStatement once the block is evaluated. Perhaps stronger would be to capture its value in a temporary and nil it before evaluating, but this is good enough." theBlock := [:node| aBlock value: node value: precedingStatement. + precedingStatement := nil]! - preceedingStatement := nil]!

1 0

The Trunk: Compiler-eem.402.mcz
by commits＠source.squeak.org 19 Mar '19

19 Mar '19

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-eem.402.mcz ==================== Summary ==================== Name: Compiler-eem.402 Author: eem Time: 19 March 2019, 11:44:20.570473 am UUID: 886de89c-a3ed-4fb5-a8ed-7f9bf78d69b6 Ancestors: Compiler-eem.401, Compiler-ul.401 Merge with Compiler-ul.401, eliminate undeclatred variable in ParseNodeWithPrecedingStatementEnumerator. =============== Diff against Compiler-eem.401 =============== Item was changed: ----- Method: ParseNodeWithPrecedingStatementEnumerator>>ofBlock: (in category 'initialize-release') ----- ofBlock: aBlock "N.B. This enumerator visits a node before any of the node's children. Hence, when enumewrating statements in a block, we can ensure that the second argument to the block, the preceeding statement, is non-nil only for top-level statements in the block by nilling out preceedingStatement once the block is evaluated. Perhaps stronger would be to capture its value in a temporary and nil it before evaluating, but this is good enough." theBlock := [:node| aBlock value: node value: precedingStatement. + precedingStatement := nil]! - preceedingStatement := nil]!

1 0

The Trunk: Tests-eem.409.mcz
by commits＠source.squeak.org 19 Mar '19

19 Mar '19

Eliot Miranda uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-eem.409.mcz ==================== Summary ==================== Name: Tests-eem.409 Author: eem Time: 19 March 2019, 11:38:09.260844 am UUID: 7ba5d6e0-5b70-462f-a1ee-c77ab5b74dc3 Ancestors: Tests-eem.408 DecompilerTests: Restrict the set of methods that are tested to thise in the base packages, excluding extensions from outside packages (this to eliminate errors due to _ assignment, etc). Beef up checkDecompileMethod: to deal with both OutOfScopeNotification and SyntaxErrorNotification when the decompiler wrongly converts a while loop into a to:do: when the index is used out of scope. Somehow the bytecode set affects which of these errors may be seen. Eliminate some cases that used to fail and no longer do (principally in ProtoObjectTest testIfNotNil et al). With these changes I see DecompilerTests all green in both 32-bit trunk and a trunk-derived 64-bit VMMaker image using SistaV1. =============== Diff against Tests-eem.408 =============== Item was added: + ----- Method: DecompilerTests>>basePackagePrefixes (in category 'utilities') ----- + basePackagePrefixes + ^#("'Balloon'" "AbstractAnimation>>prologue: in Balloon3D-Wonderland-Time breaks the test" + 'Chronology' 'Collections' 'CommandLine' 'Compiler' 'Compression' + 'Environments' 'Exceptions' + 'Files' + 'GetText' 'Graphics' 'Help-' 'HelpSystem-' + 'Installer-Core' + 'Kernel-' 'KernelTests-' + 'Monticello' + 'Morphic-' 'MorphicExtras-' 'MorphicExtrasTests-' 'MorphicTests-' + 'Multilingual' 'MultilingualTests' + 'Nebraska' 'Network' 'NetworkTests' + 'PackageInfo-Base' 'PreferenceBrowser' 'Protocols' + 'Regex' + 'ReleaseBuilder' + 'SMBase' 'SMLoader' 'ST80' 'ST80Tests' 'ST80Tools' 'SUnit' 'ScriptLoader' 'Services-Base' 'Shout' + 'Sound' 'Squeak-Version' 'SqueakSSL' 'System' + 'Tests' 'ToolBuilder' 'Tools' 'Traits' 'TrueType' + 'Universes' 'UpdateStream' 'VersionNumber' + 'WebClient-' + 'XML-')! Item was changed: ----- Method: DecompilerTests>>checkDecompileMethod: (in category 'utilities') ----- checkDecompileMethod: oldMethod | cls selector oldMethodNode methodNode newMethod oldCodeString newCodeString | cls := oldMethod methodClass. selector := oldMethod selector. oldMethodNode := (cls decompilerClass new withTempNames: oldMethod methodNode schematicTempNamesString) decompile: selector in: cls method: oldMethod methodForDecompile. [oldMethodNode properties includesKey: #warning] whileTrue: [oldMethodNode properties removeKey: #warning]. oldCodeString := oldMethodNode decompileString. + methodNode := [[| compiler | + compiler := cls newCompiler. + compiler parser encoderClass: oldMethod encoderClass. + compiler - methodNode := [| compiler | - compiler := cls newCompiler. - compiler parser encoderClass: oldMethod encoderClass. - compiler compile: oldCodeString in: cls notifying: nil ifFail: []] on: SyntaxErrorNotification do: [:ex| ex errorMessage = 'Cannot store into' ifTrue: [ex return: #badStore]. + ex pass]] + on: OutOfScopeNotification + do: [:ex| ex return: #badStore]. - ex pass]. "Ignore cannot store into block arg errors; they're not our issue." methodNode ~~ #badStore ifTrue: [newMethod := methodNode generate. newCodeString := ((cls decompilerClass new withTempNames: methodNode schematicTempNamesString) decompile: selector in: cls method: newMethod methodForDecompile) decompileString. "(StringHolder new textContents: (TextDiffBuilder buildDisplayPatchFrom: oldCodeString to: newCodeString)) openLabel: 'Decompilation Differences for ', cls name,'>>',selector" "(StringHolder new textContents: (TextDiffBuilder buildDisplayPatchFrom: oldMethod abstractSymbolic to: newMethod abstractSymbolic)) openLabel: 'Bytecode Differences for ', cls name,'>>',selector" self assert: (oldCodeString = newCodeString or: [(Scanner new scanTokens: oldCodeString) = (Scanner new scanTokens: newCodeString)]) description: cls name asString, ' ', selector asString resumable: true]! Item was changed: ----- Method: DecompilerTests>>classNames (in category 'utilities') ----- classNames "A list of the classes in most of the base packages; excluding EToys arbitrarily for now" ^Smalltalk globals allClassesAndTraits select: [:classOrTrait| + self basePackagePrefixes anySatisfy: - #( 'Balloon' - 'Chronology' 'Collections' 'CommandLine' 'Compiler' 'Compression' - 'Environments' 'Exceptions' - 'Files' - 'GetText' 'Graphics' 'Help-' 'HelpSystem-' - 'Installer-Core' - 'Kernel-' 'KernelTests-' - 'Monticello' - 'Morphic-' 'MorphicExtras-' 'MorphicExtrasTests-' 'MorphicTests-' - 'Multilingual' 'MultilingualTests' - 'Nebraska' 'Network' 'NetworkTests' - 'PackageInfo-Base' 'PreferenceBrowser' 'Protocols' - 'Regex' - 'ReleaseBuilder' - 'SMBase' 'SMLoader' 'ST80' 'ST80Tests' 'ST80Tools' 'SUnit' 'ScriptLoader' 'Services-Base' 'Shout' - 'Sound' 'Squeak-Version' 'SqueakSSL' 'System' - 'Tests' 'ToolBuilder' 'Tools' 'Traits' 'TrueType' - 'Universes' 'UpdateStream' 'VersionNumber' - 'WebClient-' - 'XML-') anySatisfy: [:packageRoot| classOrTrait category ifNil: [false] ifNotNil: [:cat| cat beginsWith: packageRoot]]] thenCollect: [:classOrTrait| classOrTrait name]! Item was changed: ----- Method: DecompilerTests>>decompileClassesSelect: (in category 'utilities') ----- decompileClassesSelect: aBlock + CurrentReadOnlySourceFiles cacheDuring: + [ (self classNames select: aBlock) do: + [ :cn | | class | + (class := Smalltalk classNamed: cn) selectorsAndMethodsDo: + [ :selector :method | + (self isUnacceptableExtension: selector inClass: class) ifFalse: + [(self exceptionClassForFailureFor: class selector: selector) + ifNil: [ self checkDecompileMethod: method ] + ifNotNil: + [ :exceptionClass | + self + should: [ self checkDecompileMethod: method ] + raise: exceptionClass ] ] ] ] ]! - CurrentReadOnlySourceFiles cacheDuring: [ - (self classNames select: aBlock) do: [ :cn | - | class | - (class := Smalltalk classNamed: cn) selectorsAndMethodsDo: [ :selector :method | - (self exceptionClassForFailureFor: class selector: selector) - ifNil: [ self checkDecompileMethod: method ] - ifNotNil: [ :exceptionClass | - self - should: [ self checkDecompileMethod: method ] - raise: exceptionClass ] ] ] ]! Item was changed: ----- Method: DecompilerTests>>decompilerFailures (in category 'utilities') ----- decompilerFailures "Here is the list of failures: either a syntax error, a hard error or some failure to decompile correctly. + Collected initially via + DecompilerTestFailuresCollector new computeFailures. + But can be maintained manually." - Collected via - DecompilerTestFailuresCollector new computeFailures." "class name, selector, error class name or nil" + ^#( - ^ #( #(BrowserCommentTextMorph showPane SyntaxErrorNotification) #(CodeHolder getSelectorAndSendQuery:to:with: SyntaxErrorNotification) #(DecompilerTests testDecompileUnreachableParameter Error) #(MVCToolBuilder setLayout:in: SyntaxErrorNotification) "same-name block-local temps in optimized blocks" + #(Pen web AssertionFailure) "needs a recompile to compute remote temps correctly (repeat now inlined)" + #(PNGReadWriter copyPixelsGray: SyntaxErrorNotification) + #(Random roll: AssertionFailure) "needs a recompile to compute remote temps correctly (repeat now inlined)" + #(SHMCClassDefinition withAllSuperclassesDo: SyntaxErrorNotification)), "same-name block-local temps in optimized blocks" + (Scanner allowBlockArgumentAssignment + ifTrue: [#()] + ifFalse: + [#( + #(NebraskaSenderMorph hideField: SyntaxErrorNotification)) "assigns into block argument"])! - #(PNGReadWriter copyPixelsGray: SyntaxErrorNotification) - #(ProtoObjectTest testIfNilIfNotNil SyntaxErrorNotification) - #(ProtoObjectTest testIfNotNil SyntaxErrorNotification) - #(ProtoObjectTest testIfNotNilIfNil SyntaxErrorNotification) - #(SHMCClassDefinition withAllSuperclassesDo: SyntaxErrorNotification) "same-name block-local temps in optimized blocks" - #(TTContourConstruction segmentsDo: SyntaxErrorNotification) "Worth fixing; these two are mistaken conversion from a whileTrue: to a to:do: but the index is used outside the whileTrue:" - #(TTFontReader processHorizontalMetricsTable:length: SyntaxErrorNotification)) - - ! Item was added: + ----- Method: DecompilerTests>>isUnacceptableExtension:inClass: (in category 'utilities') ----- + isUnacceptableExtension: selector inClass: class + "Filter-out extensions outside the base packages" + | category | + category := class whichCategoryIncludesSelector: selector. + ^category notEmpty + and: [category first == $* + and: [category := category allButFirst. + self basePackagePrefixes noneSatisfy: [:prefix| category beginsWith: prefix]]]!

1 0

The Trunk: Tests-eem.408.mcz
by commits＠source.squeak.org 19 Mar '19

19 Mar '19

Eliot Miranda uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-eem.408.mcz ==================== Summary ==================== Name: Tests-eem.408 Author: eem Time: 19 March 2019, 9:29:58.589612 am UUID: 98f708d3-76ec-4f02-9db0-8472e0e09a25 Ancestors: Tests-pre.407 Fix a couple of failing Compiler tests. testPCPreviousTo must be made aware of extensions, for the SistaV1 bytecode set. testMaxLiteralsWithClassReferenceInClosure must adapt to the much greater number of literals available in the SistaV1 set. =============== Diff against Tests-pre.407 =============== Item was changed: ----- Method: BytecodeDecodingTests>>testPCPreviousTo (in category 'tests') ----- testPCPreviousTo "Check that the pcPreviousTo machinery answers the truth for all bytecodes." self systemNavigation allSelect: + [:m| | ec is prevPC prevBlockCreationPC exclude encoder extensionOffset | - [:m| | ec is prevPC prevBlockCreationPC exclude | m isQuick ifFalse: [ec := m encoderClass. is:= InstructionStream on: m. exclude := OrderedCollection new. m embeddedBlockClosures do: + [:ebc| | bm followingpc | + bm := ebc method. "Will differ for FullBlocks/SistaV1 regime" + followingpc := ebc endPC + (ec bytecodeSize: (bm at: ebc endPC)). + exclude addLast: ebc startpc; addLast: followingpc. - [:ebc| | followingpc | - followingpc := ebc endPC + (ec bytecodeSize: (m at: ebc endPC)). - exclude addLast: ebc startpc; addLast: followingpc.. self assert: nil + equals: (ec pcPreviousTo: ebc startpc in: bm for: nil). + bm isCompiledBlock ifFalse: + [self assert: (ec pcOfBlockCreationBytecodeForBlockStartingAt: ebc startpc in: m) + equals: (ec pcPreviousTo: followingpc in: bm for: nil)]]. + encoder := m encoderClass. + extensionOffset := 0. + is scanFor: - equals: (ec pcPreviousTo: ebc startpc in: m for: nil). - self assert: (ec pcOfBlockCreationBytecodeForBlockStartingAt: ebc startpc in: m) - equals: (ec pcPreviousTo: followingpc in: m for: nil)]. - is scanFor: [:b| (exclude includes: is pc) ifFalse: + [self assert: prevPC equals: (ec pcPreviousTo: is pc in: m for: nil)]. + prevPC := is pc - extensionOffset. + extensionOffset := (encoder isExtension: is nextByte) + ifTrue: [extensionOffset + 2] + ifFalse: [0]. - [self assert: prevPC - equals: (ec pcPreviousTo: is pc in: m for: nil)]. - prevPC := is pc. b = ec createClosureCode ifTrue: [prevBlockCreationPC := prevPC]. + false]]. - false].]. false]! Item was changed: ----- Method: CompilerTest>>testMaxLiteralsWithClassReferenceInClosure (in category 'limits') ----- testMaxLiteralsWithClassReferenceInClosure "Document the maximum number of literals in a compiled method. A class reference in a closure reduces the maximum literals." + | bytecodeSetEncoder maxLiterals stringThatCanBeCompiled stringWithOneTooManyLiterals | + bytecodeSetEncoder := CompiledMethod preferredBytecodeSetEncoderClass new. + maxLiterals := bytecodeSetEncoder maxNumLiterals + - 2 "for selector & methodClass" + - (bytecodeSetEncoder supportsFullBlocks ifTrue: [1] ifFalse: [0]) + - 4 "for the implicit stream processing into which the brace construct is compiled: (Array braceStream: size) braceArray". - | maxLiterals stringThatCanBeCompiled stringWithOneTooManyLiterals | - maxLiterals := 245. stringThatCanBeCompiled := '[ DateAndTime now. Date today. Time ]. { ', (String streamContents: [:strm | 1 to: maxLiterals do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'. stringWithOneTooManyLiterals := '[ DateAndTime now. Date today. Time ]. { ', (String streamContents: [:strm | 1 to: maxLiterals + 1 do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'. self assert: maxLiterals equals: (Compiler evaluate: stringThatCanBeCompiled) size. "If the following test fails, it means that the limit has been raised or eliminated, and this test should be updated to reflect the improvement." self should: [Compiler evaluate: stringWithOneTooManyLiterals] raise: Error. !

1 0

The Trunk: Compiler-eem.401.mcz
by commits＠source.squeak.org 19 Mar '19

19 Mar '19

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-eem.401.mcz ==================== Summary ==================== Name: Compiler-eem.401 Author: eem Time: 19 March 2019, 9:28:16.827407 am UUID: 7920c007-0974-48a7-b1b3-b4de923b90d4 Ancestors: Compiler-eem.400 Fix a slip in EncoderForSistaV1 class>>isTempStoreAt:in:, and fix a couple of typos nearby. =============== Diff against Compiler-eem.400 =============== Item was changed: ----- Method: BytecodeEncoder class>>pcPreviousTo:in:for: (in category 'bytecode decoding') ----- pcPreviousTo: thePC in: method for: anInstructionStreamOrContext "Answer the pc of the bytecode before the bytecode at thePC. Unlike CompiledMethod>>pcPreviousTo:, this version answers nil for the first bytecode of an embedded block, and answers the pc of the block creation bytecode for a bytecode following an embedded block." | pc nextPc prevPc byte createClosureCode | thePC > method endPC ifTrue: [^method endPC]. pc := method initialPC. "We could save time by scanning from the block creation bytecode of an embedded block, using the following, but it saves less time than it loses in additional tests." "(anInstructionStreamOrContext isContext and: [anInstructionStreamOrContext isClosureContext and: [(nextPc := anInstructionStreamOrContext startpc) > pc]]) ifTrue: [pc := self pcOfBlockCreationBytecodeForBlockStartingAt: nextPc in: method]." createClosureCode := self createClosureCode. [pc < thePC] whileTrue: [byte := method at: (prevPc := pc). + [pc := createClosureCode = byte - [pc := createClosureCode == byte ifTrue: [nextPc := self pcFollowingBlockAt: pc in: method. nextPc = thePC ifTrue: "first bytecode following block" [^prevPc]. nextPc > thePC ifTrue: [pc + (self bytecodeSize: byte) = thePC ifTrue: "first bytecode of block" [^nil]. pc + (self bytecodeSize: byte)] ifFalse: [nextPc]] ifFalse: [pc + (self bytecodeSize: byte)]. self isExtension: byte] whileTrue: [byte := method at: pc]]. ^prevPc "Here's code to measure the effect of short-cutting scanning for blocks by starting at the startpc. + It measures how much time is used to scan for the pcs from the last block to the end of all methods containing blocks. Uncomment out the short-cut above to compare time with the optimization and time without. I see approximately 290ms for all such methods with the optimization and 292 ms without, so given that this slows down the substantial majority of methods without blocks, we KISS." - It measures how much time is used to scan for the pcs from the last block to the end of all mwetods containing blocks. Uncomment out the short-cut above to compare time with the optimization and time without. I see approximately 290ms for all such methods with the optimization and 292 ms without, so given that this slows down the substantial majority of methods without blocks, we KISS." "| candidates | candidates := Dictionary new. self systemNavigation allSelect: [:m| | ebc | (m isQuick or: [(ebc := m embeddedBlockClosures) isEmpty]) ifFalse: [candidates at: m put: { ebc last. Array streamContents: [:s| | is | (is:= InstructionStream on: m) pc: ebc last startpc; scanFor: [:b| s nextPut: is pc. false]] }]. false]. (1 to: 10) collect: [:ign| { [candidates keysAndValuesDo: [:m :tuple| [:ebc :pcs| | c | c := ebc outerContext. pcs do: [:pc| m encoderClass pcPreviousTo: pc in: m for: c]] valueWithArguments: tuple]] timeToRun. [candidates keysAndValuesDo: [:m :tuple| [:ebc :pcs| | c | c := ebc outerContext. pcs do: [:pc| m encoderClass pcPreviousTo: pc in: m for: nil]] valueWithArguments: tuple]] timeToRun. }]"! Item was changed: ----- Method: EncoderForSistaV1 class>>isTempStoreAt:in: (in category 'instruction stream support') ----- isTempStoreAt: pc in: method "Answer if the bytecode at pc is a store or store-pop into a temporary variable. 208-215 11010 iii Pop and Store Temporary Variable #iii 242 11110010 iiiiiiii Pop and Store Temporary Variable #iiiiiiii 245 11110110 iiiiiiii Store Temporary Variable #iiiiiiii" | byte | byte := method at: pc. ^byte >= 208 and: [byte <= 215 + or: [byte = 242 or: [byte = 245]]]! - or: [byte = 242 and: [byte = 245]]]!

1 0

Window label as Text instead of String bugs
by Stephan Eggermont 19 Mar '19

19 Mar '19

‘Text’ asMorph openInWindowLabeled: ‘Text’ asText Trying to open the debugger halo on the resulting window results in a MNU Text>>truncateWithElipsisTo: in HaloMorph>>doDebug:with: It needs either an asString there, or an implementation in Text Trying to grab the window results in a MNU Text>>truncateTo: in SystemWindow>>nameForUndoWording that needs a similar change Stephan

1 0

← Newer
1
2
3
4
5
6
7
8
9
Older →