The Trunk: CollectionsTests-nice.221.mcz

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.!