[Pkg] Squeak3.10bc: NetworkTests-kph.10.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Sat Dec 13 04:47:48 UTC 2008
A new version of NetworkTests was added to project Squeak3.10bc:
http://www.squeaksource.com/310bc/NetworkTests-kph.10.mcz
==================== Summary ====================
Name: NetworkTests-kph.10
Author: kph
Time: 13 December 2008, 4:47:47 am
UUID: 7783b7a2-e298-461e-b1c8-c0749d7c89df
Ancestors: NetworkTests-md.9
Saved from SystemVersion
==================== Snapshot ====================
SystemOrganization addCategory: #'NetworkTests-Kernel'!
SystemOrganization addCategory: #'NetworkTests-Protocols'!
SystemOrganization addCategory: #'NetworkTests-RFC822'!
SystemOrganization addCategory: #'NetworkTests-UUID'!
SystemOrganization addCategory: #'NetworkTests-Url'!
SystemOrganization addCategory: #'NetworkTests-URI'!
Stream subclass: #MockSocketStream
instanceVariableNames: 'atEnd inStream outStream'
classVariableNames: ''
poolDictionaries: ''
category: 'NetworkTests-Kernel'!
----- Method: MockSocketStream class>>on: (in category 'instance creation') -----
on: socket
^self basicNew initialize!
----- Method: MockSocketStream>>atEnd (in category 'testing') -----
atEnd
^self inStream atEnd.!
----- Method: MockSocketStream>>atEnd: (in category 'accessing') -----
atEnd: aBoolean
atEnd := aBoolean.!
----- Method: MockSocketStream>>inStream (in category 'accessing') -----
inStream
^inStream!
----- Method: MockSocketStream>>initialize (in category 'initialize-release') -----
initialize
self resetInStream.
self resetOutStream.!
----- Method: MockSocketStream>>nextLine (in category 'stream in') -----
nextLine
^self nextLineCrLf!
----- Method: MockSocketStream>>nextLineCrLf (in category 'stream in') -----
nextLineCrLf
^(self upToAll: String crlf).!
----- Method: MockSocketStream>>outStream (in category 'accessing') -----
outStream
^outStream!
----- Method: MockSocketStream>>resetInStream (in category 'stream in') -----
resetInStream
inStream := WriteStream on: ''.!
----- Method: MockSocketStream>>resetOutStream (in category 'stream out') -----
resetOutStream
outStream := WriteStream on: ''.!
----- Method: MockSocketStream>>sendCommand: (in category 'stream out') -----
sendCommand: aString
self outStream
nextPutAll: aString;
nextPutAll: String crlf.!
----- Method: MockSocketStream>>upToAll: (in category 'stream in') -----
upToAll: delims
^self inStream upToAll: delims.!
TestCase subclass: #MailAddressParserTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'NetworkTests-RFC822'!
!MailAddressParserTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class MailAddressParser. 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
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: MailAddressParserTest>>testAddressesIn (in category 'tests') -----
testAddressesIn
| testString correctAnswer |
testString := 'joe at lama.com, joe2 at lama.com joe3 at lama.com joe4 , Not an Address <joe5 at address>, joe.(annoying (nested) comment)literal@[1.2.3.4], "an annoying" group : joe1 at groupie, joe2 at groupie, "Joey" joe3 at groupy, "joe6"."joe8"@group.com;, Lex''s email account <lex>'.
correctAnswer := #('joe at lama.com' 'joe2 at lama.com' 'joe3 at lama.com' 'joe4' 'joe5 at address' 'joe.literal@[1.2.3.4]' 'joe1 at groupie' 'joe2 at groupie' '"Joey"' 'joe3 at groupy' '"joe6"."joe8"@group.com' 'lex') asOrderedCollection.
self assert: ((MailAddressParser addressesIn: testString) = correctAnswer).!
TestCase subclass: #SMTPClientTest
instanceVariableNames: 'smtp socket'
classVariableNames: ''
poolDictionaries: ''
category: 'NetworkTests-Protocols'!
----- Method: SMTPClientTest>>setUp (in category 'running') -----
setUp
socket := MockSocketStream on: ''.
smtp := SMTPClient new.
smtp stream: socket.!
----- Method: SMTPClientTest>>testMailFrom (in category 'testing') -----
testMailFrom
smtp mailFrom: 'frank at angband.za.org'.
self assert: socket outStream contents = ('MAIL FROM: <frank at angband.za.org>', String crlf).
socket resetOutStream.
smtp mailFrom: '<frank at angband.za.org>'.
self assert: socket outStream contents = ('MAIL FROM: <frank at angband.za.org>', String crlf).
socket resetOutStream.
smtp mailFrom: 'Frank <frank at angband.za.org>'.
self assert: socket outStream contents = ('MAIL FROM: <frank at angband.za.org>', String crlf).!
TestCase subclass: #SocketStatsTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'NetworkTests-Kernel'!
----- Method: SocketStatsTest>>stats (in category 'support') -----
stats
^ Socket
!
----- Method: SocketStatsTest>>testHttpSocket (in category 'standard tests(net)') -----
testHttpSocket
self testOpen: [ HTTPSocket new ] close: [ :s | s destroy ].!
----- Method: SocketStatsTest>>testOldSocket (in category 'standard tests(net)') -----
testOldSocket
self testOpen: [ OldSocket new ] close: [ :s | s destroy ].!
----- Method: SocketStatsTest>>testOpen:close: (in category 'support') -----
testOpen: socketOpeningBlock close: socketClosingBlock
| beforeOpened beforeClosed socket |
beforeOpened := self stats statsOpened.
beforeClosed := self stats statsClosed.
socket := socketOpeningBlock value.
self assert: (self stats statsOpened = (beforeOpened + 1)).
self assert: (self stats statsClosed = beforeClosed).
socketClosingBlock value: socket.
self assert: (self stats statsOpened = (beforeOpened + 1)).
self assert: (self stats statsClosed = (beforeClosed + 1)).
!
----- Method: SocketStatsTest>>testSocket (in category 'standard tests(net)') -----
testSocket
self testOpen: [ Socket new ] close: [ :s | s destroy ].!
TestCase subclass: #TestURI
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'NetworkTests-URI'!
!TestURI commentStamp: 'mir 2/27/2002 14:42' prior: 0!
Main comment stating the purpose of this class and relevant relationship to other classes.
Some parsers allow the scheme name to be present in a relative URI if
it is the same as the base URI scheme. This is considered to be a
loophole in prior specifications of partial URI [RFC1630]. Its use
should be avoided.
http:g = http:g ; for validating parsers
| http://a/b/c/g ; for backwards compatibility
!
----- Method: TestURI class>>generateAbnormalResolverTests (in category 'test generation') -----
generateAbnormalResolverTests
"TestURI generateAbnormalResolverTests"
| relURIString result method testPairs pair |
testPairs _ #(
#('../../../g' 'http://a/../g' )
#('../../../../g' 'http://a/../../g' )
#('/./g' 'http://a/./g' )
#('/../g' 'http://a/../g' )
#('g.' 'http://a/b/c/g.' )
#('.g' 'http://a/b/c/.g' )
#('g..' 'http://a/b/c/g..' )
#('..g' 'http://a/b/c/..g' )
#('./../g' 'http://a/b/g' )
#('./g/.' 'http://a/b/c/g/' )
#('g/./h' 'http://a/b/c/g/h' )
#('g/../h' 'http://a/b/c/h' )
#('g;x=1/./y' 'http://a/b/c/g;x=1/y' )
#('g;x=1/../y' 'http://a/b/c/y' )
#('g?y/./x' 'http://a/b/c/g?y/./x' )
#('g?y/../x' 'http://a/b/c/g?y/../x' )
#('g#s/./x' 'http://a/b/c/g#s/./x' )
#('g#s/../x' 'http://a/b/c/g#s/../x' )
).
1 to: testPairs size do: [:index |
pair _ testPairs at: index.
relURIString _ pair first.
result _ pair last.
method _ String streamContents: [:stream |
stream nextPutAll: 'testResolveAbnormal' , index printString; cr.
stream
nextPutAll: ' | baseURI relURI resolvedURI |' ; cr;
nextPutAll: ' baseURI _ ''http://a/b/c/d;p?q'' asURI.' ; cr;
nextPutAll: ' relURI _ '; nextPut: $'; nextPutAll: relURIString; nextPutAll: '''.' ; cr;
nextPutAll: ' resolvedURI _ baseURI resolveRelativeURI: relURI.' ; cr;
nextPutAll: ' self should: [resolvedURI asString = '''; nextPutAll: result; nextPutAll: '''].' ; cr].
self compile: method classified: 'running resolving'].
!
----- Method: TestURI class>>generateNormalResolverTests (in category 'test generation') -----
generateNormalResolverTests
"TestURI generateNormalResolverTests"
| relURIString result method testPairs pair |
testPairs _ #(
#('g:h' 'g:h' )
#('g' 'http://a/b/c/g' )
#('./g' 'http://a/b/c/g' )
#('g/' 'http://a/b/c/g/' )
#('/g' 'http://a/g' )
#('//g' 'http://g' )
#('?y' 'http://a/b/c/?y' )
#('g?y' 'http://a/b/c/g?y' )
#('g#s' 'http://a/b/c/g#s' )
#('g?y#s' 'http://a/b/c/g?y#s' )
#(';x' 'http://a/b/c/;x' )
#('g;x' 'http://a/b/c/g;x' )
#('g;x?y#s' 'http://a/b/c/g;x?y#s' )
#('.' 'http://a/b/c/' )
#('./' 'http://a/b/c/' )
#('..' 'http://a/b/' )
#('../' 'http://a/b/' )
#('../g' 'http://a/b/g' )
#('../..' 'http://a/' )
#('../../' 'http://a/' )
#('../../g' 'http://a/g' )
).
1 to: testPairs size do: [:index |
pair _ testPairs at: index.
relURIString _ pair first.
result _ pair last.
method _ String streamContents: [:stream |
stream nextPutAll: 'testResolveNormal' , index printString; cr.
stream
nextPutAll: ' | baseURI relURI resolvedURI |' ; cr;
nextPutAll: ' baseURI _ ''http://a/b/c/d;p?q'' asURI.' ; cr;
nextPutAll: ' relURI _ '; nextPut: $'; nextPutAll: relURIString; nextPutAll: '''.' ; cr;
nextPutAll: ' resolvedURI _ baseURI resolveRelativeURI: relURI.' ; cr;
nextPutAll: ' self should: [resolvedURI asString = '''; nextPutAll: result; nextPutAll: '''].' ; cr].
self compile: method classified: 'running resolving'].
!
----- Method: TestURI>>testDefaultDirRoundtrip (in category 'running file') -----
testDefaultDirRoundtrip
| defaultDir defaultURI uriDir |
defaultDir := FileDirectory default.
defaultURI := defaultDir uri.
uriDir := FileDirectory uri: defaultURI.
self should: [defaultDir fullName = uriDir fullName]!
----- Method: TestURI>>testDirectoryRoot (in category 'running file') -----
testDirectoryRoot
| rootDir uriRoot uriDir |
rootDir := FileDirectory root.
uriRoot := 'file:///' asURI.
uriDir := FileDirectory uri: uriRoot.
self should: [rootDir fullName = uriDir fullName]!
----- Method: TestURI>>testResolveAbnormal1 (in category 'running resolving') -----
testResolveAbnormal1
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '../../../g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/../g'].
!
----- Method: TestURI>>testResolveAbnormal10 (in category 'running resolving') -----
testResolveAbnormal10
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ './g/.'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g/'].
!
----- Method: TestURI>>testResolveAbnormal11 (in category 'running resolving') -----
testResolveAbnormal11
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g/./h'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g/h'].
!
----- Method: TestURI>>testResolveAbnormal12 (in category 'running resolving') -----
testResolveAbnormal12
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g/../h'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/h'].
!
----- Method: TestURI>>testResolveAbnormal13 (in category 'running resolving') -----
testResolveAbnormal13
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g;x=1/./y'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g;x=1/y'].
!
----- Method: TestURI>>testResolveAbnormal14 (in category 'running resolving') -----
testResolveAbnormal14
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g;x=1/../y'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/y'].
!
----- Method: TestURI>>testResolveAbnormal15 (in category 'running resolving') -----
testResolveAbnormal15
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g?y/./x'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g?y/./x'].
!
----- Method: TestURI>>testResolveAbnormal16 (in category 'running resolving') -----
testResolveAbnormal16
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g?y/../x'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g?y/../x'].
!
----- Method: TestURI>>testResolveAbnormal17 (in category 'running resolving') -----
testResolveAbnormal17
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g#s/./x'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g#s/./x'].
!
----- Method: TestURI>>testResolveAbnormal18 (in category 'running resolving') -----
testResolveAbnormal18
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g#s/../x'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g#s/../x'].
!
----- Method: TestURI>>testResolveAbnormal2 (in category 'running resolving') -----
testResolveAbnormal2
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '../../../../g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/../../g'].
!
----- Method: TestURI>>testResolveAbnormal3 (in category 'running resolving') -----
testResolveAbnormal3
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '/./g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/./g'].
!
----- Method: TestURI>>testResolveAbnormal4 (in category 'running resolving') -----
testResolveAbnormal4
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '/../g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/../g'].
!
----- Method: TestURI>>testResolveAbnormal5 (in category 'running resolving') -----
testResolveAbnormal5
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g.'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g.'].
!
----- Method: TestURI>>testResolveAbnormal6 (in category 'running resolving') -----
testResolveAbnormal6
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '.g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/.g'].
!
----- Method: TestURI>>testResolveAbnormal7 (in category 'running resolving') -----
testResolveAbnormal7
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g..'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g..'].
!
----- Method: TestURI>>testResolveAbnormal8 (in category 'running resolving') -----
testResolveAbnormal8
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '..g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/..g'].
!
----- Method: TestURI>>testResolveAbnormal9 (in category 'running resolving') -----
testResolveAbnormal9
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ './../g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/g'].
!
----- Method: TestURI>>testResolveNormal1 (in category 'running resolving') -----
testResolveNormal1
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g:h'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'g:h'].
!
----- Method: TestURI>>testResolveNormal10 (in category 'running resolving') -----
testResolveNormal10
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g?y#s'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g?y#s'].
!
----- Method: TestURI>>testResolveNormal11 (in category 'running resolving') -----
testResolveNormal11
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ ';x'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/;x'].
!
----- Method: TestURI>>testResolveNormal12 (in category 'running resolving') -----
testResolveNormal12
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g;x'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g;x'].
!
----- Method: TestURI>>testResolveNormal13 (in category 'running resolving') -----
testResolveNormal13
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g;x?y#s'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g;x?y#s'].
!
----- Method: TestURI>>testResolveNormal14 (in category 'running resolving') -----
testResolveNormal14
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '.'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/'].
!
----- Method: TestURI>>testResolveNormal15 (in category 'running resolving') -----
testResolveNormal15
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ './'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/'].
!
----- Method: TestURI>>testResolveNormal16 (in category 'running resolving') -----
testResolveNormal16
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '..'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/'].
!
----- Method: TestURI>>testResolveNormal17 (in category 'running resolving') -----
testResolveNormal17
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '../'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/'].
!
----- Method: TestURI>>testResolveNormal18 (in category 'running resolving') -----
testResolveNormal18
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '../g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/g'].
!
----- Method: TestURI>>testResolveNormal19 (in category 'running resolving') -----
testResolveNormal19
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '../..'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/'].
!
----- Method: TestURI>>testResolveNormal2 (in category 'running resolving') -----
testResolveNormal2
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g'].
!
----- Method: TestURI>>testResolveNormal20 (in category 'running resolving') -----
testResolveNormal20
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '../../'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/'].
!
----- Method: TestURI>>testResolveNormal21 (in category 'running resolving') -----
testResolveNormal21
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '../../g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/g'].
!
----- Method: TestURI>>testResolveNormal3 (in category 'running resolving') -----
testResolveNormal3
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ './g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g'].
!
----- Method: TestURI>>testResolveNormal4 (in category 'running resolving') -----
testResolveNormal4
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g/'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g/'].
!
----- Method: TestURI>>testResolveNormal5 (in category 'running resolving') -----
testResolveNormal5
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '/g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/g'].
!
----- Method: TestURI>>testResolveNormal6 (in category 'running resolving') -----
testResolveNormal6
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '//g'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://g'].
!
----- Method: TestURI>>testResolveNormal7 (in category 'running resolving') -----
testResolveNormal7
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ '?y'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/?y'].
!
----- Method: TestURI>>testResolveNormal8 (in category 'running resolving') -----
testResolveNormal8
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g?y'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g?y'].
!
----- Method: TestURI>>testResolveNormal9 (in category 'running resolving') -----
testResolveNormal9
| baseURI relURI resolvedURI |
baseURI _ 'http://a/b/c/d;p?q' asURI.
relURI _ 'g#s'.
resolvedURI _ baseURI resolveRelativeURI: relURI.
self should: [resolvedURI asString = 'http://a/b/c/g#s'].
!
----- Method: TestURI>>testSchemeAbsoluteFail1 (in category 'running parsing') -----
testSchemeAbsoluteFail1
self should: [URI fromString: 'http:'] raise: IllegalURIException!
----- Method: TestURI>>testSchemeAbsolutePass1 (in category 'running parsing') -----
testSchemeAbsolutePass1
| uri |
uri _ URI fromString: 'http://www.squeakland.org'.
self should: [uri scheme = 'http'].
self should: [uri isAbsolute].
self shouldnt: [uri isOpaque].
self shouldnt: [uri isRelative]!
----- Method: TestURI>>testSchemeAbsolutePass2 (in category 'running parsing') -----
testSchemeAbsolutePass2
| uri |
uri _ URI fromString: 'mailto:somebody at somewhere.nowhere'.
self should: [uri scheme = 'mailto'].
self should: [uri isAbsolute].
self should: [uri isOpaque].
self shouldnt: [uri isRelative]!
----- Method: TestURI>>testSchemeAbsolutePass3 (in category 'running parsing') -----
testSchemeAbsolutePass3
| uri |
uri _ URI fromString: 'ftp://ftp@squeak.org'.
self should: [uri scheme = 'ftp'].
self should: [uri isAbsolute].
self shouldnt: [uri isOpaque].
self shouldnt: [uri isRelative].
self should: [uri userInfo = 'ftp'].
self should: [uri host = 'squeak.org'].
self should: [uri port isNil].
!
----- Method: TestURI>>testSchemeAbsolutePass4 (in category 'running parsing') -----
testSchemeAbsolutePass4
| uri |
uri _ URI fromString: 'mailto:somebody at somewhere.nowhere#fragment'.
self should: [uri scheme = 'mailto'].
self should: [uri isAbsolute].
self should: [uri isOpaque].
self shouldnt: [uri isRelative].
self should: [uri fragment = 'fragment'].
!
----- Method: TestURI>>testSchemeAbsolutePass5 (in category 'running parsing') -----
testSchemeAbsolutePass5
| uri |
uri _ URI fromString: 'http://www.squeakland.org#fragment'.
self should: [uri scheme = 'http'].
self should: [uri isAbsolute].
self shouldnt: [uri isOpaque].
self shouldnt: [uri isRelative].
self should: [uri fragment = 'fragment'].
!
TestCase subclass: #UUIDPrimitivesTest
instanceVariableNames: ''
classVariableNames: 'Default'
poolDictionaries: ''
category: 'NetworkTests-UUID'!
----- Method: UUIDPrimitivesTest>>testCreation (in category 'tests') -----
testCreation
| uuid |
uuid _ UUID new.
self should: [uuid size = 16].
self shouldnt: [uuid isNilUUID].
self should: [uuid asString size = 36].
!
----- Method: UUIDPrimitivesTest>>testCreationEquality (in category 'tests') -----
testCreationEquality
| uuid1 uuid2 |
uuid1 _ UUID new.
uuid2 _ UUID new.
self should: [uuid1 = uuid1].
self should: [uuid2 = uuid2].
self shouldnt: [uuid1 = uuid2].
self shouldnt: [uuid1 hash = uuid2 hash].
!
----- Method: UUIDPrimitivesTest>>testCreationFromString (in category 'tests') -----
testCreationFromString
| uuid string |
string _ UUID nilUUID asString.
uuid _ UUID fromString: string.
self should: [uuid size = 16].
self should: [uuid = UUID nilUUID].
self should: [uuid isNilUUID].
self should: [uuid asString size = 36].
self should: [uuid asArray asSet size = 1].
self should: [(uuid asArray asSet asArray at: 1) = 0].
!
----- Method: UUIDPrimitivesTest>>testCreationFromStringNotNil (in category 'tests') -----
testCreationFromStringNotNil
| uuid string |
string _ UUID new asString.
uuid _ UUID fromString: string.
self should: [uuid size = 16].
self should: [uuid asString size = 36].
!
----- Method: UUIDPrimitivesTest>>testCreationNil (in category 'tests') -----
testCreationNil
| uuid |
uuid _ UUID nilUUID.
self should: [uuid size = 16].
self should: [uuid isNilUUID].
self should: [uuid asString size = 36].
self should: [uuid asArray asSet size = 1].
self should: [(uuid asArray asSet asArray at: 1) = 0].
!
----- Method: UUIDPrimitivesTest>>testCreationNodeBased (in category 'tests') -----
testCreationNodeBased
| uuid |
(UUID new asString last: 12) = (UUID new asString last: 12) ifFalse: [^self].
1000 timesRepeat:
[uuid _ UUID new.
self should: [((uuid at: 7) bitAnd: 16rF0) = 16r10].
self should: [((uuid at: 9) bitAnd: 16rC0) = 16r80]]
!
----- Method: UUIDPrimitivesTest>>testDuplicationsKinda (in category 'tests') -----
testDuplicationsKinda
|check uuid size |
size _ 5000.
check _ Set new: size.
size timesRepeat:
[uuid _ UUID new.
self shouldnt: [check includes: uuid].
check add: uuid].
!
----- Method: UUIDPrimitivesTest>>testOrder (in category 'tests') -----
testOrder
| uuid1 uuid2 |
100 timesRepeat:
[uuid1 _ UUID new.
uuid2 _ UUID new.
(uuid1 asString last: 12) = (uuid2 asString last: 12) ifTrue:
[self should: [uuid1 < uuid2].
self should: [uuid2 > uuid1].
self shouldnt: [uuid1 = uuid2]]]
!
ClassTestCase subclass: #FileUrlTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'NetworkTests-Url'!
----- Method: FileUrlTest>>testAsString (in category 'testing') -----
testAsString
| target url |
target := 'file://localhost/etc/rc.conf'.
url := target asUrl.
self assert: url asString = target.
!
ClassTestCase subclass: #GenericUrlTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'NetworkTests-Url'!
----- Method: GenericUrlTest>>testAsString (in category 'testing') -----
testAsString
| url |
url := GenericUrl new schemeName: 'sip' locator: 'foo at bar'.
self assert: url asString = 'sip:foo at bar'.!
ClassTestCase subclass: #HierarchicalUrlTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'NetworkTests-Url'!
----- Method: HierarchicalUrlTest>>testAsString (in category 'testing') -----
testAsString
| url |
url := HierarchicalUrl new
schemeName: 'ftp'
authority: 'localhost'
path: #('path' 'to' 'file')
query: 'aQuery'.
self assert: url asString = 'ftp://localhost/path/to/file?aQuery'.!
ClassTestCase subclass: #UrlTest
instanceVariableNames: 'url baseUrl expected string'
classVariableNames: ''
poolDictionaries: ''
category: 'NetworkTests-Url'!
!UrlTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Url. 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
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: UrlTest>>testAbsoluteBrowser (in category 'tests') -----
testAbsoluteBrowser
url _ Url absoluteFromText: 'browser:bookmarks#mainPart'.
self assert: url schemeName = 'browser'.
self assert: url locator = 'bookmarks'.
self assert:url fragment = 'mainPart'.
self assert: url class = BrowserUrl.
!
----- Method: UrlTest>>testAbsoluteFILE (in category 'tests') -----
testAbsoluteFILE
url _ Url absoluteFromText: 'file:/etc/passwd#foo'.
self assert: url schemeName = 'file'.
self assert: url path first = 'etc'.
self assert: url path size = 2.
self assert: url fragment = 'foo'.!
----- Method: UrlTest>>testAbsoluteFILE2 (in category 'tests') -----
testAbsoluteFILE2
url _ 'fILE:/foo/bar//zookie/?fakequery/#fragger' asUrl.
self assert: url schemeName = 'file'.
self assert: url class = FileUrl.
self assert: url path first ='foo'.
self assert: url path size = 5.
self assert: url fragment = 'fragger'.!
----- Method: UrlTest>>testAbsoluteFILE3 (in category 'tests') -----
testAbsoluteFILE3
"Just a few selected tests for FileUrl, not complete by any means."
{'file:'. 'file:/'. 'file://'} do: [:s |
url _ FileUrl absoluteFromText: s.
self assert: (url asString = 'file:///').
self assert: (url host = '').
self assert: url isAbsolute].
url _ FileUrl absoluteFromText: 'file://localhost/dir/file.txt'.
self assert: (url asString = 'file://localhost/dir/file.txt').
self assert: (url host = 'localhost').
url _ FileUrl absoluteFromText: 'file://localhost/dir/file.txt'.
self assert: (url asString = 'file://localhost/dir/file.txt').
self assert: (url host = 'localhost').
self assert: url isAbsolute.
url _ FileUrl absoluteFromText: 'file:///dir/file.txt'.
self assert: (url asString = 'file:///dir/file.txt').
self assert: (url host = '').
self assert: url isAbsolute.
url _ FileUrl absoluteFromText: '/dir/file.txt'.
self assert: (url asString = 'file:///dir/file.txt').
self assert: url isAbsolute.
url _ FileUrl absoluteFromText: 'dir/file.txt'.
self assert: (url asString = 'file:///dir/file.txt').
self deny: url isAbsolute.
url _ FileUrl absoluteFromText: 'c:/dir/file.txt'.
self assert: (url asString = 'file:///c%3A/dir/file.txt').
self assert: url isAbsolute.
"Only a drive letter doesn't refer to a directory."
url _ FileUrl absoluteFromText: 'c:'.
self assert: (url asString = 'file:///c%3A/').
self assert: url isAbsolute.
url _ FileUrl absoluteFromText: 'c:/'.
self assert: (url asString = 'file:///c%3A/').
self assert: url isAbsolute!
----- Method: UrlTest>>testAbsoluteFTP (in category 'tests') -----
testAbsoluteFTP
url _ 'ftP://some.server/some/directory/' asUrl.
self assert: url schemeName = 'ftp'.
self assert: url class = FtpUrl.
self assert: url authority = 'some.server'.
self assert: url path first = 'some'.
self assert: url path size = 3.
!
----- Method: UrlTest>>testAbsoluteHTTP (in category 'tests') -----
testAbsoluteHTTP
url _ 'hTTp://chaos.resnet.gatech.edu:8000/docs/java/index.html?A%20query%20#part' asUrl.
self assert: url schemeName = 'http'.
self assert: url authority = 'chaos.resnet.gatech.edu'.
self assert: url path first = 'docs'.
self assert: url path size = 3.
self assert: url query = 'A%20query%20'.
self assert: url fragment = 'part'.!
----- Method: UrlTest>>testAbsolutePortErrorFix (in category 'tests') -----
testAbsolutePortErrorFix
self shouldnt: [Url absoluteFromText: 'http://swikis.ddo.jp:8823/'] raise: Error.
self should: [Url absoluteFromText: 'http://swikis.ddo.jp:-1/'] raise: Error.
self should: [Url absoluteFromText: 'http://swikis.ddo.jp:65536/'] raise: Error.
self should: [Url absoluteFromText: 'http://swikis.ddo.jp:auau/'] raise: Error.!
----- Method: UrlTest>>testAbsoluteTELNET (in category 'tests') -----
testAbsoluteTELNET
url _ 'telNet:chaos.resnet.gatech.edu#goo' asUrl.
self assert: url schemeName = 'telnet'.
self assert: url locator = 'chaos.resnet.gatech.edu'.
self assert: url fragment = 'goo'.
!
----- Method: UrlTest>>testCombineWithRelative (in category 'tests') -----
testCombineWithRelative
#(#('http://www.rfc1149.net/' 'foo.html' 'http://www.rfc1149.net/foo.html') #('http://www.rfc1149.net/index.html' 'foo.html' 'http://www.rfc1149.net/foo.html') #('http://www.rfc1149.net/devel/' '../sam/' 'http://www.rfc1149.net/sam/') #('http://www.rfc1149.net/devel/index.html' '../sam/' 'http://www.rfc1149.net/sam/'))
do: [:a | self assert: (Url combine: a first withRelative: a second) = a third]!
----- Method: UrlTest>>testFromFileNameOrUrlString (in category 'testing') -----
testFromFileNameOrUrlString
url _ Url absoluteFromFileNameOrUrlString: 'asdf'.
self assert: url schemeName = 'file'.
self assert: url fragment isNil.
self assert: url class = FileUrl.
url _ Url absoluteFromFileNameOrUrlString: 'http://209.143.91.36/super/SuperSwikiProj/AAEmptyTest.001.pr'.
self assert: url schemeName = 'http'.
self assert: url fragment isNil.
self assert: url class = HttpUrl.!
----- Method: UrlTest>>testRelativeFILE (in category 'tests') -----
testRelativeFILE
| url2 |
baseUrl _ 'file:/some/dir#fragment1' asUrl.
url _ baseUrl newFromRelativeText: 'file:../another/dir/#fragment2'.
self assert: url asText = 'file:///another/dir/#fragment2'.
url _ FileUrl absoluteFromText: 'file://localhost/dir/dir2/file.txt'.
url2 _ FileUrl absoluteFromText: 'file://hostname/flip/file.txt'.
url2 privateInitializeFromText: '../file2.txt' relativeTo: url.
self assert: (url2 asString = 'file://localhost/dir/file2.txt').
self assert: (url2 host = 'localhost').
self assert: url2 isAbsolute.
url _ FileUrl absoluteFromText: 'file://localhost/dir/dir2/file.txt'.
url2 _ FileUrl absoluteFromText: 'flip/file.txt'.
self deny: url2 isAbsolute.
url2 privateInitializeFromText: '.././flip/file.txt' relativeTo: url.
self assert: (url2 asString = 'file://localhost/dir/flip/file.txt').
self assert: (url2 host = 'localhost').
self assert: url2 isAbsolute.
!
----- Method: UrlTest>>testRelativeFTP (in category 'tests') -----
testRelativeFTP
baseUrl _ 'ftp://somewhere/some/dir/?query#fragment' asUrl.
url _ baseUrl newFromRelativeText: 'ftp://a.b'.
self assert: url asString = 'ftp://a.b/'.!
----- Method: UrlTest>>testRelativeFTP2 (in category 'tests') -----
testRelativeFTP2
baseUrl _ 'ftp://somewhere/some/dir/?query#fragment' asUrl.
url _ baseUrl newFromRelativeText: 'ftp:xyz'.
self assert: url asString = 'ftp://somewhere/some/dir/xyz'.!
----- Method: UrlTest>>testRelativeFTP3 (in category 'tests') -----
testRelativeFTP3
baseUrl _ 'ftp://somewhere/some/dir/?query#fragment' asUrl.
url _ baseUrl newFromRelativeText: 'http:xyz'.
self assert: url asString = 'http://xyz/'.!
----- Method: UrlTest>>testRelativeHTTP (in category 'tests') -----
testRelativeHTTP
baseUrl _ 'http://some.where/some/dir?query1#fragment1' asUrl.
url _ baseUrl newFromRelativeText: '../another/dir/?query2#fragment2'.
self assert: url asString = 'http://some.where/another/dir/?query2#fragment2'.!
----- Method: UrlTest>>testRoundTripFILE (in category 'tests') -----
testRoundTripFILE
"File URLs should round-trip OK. This test should ultimately be
tested on all platforms."
| fileName |
fileName _ FileDirectory default fullNameFor: 'xxx.st'.
url _ FileDirectory urlForFileNamed: fileName.
self assert: (url pathForFile = fileName) description: 'fileName didn''t round-trip'.!
----- Method: UrlTest>>testUsernamePassword (in category 'tests') -----
testUsernamePassword
"basic case with a username+password specified"
url := 'http://user:pword@someserver.blah:8000/root/index.html' asUrl.
self should: [ url schemeName = 'http' ].
self should: [ url authority = 'someserver.blah' ].
self should: [ url port = 8000 ].
self should: [ url path first = 'root' ].
self should: [ url username = 'user' ].
self should: [ url password = 'pword' ].
"basic case for a relative url"
baseUrl := 'http://anotherserver.blah:9999/somedir/someotherdir/stuff/' asUrl.
url := 'http://user:pword@someserver.blah:8000/root/index.html' asUrlRelativeTo: baseUrl.
self should: [ url schemeName = 'http' ].
self should: [ url authority = 'someserver.blah' ].
self should: [ url port = 8000 ].
self should: [ url path first = 'root' ].
self should: [ url username = 'user' ].
self should: [ url password = 'pword' ].
"a true relative test that should keep the username and password from the base URL"
baseUrl := 'http://user:pword@someserver.blah:8000/root/index.html' asUrl.
url := '/anotherdir/stuff/' asUrlRelativeTo: baseUrl.
self should: [ url schemeName = 'http' ].
self should: [ url authority = 'someserver.blah' ].
self should: [ url port = 8000 ].
self should: [ url path first = 'anotherdir' ].
self should: [ url username = 'user' ].
self should: [ url password = 'pword' ].
"just a username specified"
url := 'http://user@someserver.blah:8000/root/index.html' asUrl.
self should: [ url schemeName = 'http' ].
self should: [ url authority = 'someserver.blah' ].
self should: [ url port = 8000 ].
self should: [ url path first = 'root' ].
self should: [ url username = 'user' ].
self should: [ url password = nil ].
"the port is not specified"
url := 'http://user:pword@someserver.blah/root/index.html' asUrl.
self should: [ url schemeName = 'http' ].
self should: [ url authority = 'someserver.blah' ].
self should: [ url port = nil ].
self should: [ url path first = 'root' ].
self should: [ url username = 'user' ].
self should: [ url password = 'pword' ].
"neither a path nor a port is specified"
url := 'http://user:pword@someserver.blah' asUrl.
self should: [ url schemeName = 'http' ].
self should: [ url authority = 'someserver.blah' ].
self should: [ url port = nil ].
self should: [ url username = 'user' ].
self should: [ url password = 'pword' ].
"relative URL where the username+password should be forgotten"
baseUrl := 'http://user:pword@someserver.blah' asUrl.
url := 'http://anotherserver.blah' asUrlRelativeTo: baseUrl.
self should: [ url username = nil ].
self should: [ url password = nil ].
!
----- Method: UrlTest>>testUsernamePasswordPrinting (in category 'tests') -----
testUsernamePasswordPrinting
#( 'http://user:pword@someserver.blah:8000/root/index.html'
'http://user@someserver.blah:8000/root/index.html'
'http://user:pword@someserver.blah/root/index.html'
) do: [ :urlText |
self should: [ urlText = urlText asUrl asString ] ].
!
More information about the Packages
mailing list