Smalltalk interchangeVersion: '1.0'! Class named: 'SixxMockBinaryData' superclass: 'Object' indexedInstanceVariables: #object instanceVariableNames: 'author version ' classVariableNames: '' sharedPools: '' classInstanceVariableNames: ''! Annotation key: 'package' value: 'SIXX-Test'! Object method! initializeFromSixxElement: sixxElement context: aDictionary (SixxXmlUtil elementsFrom: sixxElement) do: [:elem | | varName | (SixxXmlUtil isTextFrom: elem) ifFalse: [varName := self class nameFromSixxElement: elem. varName notNil ifTrue: [| childInst | childInst := self class fromSixxElement: elem context: aDictionary. self sixxInstVarNamed: varName put: childInst]]]. self class isVariable ifTrue: [| idx dataElem | idx := 1. dataElem := ((SixxXmlUtil elementsFrom: sixxElement) select: [:each | (self class nameFromSixxElement: each) isNil]) first. (SixxXmlUtil elementsFrom: dataElem) do: [:elem | | childInst | (SixxXmlUtil isTextFrom: elem) ifFalse: [childInst := self class fromSixxElement: elem context: aDictionary. self at: idx put: childInst. idx := idx + 1]]]! Annotation key: 'category' value: 'initializing-sixx'! Annotation key: 'stamp' value: 'MU 10/21/2002 00:55'! Object method! sixxAllContentsOn: aStream indent: level context: dictionary self sixxInstVarsOn: aStream indent: level context: dictionary. self sixxElementsOn: aStream indent: level context: dictionary.! Annotation key: 'category' value: 'private-sixx'! Annotation key: 'stamp' value: 'MU 10/20/2002 02:31'! Object method! sixxChildrenContentsFixedOn: aStream indent: level context: dictionary self sixxInstVarsOn: aStream indent: level context: dictionary! Annotation key: 'category' value: 'private-sixx'! Annotation key: 'stamp' value: 'MU 10/20/2002 02:40'! Object method! sixxChildrenContentsVariableOn: aStream indent: level context: dictionary self class isBits ifTrue: [aStream nextPutAll: '#( '. self do: [:each | aStream nextPutAll: each asString; space]. aStream nextPutAll: ')'] ifFalse: [self sixxAllContentsOn: aStream indent: level context: dictionary]! Annotation key: 'category' value: 'private-sixx'! Annotation key: 'stamp' value: 'MU 10/20/2002 02:35'! Object method! sixxElementsOn: aStream indent: level context: dictionary "override if you like" | size array | size := self basicSize. size = 0 ifTrue: [^ self]. array := Array new: size. 1 to: size do: [:i | | element | element := self basicAt: i. array at: i put: element]. array sixxOn: aStream indent: level context: dictionary! Annotation key: 'category' value: 'private-sixx'! Annotation key: 'stamp' value: 'MU 10/21/2002 01:01'! Object method! sixxInstVarsOn: aStream indent: level context: dictionary | instVars ind | aStream cr. instVars := self class allInstVarNames. ind := 0. instVars do: [:nm | ind := ind + 1. (self instVarAt: ind) sixxOn: aStream name: nm indent: level context: dictionary]! Annotation key: 'category' value: 'private-sixx'! Annotation key: 'stamp' value: 'MU 10/20/2002 02:30'! SixxMockBinaryData method! author ^author! Annotation key: 'category' value: 'accessing'! Annotation key: 'stamp' value: 'MU 10/20/2002 22:58'! SixxMockBinaryData method! author: aString author := aString ! Annotation key: 'category' value: 'accessing'! Annotation key: 'stamp' value: 'MU 10/20/2002 22:59'! SixxMockBinaryData method! version ^version! Annotation key: 'category' value: 'accessing'! Annotation key: 'stamp' value: 'MU 10/20/2002 22:59'! SixxMockBinaryData method! version: aString version := aString ! Annotation key: 'category' value: 'accessing'! Annotation key: 'stamp' value: 'MU 10/20/2002 23:00'! SixxMockBinaryData classMethod! author: author version: version data: binaryData "SixxMockBinaryData author: 'MU' version: '0.1' data: #(1 2 3)" | inst idx | inst := self new: binaryData size. idx := 0. binaryData do: [:each | inst at: (idx := idx + 1) put: each]. inst author: author. inst version: version. ^inst ! Annotation key: 'category' value: 'instance creation'! Annotation key: 'stamp' value: 'MU 10/21/2002 01:03'! Collection method! sixxAllContentsOn: aStream indent: level context: dictionary "Usually Collection's inst vars are not needed for serialization" self sixxElementsOn: aStream indent: level context: dictionary.! Annotation key: 'category' value: 'private-sixx'! Annotation key: 'stamp' value: 'MU 10/20/2002 02:38'! Collection method! sixxElementsOn: aStream indent: level context: dictionary "override if you like" self size = 0 ifTrue: [^self]. aStream cr. self do: [:each | each sixxOn: aStream indent: level context: dictionary] ! Annotation key: 'category' value: 'private-sixx'! Annotation key: 'stamp' value: 'MU 10/20/2002 02:59'! Behavior method! createInstanceOf: aClass withSixxElement: sixxElement "override if you like" ^ aClass isVariable ifTrue: [| dataElem | dataElem := ((SixxXmlUtil elementsFrom: sixxElement) select: [:each | (self nameFromSixxElement: each) isNil]) first. aClass new: (SixxXmlUtil elementsFrom: dataElem) size] ifFalse: [aClass new]! Annotation key: 'category' value: 'instance creation-sixx'! Annotation key: 'stamp' value: 'minami 10/23/2002 00:53'! SixxGeneratingTestCase method! testSixxStringForVariableObject | expectedStr variableObj | expectedStr :=' MU 0.1 1 2 3 '. variableObj := SixxMockBinaryData author: 'MU' version: '0.1' data: #(1 2 3). self should: [variableObj sixxString = expectedStr]! Annotation key: 'category' value: 'tests'! Annotation key: 'stamp' value: 'MU 10/21/2002 01:05'! SixxLoadingTestCase method! testReadSixxForVariableObject | sixxString variableObj | sixxString := ' MU 0.1 1 2 3 '. variableObj := Object readSixxFrom: sixxString. self should: [ variableObj author = 'MU']. self should: [ variableObj version = '0.1']. self should: [ variableObj size = 3]. self should: [ (variableObj at: 1) = 1]. self should: [ (variableObj at: 2) = 2]. self should: [ (variableObj at: 3) = 3]. ! Annotation key: 'category' value: 'tests'! Annotation key: 'stamp' value: 'MU 10/21/2002 01:09'!