Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
ReadWriteStreamTest
Last updated at 12:19 am UTC on 1 November 2006
'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 5 May 2003 at 8:53:22 pm'!
TestCase subclass: #ReadWriteStreamTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Tests-Collections-Streams'!

ReadWriteStreamTest commentStamp: '' prior: 0!

This is the unit test for the class ReadWriteStream. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- SUnit
- the sunit class category!


ReadWriteStreamTest methodsFor: 'initialize-release' stamp: 'AKA 5/5/2003 19:39'!

setUp
"I am the method in which your test is initialized.
If you have ressources to build, put them here."

!


ReadWriteStreamTest methodsFor: 'initialize-release' stamp: 'AKA 5/5/2003 19:38'!

tearDown
"I am called whenever your test ends.
I am the place where you release the ressources"! !


ReadWriteStreamTest methodsFor: 'Testing' stamp: 'AKA 5/5/2003 19:44'!

testConstructionUsingWith
"Use the with: constructor."

aStream
aStream _ ReadWriteStream with: #(1 2).
self assert: (aStream contents = #(1 2)) description: 'Ensure correct initialization.'! !

ReadWriteStreamTest methodsFor: 'Testing' stamp: 'AKA 5/5/2003 20:29'!

testConstructorUsingOn
"Use the on: constructor."

aStream
aStream _ ReadWriteStream on: #(1 2).
self assert: (aStream contents = #(1 2)) description: 'Ensure correct initialization.'! !

ReadWriteStreamTest methodsFor: 'Testing' stamp: 'AKA 5/5/2003 20:35'!

testTrackingPositionOnConstructedStream
"Ensure the ReadWriteStream is able to keep track of where it should be."

aStream nextItem startPosition currentPosition
aStream _ ReadWriteStream on: #(1 2).

nextItem _ aStream next.
self assert: (nextItem = 1)
description: 'first next message send should return 1st item in collection.'.

nextItem _ aStream next.
self assert: (nextItem = 2)
description: 'second next message send should return 2nd item in collection.'.
self assert: aStream
atEnd
description: 'After the second next message send in a two element collection we should be at the end.'.

aStream reset.
startPosition _ aStream position.
self assert: ( startPosition = 0)
description: 'Should be back to the starting point upon reset.'.
nextItem _ aStream next.
self assert: (nextItem = 1)
description: 'after a reset the following next message send should return 1st item in collection.'.
currentPosition _ aStream position.
self assert: (currentPosition = 1).! !

ReadWriteStreamTest methodsFor: 'Testing' stamp: 'AKA 5/5/2003 20:33'!

testTrackingPositionWithConstructedStream
"Ensure the ReadWriteStream is able to keep track of where it should be."

aStream nextItem startPosition currentPosition
aStream _ ReadWriteStream with: #(1 2).
"Uncommenting and sending reset will cause broken test to pass."
"aStream reset."
nextItem _ aStream next.
self assert: (nextItem = 1)
description: 'first next message send should return 1st item in collection.'.

nextItem _ aStream next.
self assert: (nextItem = 2)
description: 'second next message send should return 2nd item in collection.'.
self assert: aStream
atEnd
description: 'After the second next message send in a two element collection we should be at the end.'.

aStream reset.
startPosition _ aStream position.
self assert: ( startPosition = 0)
description: 'Should be back to the starting point upon reset.'.
nextItem _ aStream next.
self assert: (nextItem = 1)
description: 'after a reset the following next message send should return 1st item in collection.'.
currentPosition _ aStream position.
self assert: (currentPosition = 1).! !

ReadWriteStreamTest methodsFor: 'Testing' stamp: 'AKA 5/5/2003 20:38'!

testWritingToOnConstructedStream
"test instance created using the on: constructor."

aStream theContents
aStream _ ReadWriteStream on: #(1 2).

aStream next.
aStream nextPut: 7.
aStream nextPut: 8.
theContents _ aStream contents.
self assert: (theContents = #(1 7 8))
description: 'Should be able to add objects one at a time to collection.'.

aStream nextPutAll: 'AB'.
theContents _ aStream contents.
self assert: (theContents = #(1 7 8 $A $B))
description: 'Should be able to add collections to collection.'.

!


ReadWriteStreamTest methodsFor: 'Testing' stamp: 'AKA 5/5/2003 20:38'!

testWritingToWithConstructedStream
"test instance created using the with: constructor."

aStream theContents
aStream _ ReadWriteStream with: #(1 2).
"Uncommenting and sending reset will cause broken test to pass."
"aStream reset."
aStream next.
aStream nextPut: 7.
aStream nextPut: 8.
theContents _ aStream contents.
self assert: (theContents = #(1 7 8))
description: 'Should be able to add objects one at a time to collection.'.

aStream nextPutAll: 'AB'.
theContents _ aStream contents.
self assert: (theContents = #(1 7 8 $A $B))
description: 'Should be able to add collections to collection.'.

!