The Trunk: CollectionsTests-pre.302.mcz

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