Squeak 4.6: NetworkTests-fbs.37.mcz

Chris Muller uploaded a new version of NetworkTests to project Squeak 4.6:
http://source.squeak.org/squeak46/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 := '[hidden email], [hidden email] [hidden email] joe4 , Not an Address <joe5@address>, joe.(annoying (nested) comment)literal@[1.2.3.4], "an annoying" group : joe1@groupie, joe2@groupie, "Joey" joe3@groupy, "joe6"."joe8"@group.com;,  Lex''s email account <lex>, [hidden email]'.

correctAnswer := #('[hidden email]' '[hidden email]' '[hidden email]' 'joe4' 'joe5@address' 'joe.literal@[1.2.3.4]' 'joe1@groupie' 'joe2@groupie' '"Joey"' 'joe3@groupy' '"joe6"."joe8"@group.com' 'lex' '[hidden email]') 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: '[hidden email]'.
        self assert: socket outStream contents = ('MAIL FROM: <[hidden email]>', String crlf).
       
        socket resetOutStream.
        smtp mailFrom: '<[hidden email]>'.
        self assert: socket outStream contents = ('MAIL FROM: <[hidden email]>', String crlf).
       
        socket resetOutStream.
        smtp mailFrom: 'Frank <[hidden email]>'.
        self assert: socket outStream contents = ('MAIL FROM: <[hidden email]>', 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:[hidden email]'.
        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://[hidden email]'.
        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:[hidden email]#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@bar'.
        self assert: url asString = 'sip:foo@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: '<a href="http://swikis.ddo.jp:auau/'">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: '<a href="http://squeak.org/name%with%space?and=value'">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@...: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@...: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@...: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@...: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@.../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@...' 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@...' 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@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@...:8000/root/index.html'
                'http://user@...:8000/root/index.html' 
                'http://user:pword@.../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@...: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 ] ].

!