[squeak-dev] Squeak 4.5: NetworkTests-fbs.37.mczcommits at source.squeak.org commits at source.squeak.orgFri Jan 24 20:24:33 UTC 2014
Chris Muller uploaded a new version of NetworkTests to project Squeak 4.5: http://source.squeak.org/squeak45/NetworkTests-fbs.37.mcz ==================== Summary ==================== Name: NetworkTests-fbs.37 Author: fbs Time: 6 November 2013, 6:35:55.414 pm UUID: 97699685-5826-fe47-af98-356971abf2fb Ancestors: NetworkTests-fbs.36 More #shouldnt:raise: Error fixes. ==================== Snapshot ==================== SystemOrganization addCategory: #'NetworkTests-Kernel'! SystemOrganization addCategory: #'NetworkTests-Protocols'! SystemOrganization addCategory: #'NetworkTests-RFC822'! SystemOrganization addCategory: #'NetworkTests-URI'! SystemOrganization addCategory: #'NetworkTests-UUID'! SystemOrganization addCategory: #'NetworkTests-Url'! 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>, foo+bar at baz.com'. 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' 'foo+bar at baz.com') asOrderedCollection. self assert: ((MailAddressParser addressesIn: testString) = correctAnswer).! TestCase subclass: #MailMessageTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'NetworkTests-RFC822'! !MailMessageTest commentStamp: 'tonyg 9/12/2011 09:17' prior: 0! This is the unit test for the class MailMessage.! ----- Method: MailMessageTest>>testDateStampFractionalSecondFormatting (in category 'as yet unclassified') ----- testDateStampFractionalSecondFormatting self assert: (MailMessage dateStamp: (DateAndTime fromSeconds: 1.234)) = 'Tue, 1 Jan 1901 00:00:01' description: 'RFC822 (and RFC2822) forbids non-integer seconds in dates'! 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: #SocketTest instanceVariableNames: 'listenerSocket clientSocket serverSocket' classVariableNames: '' poolDictionaries: '' category: 'NetworkTests-Kernel'! ----- Method: SocketTest>>listenerAddress (in category 'setup') ----- listenerAddress ^NetNameResolver localHostAddress ! ----- Method: SocketTest>>listenerPort (in category 'setup') ----- listenerPort ^42324 ! ----- Method: SocketTest>>setUp (in category 'setup') ----- setUp listenerSocket := Socket newTCP listenOn: self listenerPort backlogSize: 4 interface: self listenerAddress. ! ----- Method: SocketTest>>tearDown (in category 'setup') ----- tearDown listenerSocket ifNotNil:[listenerSocket destroy]. clientSocket ifNotNil:[clientSocket destroy]. serverSocket ifNotNil:[serverSocket destroy]. ! ----- Method: SocketTest>>testClientConnect (in category 'tests') ----- testClientConnect "Tests a client socket connection" clientSocket := Socket newTCP. clientSocket connectTo: self listenerAddress port: self listenerPort. clientSocket waitForConnectionFor: 2. self assert: clientSocket isConnected. ! ----- Method: SocketTest>>testDataReceive (in category 'tests') ----- testDataReceive "Test data transfer and related methods" self testDataSending. "It can take a tad for the status change to be visible" (Delay forMilliseconds: 200) wait. self assert: serverSocket dataAvailable. self assert: (serverSocket receiveData = 'Hello World'). self deny: (serverSocket dataAvailable). ! ----- Method: SocketTest>>testDataSending (in category 'tests') ----- testDataSending "Test data transfer and related methods" self testServerAccept. clientSocket sendData: 'Hello World'. clientSocket waitForSendDoneFor: 2. self assert: clientSocket sendDone. ! ----- Method: SocketTest>>testLocalAddress (in category 'tests') ----- testLocalAddress "Tests the various localAddress values for sockets" self testServerAccept. self assert: listenerSocket localAddress = self listenerAddress. self assert: clientSocket localAddress = self listenerAddress. self assert: serverSocket localAddress = self listenerAddress. ! ----- Method: SocketTest>>testLocalPort (in category 'tests') ----- testLocalPort "Tests the various localPort values for sockets" self testServerAccept. self assert: listenerSocket localPort = self listenerPort. self assert: clientSocket localPort > 0. self assert: serverSocket localPort > 0. ! ----- Method: SocketTest>>testPeerName (in category 'tests') ----- testPeerName "None of these should throw an exception." Socket new peerName. self testServerAccept. listenerSocket peerName. clientSocket peerName. serverSocket peerName.! ----- Method: SocketTest>>testReceiveTimeout (in category 'tests') ----- testReceiveTimeout "Test data transfer and related methods" self testServerAccept. self assert: (serverSocket receiveDataTimeout: 1) isEmpty.! ----- Method: SocketTest>>testRemoteAddress (in category 'tests') ----- testRemoteAddress "Tests the various remoteAddress values for sockets" self testServerAccept. self assert: listenerSocket remoteAddress asByteArray = #[0 0 0 0]. self assert: clientSocket remoteAddress = self listenerAddress. self assert: serverSocket remoteAddress = self listenerAddress. ! ----- Method: SocketTest>>testRemotePort (in category 'tests') ----- testRemotePort "Tests the various remoteAddress values for sockets" self testServerAccept. self assert: listenerSocket remotePort = 0. self assert: clientSocket remotePort = self listenerPort. self assert: serverSocket remotePort > 0. ! ----- Method: SocketTest>>testSendTimeout (in category 'tests') ----- testSendTimeout "Test data transfer and related methods" | buffer ex | self testServerAccept. buffer := ByteArray new: 1000. "Write to the socket until the platform reports that sending is not complete." [serverSocket sendDone] whileTrue:[ serverSocket sendSomeData: buffer. ]. "The network layer is now either blocked or in the process of sending data in its buffers. It may or may not be able buffer additional write requests, depending on the platform implemention. Keep sending data until the network reports that it is unable to process the request, at which time a exception will be raised. On Windows, the exception will be raised on the next write request, while unix platforms may provide additional buffering that permit write requests to continue being accepted." ex := nil. [[serverSocket sendSomeData: buffer startIndex: 1 count: buffer size for: 1] on: ConnectionTimedOut do: [ :e | ex := e ]. ex isNil] whileTrue: []. self assert: ex notNil. ! ----- Method: SocketTest>>testServerAccept (in category 'tests') ----- testServerAccept "Tests a server-side accept" self testClientConnect. serverSocket := listenerSocket waitForAcceptFor: 2. self assert: (serverSocket notNil). self assert: (serverSocket isConnected). ! ----- Method: SocketTest>>testSocketReuse (in category 'tests') ----- testSocketReuse "Test for SO_REUSEADDR/SO_REUSEPORT" | address port udp1 send1 udp2 recv2 sendProc recvProc received | address := #[255 255 255 255]. "broadcast" port := 31259. [ udp1 := Socket newUDP. udp1 setOption: 'SO_REUSEADDR' value: 1. udp1 setOption: 'SO_REUSEPORT' value: 1. udp1 setPort: port. udp1 setOption: 'SO_BROADCAST' value: 1. send1 := UUID new. udp2 := Socket newUDP. udp2 setOption: 'SO_REUSEADDR' value: 1. udp2 setOption: 'SO_REUSEPORT' value: 1. udp2 setPort: port. udp2 setOption: 'SO_BROADCAST' value: 1. recv2 := UUID new. received := 0. recvProc := [ [received < 16] whileTrue:[ received := received + (udp2 receiveDataInto: recv2 startingAt: received + 1). ] ] fork. sendProc := [ udp1 setPeer: address port: port. udp1 sendData: send1 count: 16. ] fork. (Delay forMilliseconds: 200) wait. self should: [recvProc isTerminated]. self should: [sendProc isTerminated]. self should: [send1 = recv2]. ] ensure:[ udp1 destroy. udp2 destroy. ]. ! ----- Method: SocketTest>>testStringFromAddress (in category 'tests') ----- testStringFromAddress "Addresses are represented by a ByteArray if NetNameResolver useOldNetwork is true, or by by SocketAddress otherwise. Ensure the #stringFromAddress: works in either case. Older versions of SocketPlugin in the VM do not provide support for SocketAddress, and ByteArray addresses are used in that case." | localAddress localAddressBytes localName1 localName2 | localAddress := NetNameResolver localHostAddress. "ByteArray or SocketAddress" localAddressBytes := localAddress asByteArray. localName1 := NetNameResolver stringFromAddress: localAddress. localName2 := NetNameResolver stringFromAddress: localAddressBytes. self assert: localName1 = localName2 ! ----- Method: SocketTest>>testUDP (in category 'tests') ----- testUDP "Test udp recv() and send() functionality" serverSocket := Socket newUDP. serverSocket setPort: 54321. clientSocket := Socket newUDP. clientSocket setPeer: NetNameResolver localHostAddress port: serverSocket port. clientSocket sendData: 'Hello World'. (Delay forMilliseconds: 200) wait. self assert: (serverSocket dataAvailable). self assert: (serverSocket receiveData = 'Hello World'). ! 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>>testDirWithHash (in category 'running file') ----- testDirWithHash "Tests proper escaping of directories with hash mark" | uriDir origPath origDir dirURI | origPath := FileDirectory default pathName, '#123'. origDir := FileDirectory on: origPath. self assert: origDir pathName = origPath. dirURI := origDir uri. uriDir := FileDirectory uri: dirURI. self assert: origDir 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 new asString last: 12) = (UUID new asString last: 12) ifFalse: [^self]. 1000 timesRepeat: [ | uuid | 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 size | size := 5000. check := Set new: size. size timesRepeat: [ | uuid | uuid := UUID new. self shouldnt: [check includes: uuid]. check add: uuid]. ! ----- Method: UUIDPrimitivesTest>>testOrder (in category 'tests') ----- testOrder 100 timesRepeat: [ | uuid1 uuid2 | 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]]] ! TestCase subclass: #UUIDTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'NetworkTests-UUID'! ----- Method: UUIDTest>>testComparison (in category 'as yet unclassified') ----- testComparison "Test if the comparison operators define a total sort function." #( #[3 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0] #[2 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0] #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 1] #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 4] #[2 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0] #[3 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0] #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 4] #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 1] #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 4] #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 4] ) pairsDo: [ :x :y | | a b c d | a := UUID newFrom: x. b := UUID newFrom: y. c := x asString. d := y asString. "Check if the comparison is lexicographical, just like strings'." #(< > <= >= = ~=) do: [ :operation | self assert: (a perform: operation with: b) = (c perform: operation with: d) ]. "And a few more" self assert: (a < b) = (a >= b) not; assert: (a > b) = (a <= b) not; assert: (a = b) = (a ~= b) not; assert: (a < b) = (b > a); assert: (a > b) = (b < a); assert: (a >= b) = (b <= a); assert: (a <= b) = (b >= a); assert: (a = b) = (b = a); assert: (a ~= b) = (b ~= a); assert: (a > b) = ((a >= b) & (a ~= b)); assert: (a < b) = ((a <= b) & (a ~= b)); assert: (a >= b) = ((a = b) | (a > b)); assert: (a <= b) = ((a = b) | (a < b)); assert: (a ~= b) = ((a < b) | (a > b)); assert: (a <= b) & (b <= a) = (a = b); assert: (a >= b) & (b >= a) = (a = b); assert: (a <= b) | (b <= a); assert: (a = b) asBit + (a < b) asBit + (b < a) asBit = 1 ]! 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: #HttpUrlTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'NetworkTests-Url'! ----- Method: HttpUrlTest>>testHttps (in category 'as yet unclassified') ----- testHttps self assert: 'https://encrypted.google.com' asUrl class == HttpUrl! ClassTestCase subclass: #SocketStreamTest instanceVariableNames: 'clientStream serverStream' classVariableNames: '' poolDictionaries: '' category: 'NetworkTests-Kernel'! ----- Method: SocketStreamTest>>setUp (in category 'setup') ----- setUp | listener clientSocket serverSocket | listener := Socket newTCP. [listener listenOn: 0 backlogSize: 4. clientSocket := Socket newTCP. clientSocket connectTo: #[127 0 0 1] port: listener localPort. clientSocket waitForConnectionFor: 1. self assert: clientSocket isConnected. serverSocket := listener waitForAcceptFor: 1. self assert: serverSocket isConnected. ] ensure:[listener destroy]. clientStream := SocketStream on: clientSocket. serverStream := SocketStream on: serverSocket. ! ----- Method: SocketStreamTest>>tearDown (in category 'setup') ----- tearDown clientStream ifNotNil:[clientStream destroy]. serverStream ifNotNil:[serverStream destroy].! ----- Method: SocketStreamTest>>testNextIntoClose (in category 'stream protocol') ----- testNextIntoClose "Ensure that #next:into: will function properly when the connection is closed" clientStream nextPutAll:'A line of text'; flush. [(Delay forMilliseconds: 100) wait. clientStream close] fork. self assert: (serverStream next: 100 into: (String new: 100) startingAt: 1) equals: 'A line of text'. ! ----- Method: SocketStreamTest>>testNextIntoCloseNonSignaling (in category 'stream protocol') ----- testNextIntoCloseNonSignaling "Ensure that #next:into: will function properly when the connection is closed" serverStream shouldSignal: false. clientStream nextPutAll:'A line of text'; flush. [(Delay forMilliseconds: 100) wait. clientStream close] fork. self assert: (serverStream next: 100 into: (String new: 100) startingAt: 1) equals: 'A line of text'. ! ----- Method: SocketStreamTest>>testUpTo (in category 'stream protocol') ----- testUpTo "Tests correct behavior of #upTo:" clientStream nextPutAll:'A line of text', String cr, 'with more text'; flush. self assert: (serverStream upTo: Character cr) = 'A line of text'. [(Delay forSeconds: 1) wait. clientStream nextPutAll: String cr; flush] fork. self assert: (serverStream upTo: Character cr) = 'with more text'. ! ----- Method: SocketStreamTest>>testUpToAfterCloseNonSignaling (in category 'stream protocol') ----- testUpToAfterCloseNonSignaling "Tests correct behavior of #upToAll" | resp | clientStream nextPutAll: 'A line of text'. clientStream close. serverStream shouldSignal: false. self shouldnt: [resp := serverStream upTo: Character cr] raise: ConnectionClosed. self assert: resp = 'A line of text'.! ----- Method: SocketStreamTest>>testUpToAfterCloseSignaling (in category 'stream protocol') ----- testUpToAfterCloseSignaling "Tests correct behavior of #upToAll" clientStream nextPutAll:'A line of text'. clientStream close. self should: [serverStream upTo: Character cr] raise: ConnectionClosed. ! ----- Method: SocketStreamTest>>testUpToAll (in category 'stream protocol') ----- testUpToAll "Tests correct behavior of #upToAll" clientStream nextPutAll:'A line of text', String crlf, 'with more text'; flush. self assert: (serverStream upToAll: String crlf) = 'A line of text'. [(Delay forSeconds: 1) wait. clientStream nextPutAll: String crlf; flush] fork. self assert: (serverStream upToAll: String crlf) = 'with more text'. ! ----- Method: SocketStreamTest>>testUpToAllAfterCloseNonSignaling (in category 'stream protocol') ----- testUpToAllAfterCloseNonSignaling "Tests correct behavior of #upToAll" | resp | clientStream nextPutAll: 'A line of text'. clientStream close. serverStream shouldSignal: false. self shouldnt: [resp := serverStream upToAll: String crlf] raise: ConnectionClosed. self assert: resp = 'A line of text'.! ----- Method: SocketStreamTest>>testUpToAllAfterCloseSignaling (in category 'stream protocol') ----- testUpToAllAfterCloseSignaling "Tests correct behavior of #upToAll" clientStream nextPutAll:'A line of text'. clientStream close. self should: [serverStream upToAll: String crlf] raise: ConnectionClosed. ! ----- Method: SocketStreamTest>>testUpToAllAsciiVsBinary (in category 'stream protocol') ----- testUpToAllAsciiVsBinary "Tests correct behavior of #upToAll" serverStream ascii. clientStream nextPutAll:'A line of text', String crlf, 'with more text'; flush. self assert: (serverStream upToAll: #[13 10]) = 'A line of text'. serverStream binary. clientStream nextPutAll: String crlf; flush. self assert: (serverStream upToAll: String crlf) asString = 'with more text'. ! ----- Method: SocketStreamTest>>testUpToAllLimit (in category 'stream protocol') ----- testUpToAllLimit "Tests correct behavior of #upToAll:limit:" clientStream nextPutAll:'A line of text'; flush. self assert: (serverStream upToAll: String crlf limit: 5) = 'A line of text'.! ----- Method: SocketStreamTest>>testUpToAllTimeout (in category 'stream protocol') ----- testUpToAllTimeout "Tests correct behavior of #upToAll" clientStream nextPutAll: 'A line of text'. serverStream timeout: 1. self should: [serverStream upToAll: String crlf] raise: ConnectionTimedOut. ! ----- Method: SocketStreamTest>>testUpToAsciiVsBinary (in category 'stream protocol') ----- testUpToAsciiVsBinary "Tests correct behavior of #upTo:" serverStream ascii. clientStream nextPutAll:'A line of text', String cr, 'with more text'; flush. self assert: (serverStream upTo: 13) = 'A line of text'. serverStream binary. clientStream nextPutAll: String cr; flush. self assert: (serverStream upTo: Character cr) asString = 'with more text'. ! ----- Method: SocketStreamTest>>testUpToEndClose (in category 'stream protocol') ----- testUpToEndClose "Ensure that #upToEnd will function properly when the connection is closed" clientStream nextPutAll:'A line of text'; flush. [(Delay forMilliseconds: 100) wait. clientStream close] fork. self assert: (serverStream upToEnd) equals: 'A line of text'. ! ----- Method: SocketStreamTest>>testUpToEndCloseNonSignaling (in category 'stream protocol') ----- testUpToEndCloseNonSignaling "Ensure that #upToEnd will function properly when the connection is closed" serverStream shouldSignal: false. clientStream nextPutAll:'A line of text'; flush. [(Delay forMilliseconds: 100) wait. clientStream close] fork. self assert: (serverStream upToEnd) equals: 'A line of text'. ! ----- Method: SocketStreamTest>>testUpToMax (in category 'stream protocol') ----- testUpToMax "Tests correct behavior of #upToAll:max:" clientStream nextPutAll:'A line of text'; flush. self assert: (serverStream upTo: Character cr limit: 5) = 'A line of text'.! ----- Method: SocketStreamTest>>testUpToTimeout (in category 'stream protocol') ----- testUpToTimeout "Tests correct behavior of #upToAll" clientStream nextPutAll: 'A line of text'. serverStream timeout: 1. self should: [serverStream upTo: Character cr] raise: ConnectionTimedOut. ! 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 "This should not throw an exception." Url absoluteFromText: 'http://swikis.ddo.jp:8823/'. 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>>testUrlEncoded (in category 'tests') ----- testUrlEncoded "Test the behavior of #urlEncoded" self assert: 'http://squeak.org/name with space?and=value' urlEncoded equals: 'http://squeak.org/name%20with%20space?and=value'. self assert: 'http://squeak.org/name%20with%20space?and=value' urlEncoded equals: 'http://squeak.org/name%20with%20space?and=value'. self assert: 'http://squeak.org/name%with%space?and=value' urlEncoded equals: 'http://squeak.org/name%25with%25space?and=value'. ! ----- 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>>testUsernamePasswordEncoded (in category 'tests') ----- testUsernamePasswordEncoded "Sometimes, weird usernames or passwords are necessary in applications, and, thus, we might receive them in a Url. The @ and the : ar the kind of critical ones. " #( "('user' 'pword' 'host' port 'path')" ('Fürst Pückler' 'leckerEis' 'cottbus.brandenburg' 80 'mein/Zuhause') ('Jeannde.d''Arc' 'jaiunesécret' 'orleans' 8080 'une/deux/trois') ('HaXor at roxor:fnac' 'my~Pa$§wert' 'cbase' 42 'do/not_try') ) do: [:urlParts | |theUrl| theUrl := ('http://{1}:{2}@{3}:{4}/{5}' format: { (urlParts at: 1) encodeForHTTP. (urlParts at: 2) encodeForHTTP. urlParts at: 3. urlParts at: 4. urlParts at: 5. }) asUrl. self should: [theUrl schemeName = 'http']; should: [theUrl username = (urlParts at: 1)]; should: [theUrl password = (urlParts at: 2)]; should: [theUrl authority = (urlParts at: 3)]; should: [theUrl port = (urlParts at: 4)]; should: [theUrl path first = ((urlParts at: 5) copyUpTo: $/)]]. ! ----- 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 ] ]. ! ----- Method: UrlTest>>testUsernamePasswordPrintingEncoded (in category 'tests') ----- testUsernamePasswordPrintingEncoded #( 'http://F%C3%BCrst%20P%C3%BCckler:leckerEis@cottbus.brandenburg:80/mein/Zuhause' 'http://Jeannde.d%27Arc:jaiunes%C3%A9cret@orleans:8080/une/deux/trois' 'http://HaXor%40roxor%3Afnac:my%7EPa%24%C2%A7wert@cbase:42/do/not_try' ) do: [ :urlText | self should: [ urlText = urlText asUrl asString ] ]. !
More information about the Squeak-dev mailing list |