[squeak-dev] The Trunk: CollectionsTests-nice.221.mczcommits at source.squeak.org commits at source.squeak.orgSun Jul 27 20:29:03 UTC 2014
Nicolas Cellier uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-nice.221.mcz ==================== Summary ==================== Name: CollectionsTests-nice.221 Author: nice Time: 27 July 2014, 10:28:40.852 pm UUID: 25bc290f-60ff-429d-a608-304e995e35a2 Ancestors: CollectionsTests-nice.220 TextAttributesScanningTest is repeating the same code in most tests, refactor it, and while at it, use a WriteStream for writing then a ReadStream for reading. Note: there are still 2 tests failing... =============== Diff against CollectionsTests-nice.220 =============== Item was added: + ----- 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 'testing') ----- testPluggableTextAttribute | att strm | att := PluggableTextAttribute evalBlock: [ #foo ]. + strm := WriteStream on: ''. - strm := ReadWriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). att writeScanOn: strm. "FIXME: PluggableTextAttribute used by SqueakMap. Currently it cannot be filed out, so this probably needs fixing. See RunArray class>>scanFrom:" ! Item was changed: ----- 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: ''. - strm := ReadWriteStream on: ''. ra writeScanOn: strm. + + ra2 := RunArray scanFrom: strm readStream. - strm reset. - ra2 := RunArray scanFrom: strm. self assert: ra equals: ra2 ! Item was added: + ----- Method: TextAttributesScanningTest>>testScanAttribute:encodedWithCharacter: (in category 'testing') ----- + testScanAttribute: att encodedWithCharacter: aCharacter + ^self testScanAttribute: att encodedWithCharacter: aCharacter decodedWithBlock: [:strm | att] + ! Item was added: + ----- 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 added: + ----- 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>>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]].! - | att strm att2 identifierCharacter att3 att4 | - att := TextAlignment leftFlush. - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $a equals: identifierCharacter. - att2 :=TextAlignment new alignment: (Integer readFrom: strm ifFail: [-1]). - self assert: att equals: att2. - self assert: (TextAttribute classFor: $a) equals: TextAlignment. - - strm reset. - identifierCharacter := strm next. - self assert: $a equals: identifierCharacter. - att3 := TextAlignment scanFrom: strm. - self assert: att equals: att3. - self assert: TextAlignment equals: (TextAttribute classFor: $a). - - strm reset. - att4 := TextAttribute newFrom: strm. - self assert: att equals: att4.! Item was changed: ----- Method: TextAttributesScanningTest>>testTextAnchor (in category 'testing') ----- testTextAnchor | att strm | att := TextAnchor new anchoredMorph: RectangleMorph new initialize. + strm := WriteStream on: ''. - strm := ReadWriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). att writeScanOn: strm. "FIXME - is TextAnchor used for anything?" ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextColor (in category 'testing') ----- testTextColor + | att | - | att strm att2 att3 identifierCharacter | att := TextColor color: Color red. + self testScanAttribute: att encodedWithCharacter: $c decodedWithBlock: [:strm | TextColor scanFrom: strm]! - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $c equals: identifierCharacter. - att2 := TextColor scanFrom: strm. - self assert: att equals: att2. - self assert: TextColor equals: (TextAttribute classFor: $c). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3. - ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextDoIt (in category 'testing') ----- testTextDoIt + | att | - | att strm att2 identifierCharacter att3 | att := TextDoIt evalString: 'foo'. + self testScanAttribute: att encodedWithCharacter: $d decodedWithBlock: [:strm | TextDoIt scanFrom: strm]! - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: identifierCharacter equals: $d. - att2 := TextDoIt scanFrom: strm. - self assert: att equals: att2. - self assert: (TextAttribute classFor: $d) equals: TextDoIt. - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3.! Item was changed: ----- Method: TextAttributesScanningTest>>testTextEmphasisBold (in category 'testing') ----- testTextEmphasisBold + self testScanAttribute: TextEmphasis bold encodedWithCharacter: $b - | att strm identifierCharacter att3 | - att := TextEmphasis bold. - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $b equals: identifierCharacter. - self assert: strm atEnd. - self assert: (TextAttribute classFor: $b) equals: TextEmphasis. - self assert: TextEmphasis equals: (TextAttribute classFor: $b). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3. ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextEmphasisItalic (in category 'testing') ----- testTextEmphasisItalic + self testScanAttribute: TextEmphasis italic encodedWithCharacter: $i! - | att strm identifierCharacter att3 | - att := TextEmphasis italic. - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $i equals: identifierCharacter. - self assert: strm atEnd. - self assert: TextEmphasis equals: (TextAttribute classFor: $i). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3. - ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextEmphasisNormal (in category 'testing') ----- testTextEmphasisNormal + self testScanAttribute: TextEmphasis normal encodedWithCharacter: $n! - | att strm identifierCharacter att3 | - att := TextEmphasis normal. - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $n equals: identifierCharacter. - self assert: strm atEnd. - self assert: TextEmphasis equals: (TextAttribute classFor: $n). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3. - ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextEmphasisStruckOut (in category 'testing') ----- testTextEmphasisStruckOut + self testScanAttribute: TextEmphasis struckOut encodedWithCharacter: $=! - | att strm identifierCharacter att3 | - att := TextEmphasis struckOut. - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $= equals: identifierCharacter. - self assert: strm atEnd. - self assert: (TextAttribute classFor: $=) equals: TextEmphasis. - self assert: TextEmphasis equals: (TextAttribute classFor: $= ). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3. - ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextEmphasisUnderlined (in category 'testing') ----- testTextEmphasisUnderlined + self testScanAttribute: TextEmphasis underlined encodedWithCharacter: $u! - | att strm identifierCharacter att3 | - att := TextEmphasis underlined. - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $u equals: identifierCharacter. - self assert: strm atEnd. - self assert: TextEmphasis equals: (TextAttribute classFor: $u). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3. - ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextFontChange (in category 'testing') ----- testTextFontChange + | att | - | att strm att2 identifierCharacter att3 | att := TextFontChange font3. + self testScanAttribute: att encodedWithCharacter: $f decodedWithBlock: [:strm | TextFontChange new fontNumber: (Integer readFrom: strm ifFail: [0])]! - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $f equals: identifierCharacter. - att2 := TextFontChange new fontNumber: (Integer readFrom: strm ifFail: [0]). - self assert: att equals: att2. - self assert: TextFontChange equals: (TextAttribute classFor: $f). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3.! Item was changed: ----- Method: TextAttributesScanningTest>>testTextFontReference (in category 'testing') ----- testTextFontReference "Test TextFontReference with a StrikeFont" + | font att att3 stream fontReferenceString | - | font att strm identifierCharacter fontReferenceString att3 | font := StrikeFont someInstance. att := TextFontReference toFont: font. + stream := self streamWithAttribute: att. + fontReferenceString := self testScanAttribute: att fromStream: stream encodedWithCharacter: $F decodedWithBlock: [:strm | strm upToEnd]. - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $F equals: identifierCharacter. - fontReferenceString := strm upToEnd. self assert: font familyName, '#', font height equals: fontReferenceString. + stream reset. + att3 := TextAttribute newFrom: stream. + self assert: att equals: att3.! - self assert: TextFontReference equals: (TextAttribute classFor: $F). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3. - ! Item was changed: ----- 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 att att3 stream fontReferenceString | - | font att strm identifierCharacter fontReferenceString att3 | font := TTCFont someInstance. att := TextFontReference toFont: font. + stream := self streamWithAttribute: att. + fontReferenceString := self testScanAttribute: att fromStream: stream encodedWithCharacter: $F decodedWithBlock: [:strm | strm upToEnd]. - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $F equals: identifierCharacter. - fontReferenceString := strm upToEnd. self assert: font familyName, '#', font height equals: fontReferenceString. + stream reset. + att3 := TextAttribute newFrom: stream. - self assert: TextFontReference equals: (TextAttribute classFor: $F). - strm reset. - att3 := TextAttribute newFrom: strm. "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>>testTextKern (in category 'testing') ----- testTextKern + | att | - | att strm att2 att3 | 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]. + - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - 5 timesRepeat: [self assert: $+ equals: strm next]. - self assert: strm atEnd. - strm reset. - att2 := TextAttribute newFrom: strm. - self assert: att equals: att2. - att := TextKern kern: -5. + self testScanAttribute: att encodedWithCharacter: $- decodedWithBlock: [:strm | + strm skip: -1. + 5 timesRepeat: [self assert: $- equals: strm next]. + att].! - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - 5 timesRepeat: [self assert: $- equals: strm next]. - self assert: strm atEnd. - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3.! Item was changed: ----- Method: TextAttributesScanningTest>>testTextLink (in category 'testing') ----- testTextLink + | att | - | att strm att2 identifierCharacter att3 | att := TextLink new classAndMethod: 'class and method string'. + self testScanAttribute: att encodedWithCharacter: $L decodedWithBlock: [:strm | TextLink scanFrom: strm].! - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $L equals: identifierCharacter. - att2 := TextLink scanFrom: strm. - self assert: att equals: att2. - self assert: TextLink equals: (TextAttribute classFor: $L). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3.! Item was changed: ----- Method: TextAttributesScanningTest>>testTextMessageLink (in category 'testing') ----- testTextMessageLink | att strm | att := TextMessageLink message: Message someInstance. + strm := WriteStream on: ''. - strm := ReadWriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). att writeScanOn: strm. "FIXME - is TextMessageLink used for anything?" ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextPlusJumpEnd (in category 'testing') ----- testTextPlusJumpEnd | att strm | att := TextPlusJumpEnd new jumpLabel: 'this is a jump label'. + strm := WriteStream on: ''. - strm := ReadWriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). att writeScanOn: strm. "FIXME - is TextPlusJumpEnd used for anything?" ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextPlusJumpStart (in category 'testing') ----- testTextPlusJumpStart | att strm | att := TextPlusJumpStart new jumpLabel: 'this is a jump label'. + strm := WriteStream on: ''. - strm := ReadWriteStream on: ''. self assert: (att respondsTo: #writeScanOn:). att writeScanOn: strm. "FIXME - is TextPlusJumpStart used for anything?" ! Item was changed: ----- Method: TextAttributesScanningTest>>testTextPrintIt (in category 'testing') ----- testTextPrintIt + | att | - | att strm att2 identifierCharacter att3 | att := TextPrintIt evalString: 'foo'. + self testScanAttribute: att encodedWithCharacter: $P decodedWithBlock: [:strm | TextPrintIt scanFrom: strm]! - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $P equals: identifierCharacter. - att2 := TextPrintIt scanFrom: strm. - self assert: att equals: att2. - self assert: TextPrintIt equals: (TextAttribute classFor: $P). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3.! Item was changed: ----- Method: TextAttributesScanningTest>>testTextSqkPageLink (in category 'testing') ----- testTextSqkPageLink + | att | - | att strm att2 identifierCharacter att3 | att := TextSqkPageLink new url: 'a URL string'. + self testScanAttribute: att encodedWithCharacter: $q decodedWithBlock: [:strm | TextSqkPageLink scanFrom: strm]! - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $q equals: identifierCharacter. - att2 := TextSqkPageLink scanFrom: strm. - self assert: att equals: att2. - self assert: TextSqkPageLink equals: (TextAttribute classFor: $q). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3.! Item was changed: ----- Method: TextAttributesScanningTest>>testTextSqkProjectLink (in category 'testing') ----- testTextSqkProjectLink + | att | - | att strm att2 identifierCharacter att3 | att := TextSqkProjectLink new url: 'a URL string'. + self testScanAttribute: att encodedWithCharacter: $p decodedWithBlock: [:strm | TextSqkProjectLink scanFrom: strm]! - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $p equals: identifierCharacter. - att2 := TextSqkProjectLink scanFrom: strm. - self assert: att equals: att2. - self assert: TextSqkProjectLink equals: (TextAttribute classFor: $p). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3.! Item was changed: ----- Method: TextAttributesScanningTest>>testTextURL (in category 'testing') ----- testTextURL + | att | - | att strm att2 identifierCharacter att3 | att := TextURL new url: 'a URL string'. + self testScanAttribute: att encodedWithCharacter: $R decodedWithBlock: [:strm | TextURL scanFrom: strm]! - strm := ReadWriteStream on: ''. - att writeScanOn: strm. - strm reset. - identifierCharacter := strm next. - self assert: $R equals: identifierCharacter. - att2 := TextURL scanFrom: strm. - self assert: att equals: att2. - self assert: TextURL equals: (TextAttribute classFor: $R). - strm reset. - att3 := TextAttribute newFrom: strm. - self assert: att equals: att3.!
More information about the Squeak-dev mailing list |