[squeak-dev] The Inbox: NetworkTests-mt.64.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:11:28 UTC 2022
A new version of NetworkTests was added to project The Inbox: http://source.squeak.org/inbox/NetworkTests-mt.64.mcz ==================== Summary ==================== Name: NetworkTests-mt.64 Author: mt Time: 16 June 2022, 4:16:09.680458 pm UUID: 9f7b2832-2393-ee43-8dc5-8198eb48c359 Ancestors: NetworkTests-pre.63 Update expected failures. =============== Diff against NetworkTests-pre.63 =============== Item was removed: - SystemOrganization addCategory: #'NetworkTests-Kernel'! - SystemOrganization addCategory: #'NetworkTests-Protocols'! - SystemOrganization addCategory: #'NetworkTests-RFC822'! - SystemOrganization addCategory: #'NetworkTests-URI'! - SystemOrganization addCategory: #'NetworkTests-UUID'! - SystemOrganization addCategory: #'NetworkTests-Url'! Item was removed: - UrlSubclassesTest subclass: #FileUrlTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Url'! Item was removed: - ----- Method: FileUrlTest>>classToBeTested (in category 'coverage') ----- - classToBeTested - - ^ FileUrl! Item was removed: - ----- Method: FileUrlTest>>createUrlFrom: (in category 'private') ----- - createUrlFrom: aString - - ^ FileUrl absoluteFromText: aString! Item was removed: - ----- Method: FileUrlTest>>testAsString (in category 'tests') ----- - testAsString - | target url | - target := 'file://localhost/etc/rc.conf'. - url := target asUrl. - self assert: url asString = target. - ! Item was removed: - ----- Method: FileUrlTest>>testEqual (in category 'tests') ----- - testEqual - - self - assertUrl: 'file:///C:/Users/Uniform%20Resource%20Identifier.html' - equals: 'file:///C:/Users/Uniform%20Resource%20Identifier.html'. - - self - denyUrl: 'file:///C:/Users/Uniform%20Resource%20Identifier.html' - equals: 'file:///C:/Users/Uniform%20Resource%20Identifier2.html'.! Item was removed: - ----- Method: FileUrlTest>>testEqualWithHostAndFragment (in category 'tests') ----- - testEqualWithHostAndFragment - - self - assertUrl: 'file://localhost/C:/Users/Uniform%20Resource%20Identifier.html#heading1' - equals: 'file://localhost/C:/Users/Uniform%20Resource%20Identifier.html#heading1'. - - self - denyUrl: 'file://localhost/C:/Users/Uniform%20Resource%20Identifier.html#heading1' - equals: 'file://localhost/C:/Users/Uniform%20Resource%20Identifier.html#heading2'. - - self - denyUrl: 'file://localhost/C:/Users/Uniform%20Resource%20Identifier.html#heading1' - equals: 'file://localhost2/C:/Users/Uniform%20Resource%20Identifier.html#heading1'.! Item was removed: - ----- Method: FileUrlTest>>testRetrieveContents (in category 'tests') ----- - testRetrieveContents - - | content name | - name := '{1}-{2}.txt' format: {self className. self selector}. - content := self identityHash asString. - - FileStream newFileNamed: name do: [:stream | - stream nextPutAll: content]. - [self assert: content equals: - (FileUrl absoluteFromFileNameOrUrlString: name) retrieveContents content] - ensure: [FileDirectory default deleteFileNamed: name].! Item was removed: - UrlSubclassesTest subclass: #GenericUrlTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Url'! Item was removed: - ----- Method: GenericUrlTest>>classToBeTested (in category 'coverage') ----- - classToBeTested - - ^ GenericUrl! Item was removed: - ----- Method: GenericUrlTest>>createUrlFrom: (in category 'private') ----- - createUrlFrom: aString - - ^ GenericUrl absoluteFromText: aString! Item was removed: - ----- Method: GenericUrlTest>>testAsString (in category 'tests') ----- - testAsString - | url | - url := GenericUrl new schemeName: 'sip' locator: 'foo at bar'. - self assert: url asString = 'sip:foo at bar'.! Item was removed: - ----- Method: GenericUrlTest>>testEqual (in category 'tests') ----- - testEqual - - self - assertUrl: 'http://nobody:password@example.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2' - equals: 'http://nobody:password@example.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2'. - - "Different port" - self - denyUrl: 'http://nobody:password@example.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2' - equals: 'http://nobody:password@example.org:8081/cgi-bin/script.php?action=submit&pageid=86392001#section_2'. - - "Different host" - self - denyUrl: 'http://nobody:password@example.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2' - equals: 'http://nobody:password@example2.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2'. - - "Different query" - self - denyUrl: 'http://nobody:password@example.org:8080/cgi-bin/script.php?action=submit&pageid=86#section_2' - equals: 'http://nobody:password@example2.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2'. - - "Different fragment" - self - denyUrl: 'http://nobody:password@example.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2' - equals: 'http://nobody:password@example2.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section'. - - "Different authentication" - self - denyUrl: 'http://nobody:password@example.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2' - equals: 'http://someone:password@example2.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2'. - - "Different schema" - self - denyUrl: 'http://nobody:password@example.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2' - equals: 'sometp://someone:password@example2.org:8080/cgi-bin/script.php?action=submit&pageid=86392001#section_2'. - - ! Item was removed: - UrlSubclassesTest subclass: #HierarchicalUrlTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Url'! Item was removed: - ----- Method: HierarchicalUrlTest>>classToBeTested (in category 'coverage') ----- - classToBeTested - - ^ HierarchicalUrl! Item was removed: - ----- Method: HierarchicalUrlTest>>createUrlFrom: (in category 'private') ----- - createUrlFrom: aString - - ^ HierarchicalUrl absoluteFromText: aString! Item was removed: - ----- Method: HierarchicalUrlTest>>testAsString (in category 'tests') ----- - 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'.! Item was removed: - ----- Method: HierarchicalUrlTest>>testEqual (in category 'tests') ----- - testEqual - - self - assertUrl: 'ftp://localhost/path/to/file?aQuery' - equals: 'ftp://localhost/path/to/file?aQuery'. - - "Different Schema name" - self - denyUrl: 'ftp://localhost/path/to/file?aQuery' - equals: 'http://localhost/path/to/file?aQuery'. - - "Different Authority" - self - denyUrl: 'ftp://localhost/path/to/file?aQuery' - equals: 'ftp://remotehost/path/to/file?aQuery'. - - "Different Path" - self - denyUrl: 'ftp://localhost/path/to/file?aQuery' - equals: 'ftp://localhost/anotherpath/to/file?aQuery'. - - "Different Query" - self - denyUrl: 'ftp://localhost/path/to/file?aQuery' - equals: 'ftp://localhost/path/to/file?aQuery=aValue'. - ! Item was removed: - UrlSubclassesTest subclass: #HttpUrlTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Url'! Item was removed: - ----- Method: HttpUrlTest>>classToBeTested (in category 'coverage') ----- - classToBeTested - - ^ HttpUrl! Item was removed: - ----- Method: HttpUrlTest>>createUrlFrom: (in category 'private') ----- - createUrlFrom: aString - - ^ HttpUrl absoluteFromText: aString! Item was removed: - ----- Method: HttpUrlTest>>testEqual (in category 'tests') ----- - testEqual - - self - assertUrl: 'http://localhost/path/to/file?aQuery' - equals: 'http://localhost/path/to/file?aQuery'. - - "Different Schema name" - self - denyUrl: 'http://localhost/path/to/file?aQuery' - equals: 'https://localhost/path/to/file?aQuery'. - - "Different Authority" - self - denyUrl: 'http://localhost/path/to/file?aQuery' - equals: 'http://remotehost/path/to/file?aQuery'. - - "Different Path" - self - denyUrl: 'http://localhost/path/to/file?aQuery' - equals: 'http://localhost/anotherpath/to/file?aQuery'. - - "Different Query" - self - denyUrl: 'http://localhost/path/to/file?aQuery' - equals: 'http://localhost/path/to/file?aQuery=aValue'. - ! Item was removed: - ----- Method: HttpUrlTest>>testHttps (in category 'tests') ----- - testHttps - self assert: 'https://encrypted.google.com' asUrl class == HttpUrl! Item was removed: - ClassTestCase subclass: #MIMEDocumentTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Url'! Item was removed: - ----- Method: MIMEDocumentTest>>testCharset (in category 'tests') ----- - testCharset - - | document | - document := MIMEDocument contentType: 'text/plain;charset=utf-8' content: self utf8String. - self assert: 'utf-8' equals: document charset. ! Item was removed: - ----- Method: MIMEDocumentTest>>testContentType (in category 'tests') ----- - testContentType - - | document | - document := MIMEDocument contentType: 'text/plain;charset=utf-8' content: self utf8String. - self assert: 'text/plain' equals: document contentType. ! Item was removed: - ----- Method: MIMEDocumentTest>>testMainAndSubType (in category 'tests') ----- - testMainAndSubType - - | document | - document := MIMEDocument contentType: 'text/plain' content: self utf8String. - self assert: 'text' equals: document mainType. - self assert: 'plain' equals: document subType.! Item was removed: - ----- Method: MIMEDocumentTest>>testMultipartDocument (in category 'tests') ----- - testMultipartDocument - - | document | - document := MIMEDocument newMultipart. - self assert: 'multipart/mixed' equals: document contentType. ! Item was removed: - ----- Method: MIMEDocumentTest>>testParameterizedContentType (in category 'tests') ----- - testParameterizedContentType - - | document | - document := MIMEDocument contentType: 'text/plain;charset=utf-8' content: self utf8String. - self assert: 'text/plain;charset=utf-8' equals: document parameterizedContentType. ! Item was removed: - ----- Method: MIMEDocumentTest>>testUtf8Text (in category 'tests') ----- - testUtf8Text - - | document | - document := MIMEDocument contentType: 'text/plain; charset="utf8"' content: self utf8String. - self assert: self utf8String utf8ToSqueak equals: document content ! Item was removed: - ----- Method: MIMEDocumentTest>>utf8String (in category 'fixtures') ----- - utf8String - - ^ #[199 161 84 83 67 72] asString! Item was removed: - 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! Item was removed: - ----- Method: MailAddressParserTest>>stringOfMailAddresses (in category 'fixtures') ----- - stringOfMailAddresses - ^ '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, "Joey3" joe3 at groupy, "joe6"."joe8"@group.com;, Lex''s email account <lex>, foo+bar at baz.com, romeo&juliet at shakespeare.uk, "Name" mail at email.com'.! Item was removed: - ----- Method: MailAddressParserTest>>testAddressesAndNamePairsIn (in category 'tests') ----- - testAddressesAndNamePairsIn - - | correctAnswer parsedParis | - - correctAnswer := #( - ('' 'joe at lama.com') - ('' 'joe2 at lama.com') - ('' 'joe3 at lama.com') - ('' 'joe4') - ('Not an Address' 'joe5 at address') - ('' 'joe.literal@[1.2.3.4]') - ('' 'joe1 at groupie') - ('' 'joe2 at groupie') - ('Joey3' 'joe3 at groupy') - ('' '"joe6"."joe8"@group.com') - ('Lex''s email account' 'lex') - ('' 'foo+bar at baz.com') - ('' 'romeo&juliet at shakespeare.uk') - ('Name' 'mail at email.com')) asOrderedCollection. - - parsedParis := MailAddressParser addressesAndNamePairsIn: self stringOfMailAddresses. - self assert: correctAnswer equals: parsedParis.! Item was removed: - ----- Method: MailAddressParserTest>>testAddressesIn (in category 'tests') ----- - testAddressesIn - - | correctAnswer | - - 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' - 'joe3 at groupy' - '"joe6"."joe8"@group.com' - 'lex' - 'foo+bar at baz.com' - 'romeo&juliet at shakespeare.uk' - 'mail at email.com') asOrderedCollection. - - self assert: correctAnswer equals: (MailAddressParser addressesIn: self stringOfMailAddresses).! Item was removed: - TestCase subclass: #MailDateAndTimeTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-RFC822'! Item was removed: - ----- Method: MailDateAndTimeTest>>testBasicDate (in category 'tests') ----- - testBasicDate - - | date | - date := DateAndTime year: 2017 month: 2 day: 3 hour: 0 minute: 0 second: 0 offset: (Duration hours: 0). - self assert: 'Fri, 03 Feb 2017 00:00:00 +0000' equals: date asMailMessageString! Item was removed: - ----- Method: MailDateAndTimeTest>>testBasicDateAndTime (in category 'tests') ----- - testBasicDateAndTime - - | date | - date := DateAndTime year: 2000 month: 6 day: 22 hour: 14 minute: 17 second: 47 offset: (Duration days: 0 hours: -5 minutes: 0 seconds: 0 nanoSeconds:0). - self assert: 'Thu, 22 Jun 2000 14:17:47 -0500' equals: date asMailMessageString - ! Item was removed: - 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.! Item was removed: - ----- Method: MailMessageTest>>fixtureMail (in category 'fixtures') ----- - fixtureMail - - ^ MailMessage empty - from: self fixtureSenderMail; - to: self fixtureReceiverMails; - messageId: self fixtureMessageId; - dateTime: self fixtureMessageDate; - subject: self fixtureSubject; - yourself! Item was removed: - ----- Method: MailMessageTest>>fixtureMessageDate (in category 'fixtures') ----- - fixtureMessageDate - - ^ DateAndTime year: 2017 month: 2 day: 5 hour: 14 minute: 15 ! Item was removed: - ----- Method: MailMessageTest>>fixtureMessageId (in category 'fixtures') ----- - fixtureMessageId - - ^ 'ijoisjdfoihasoidhfosihd at mail.com'! Item was removed: - ----- Method: MailMessageTest>>fixtureReceiverMails (in category 'fixtures') ----- - fixtureReceiverMails - - ^ 'receiver at mail.com'! Item was removed: - ----- Method: MailMessageTest>>fixtureSenderMail (in category 'fixtures') ----- - fixtureSenderMail - - ^ 'sender at mail.com'! Item was removed: - ----- Method: MailMessageTest>>fixtureSubject (in category 'fixtures') ----- - fixtureSubject - - ^ 'This is the subject'! Item was removed: - ----- Method: MailMessageTest>>testAttachmentsGetTheirOwnContentType (in category 'tests') ----- - testAttachmentsGetTheirOwnContentType - - | message contentType | - message := MailMessage empty - addAttachmentFrom: 'abcxxx' readStream withName: 'aTestingAttachment.pdf'; - body: ((MIMEDocument contentType: 'application/foo' content: 'This is the main text' squeakToUtf8) - charset: 'utf-8'; yourself). - - self assert: message attachments size equals: 1. - - contentType := (message attachments first fieldNamed: 'content-type' ifAbsent: [self fail]) - mainValue. - self assert: contentType equals: 'application/pdf'. - ! Item was removed: - ----- Method: MailMessageTest>>testAttachmentsReturnsTheAttachments (in category 'tests') ----- - testAttachmentsReturnsTheAttachments - - | fileName message | - message := MailMessage empty - addAttachmentFrom: 'abcxxx' readStream withName: 'aTestingAttachment'; - body: ((MIMEDocument contentType: 'application/foo' content: 'This is the main text' squeakToUtf8) - charset: 'utf-8'; yourself). - - self assert: 1 equals: message attachments size. - - fileName := (message attachments first fieldNamed: 'content-disposition' ifAbsent: [self fail]) - parameterAt: 'filename' ifAbsent: ['']. - - self assert: fileName equals: '"aTestingAttachment"'. - - fileName := (message attachments first fieldNamed: 'content-type' ifAbsent: [self fail]) - parameterAt: 'name' ifAbsent: ['']. - - self assert: fileName equals: '"aTestingAttachment"'.! Item was removed: - ----- Method: MailMessageTest>>testAttachmentsWorkWithVeryLongFilenames (in category 'tests') ----- - testAttachmentsWorkWithVeryLongFilenames - - | fileName message | - message := MailMessage empty - addAttachmentFrom: 'abcxxx' readStream withName: 'aTestingAttachmentWithAVeryVeryVeryVeryVeryVeryVeryVeryLongName.file'; - body: ((MIMEDocument contentType: 'application/foo' content: 'This is the main text' squeakToUtf8) - charset: 'utf-8'; yourself). - - self assert: message attachments size equals: 1. - - fileName := (message attachments first fieldNamed: 'content-disposition' ifAbsent: [self fail]) - parameterAt: 'filename' ifAbsent: ['']. - - self assert: '"aTestingAttachmentWithAVeryVeryVeryVeryVeryVeryVeryVeryLongName.file"' equals: fileName - ! Item was removed: - ----- Method: MailMessageTest>>testCreateAReplyForFrom (in category 'tests') ----- - testCreateAReplyForFrom - - | replyMail | - replyMail := MailMessage replyFor: self fixtureMail. - self assert: self fixtureSenderMail equals: replyMail to.! Item was removed: - ----- Method: MailMessageTest>>testCreateAReplyForReplyTo (in category 'tests') ----- - testCreateAReplyForReplyTo - - | replyMail startMail | - startMail := self fixtureMail - setField: 'reply-to' toString: 'anothersender at mail.com'; - yourself. - replyMail := MailMessage replyFor: startMail. - self assert: 'anothersender at mail.com' equals: replyMail to.! Item was removed: - ----- Method: MailMessageTest>>testCreateAReplyForReplyTos (in category 'tests') ----- - testCreateAReplyForReplyTos - - | replyMail startMail | - startMail := self fixtureMail - setField: 'reply-to' toString: 'anothersender at mail.com, andanothersender at mail.com'; - yourself. - replyMail := MailMessage replyFor: startMail. - self - assert: {'anothersender at mail.com' . 'andanothersender at mail.com'} asSet - equals: ((replyMail to findTokens: ',') collect: [:e | e withBlanksTrimmed]) asSet.! Item was removed: - ----- Method: MailMessageTest>>testCreateAReplyHasANewSubject (in category 'tests') ----- - testCreateAReplyHasANewSubject - - | replyMail | - replyMail := MailMessage replyFor: self fixtureMail. - self assert: 'Re: ' , self fixtureSubject equals: replyMail subject.! Item was removed: - ----- Method: MailMessageTest>>testCreateAReplyHasANewSubjectUnlessWasAlreadyReply (in category 'testing') ----- - testCreateAReplyHasANewSubjectUnlessWasAlreadyReply - - | replyMail startMail | - startMail := self fixtureMail - subject: 'Re: Subject'; - yourself. - replyMail := MailMessage replyFor: startMail. - self assert: 'Re: Subject' equals: replyMail subject.! Item was removed: - ----- Method: MailMessageTest>>testCreateMailMessage (in category 'tests') ----- - testCreateMailMessage - - | newMail | - newMail := MailMessage from: 'From: Al Gore <vicepresident at whitehouse.gov> - To: White House Transportation Coordinator <transport at whitehouse.gov> - Subject: [Map of a country] - - there is a country map in this mail somewhere'. - self assert: '[Map of a country]' equals: newMail subject! Item was removed: - ----- Method: MailMessageTest>>testDateAndDateString (in category 'tests') ----- - testDateAndDateString - - | newMail | - newMail := MailMessage from: 'From: Al Gore <vicepresident at whitehouse.gov> - To: White House Transportation Coordinator <transport at whitehouse.gov> - Subject: [Map of a country] - Date: Mon, 12 Aug 2002 17:42:00 +0000 - - there is a country map in this mail somewhere'. - - self assert: (DateAndTime year: 2002 month: 8 day: 12 hour: 17 minute: 42 second: 0 offset: Timespan defaultOffset) equals: newMail date. - self assert: '8/12/02' equals: newMail dateString.! Item was removed: - ----- Method: MailMessageTest>>testDateStampFractionalSecondFormatting (in category 'tests') ----- - testDateStampFractionalSecondFormatting - self - assert: (MailMessage dateStamp: (DateAndTime year: 1901 month: 1 day: 1 hour: 0 minute: 0 second: 1.234 offset: Timespan defaultOffset)) - equals: 'Tue, 1 Jan 1901 00:00:01' - description: 'RFC822 (and RFC2822) forbids non-integer seconds in dates'! Item was removed: - ----- Method: MailMessageTest>>testReplyContainsInReplyTo (in category 'tests') ----- - testReplyContainsInReplyTo - - | replyMail | - replyMail := MailMessage replyFor: self fixtureMail. - self assert: self fixtureMessageId equals: (replyMail fieldNamed: 'in-reply-to' ifAbsent: [self fail]) mainValue.! Item was removed: - ----- Method: MailMessageTest>>testReplyContainsReferences (in category 'tests') ----- - testReplyContainsReferences - - | replyMail lastReply | - replyMail := MailMessage replyFor: self fixtureMail. - replyMail - setField: 'message-id' toString: 'abc'; - from: 'me at mail.com'. - lastReply := MailMessage replyFor: replyMail. - - self - assert: self fixtureMessageId , ', abc' - equals: (lastReply fieldNamed: 'references' ifAbsent: [self fail]) mainValue.! Item was removed: - ----- Method: MailMessageTest>>testSendableVersionHasCorrectLineBreaks (in category 'tests') ----- - testSendableVersionHasCorrectLineBreaks - - | newMail longContent | - "To create a string which is too long to very old recommendations - of the mail message format, which is about 70 characters." - longContent := ((1 to: 80) do: [:i | i asString]) joinSeparatedBy: ''. - newMail := self fixtureMail. - newMail body: ((MIMEDocument - contentType: MIMEDocument contentTypePlainText - content: longContent) - charset: 'UTF-8'; - yourself). - newMail := MailMessage from: newMail asSendableText. - self assert: (newMail bodyTextFormatted asString includesSubstring: longContent)! Item was removed: - Stream subclass: #MockSocketStream - instanceVariableNames: 'binary atEnd inStream outStream' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Kernel'! Item was removed: - ----- Method: MockSocketStream class>>on: (in category 'instance creation') ----- - on: socket - ^self basicNew initialize! Item was removed: - ----- Method: MockSocketStream>>ascii (in category 'configuration') ----- - ascii - - binary := false. - self refreshStreams.! Item was removed: - ----- Method: MockSocketStream>>atEnd (in category 'testing') ----- - atEnd - ^self inStream atEnd.! Item was removed: - ----- Method: MockSocketStream>>atEnd: (in category 'accessing') ----- - atEnd: aBoolean - atEnd := aBoolean.! Item was removed: - ----- Method: MockSocketStream>>binary (in category 'configuration') ----- - binary - - binary := true. - self refreshStreams.! Item was removed: - ----- Method: MockSocketStream>>cr (in category 'stream out') ----- - cr - self nextPutAll: String cr! Item was removed: - ----- Method: MockSocketStream>>crlf (in category 'stream out') ----- - crlf - self nextPutAll: String crlf! Item was removed: - ----- Method: MockSocketStream>>inStream (in category 'accessing') ----- - inStream - ^inStream! Item was removed: - ----- Method: MockSocketStream>>initialize (in category 'initialize-release') ----- - initialize - binary := false. - self resetInStream. - self resetOutStream.! Item was removed: - ----- Method: MockSocketStream>>next:putAll:startingAt: (in category 'stream out') ----- - next: n putAll: aCollection startingAt: startIndex - - ^ self outStream next: n putAll: aCollection startingAt: startIndex - ! Item was removed: - ----- Method: MockSocketStream>>nextLine (in category 'stream in') ----- - nextLine - ^self nextLineCrLf! Item was removed: - ----- Method: MockSocketStream>>nextLineCrLf (in category 'stream in') ----- - nextLineCrLf - ^(self upToAll: String crlf).! Item was removed: - ----- Method: MockSocketStream>>nextPut: (in category 'stream out') ----- - nextPut: anObject - - ^ self outStream nextPut: anObject! Item was removed: - ----- Method: MockSocketStream>>nextPutAll: (in category 'stream out') ----- - nextPutAll: aCollection - ^ self outStream nextPutAll: aCollection.! Item was removed: - ----- Method: MockSocketStream>>nextPutAllFlush: (in category 'stream out') ----- - nextPutAllFlush: aCollection - ^ self outStream nextPutAll: aCollection.! Item was removed: - ----- Method: MockSocketStream>>outStream (in category 'accessing') ----- - outStream - ^outStream! Item was removed: - ----- Method: MockSocketStream>>refreshStreams (in category 'initialize-release') ----- - refreshStreams - - binary = self inStream isBinary ifFalse: [self resetInStream]. - binary = self outStream isBinary ifFalse: [self resetOutStream]. - ! Item was removed: - ----- Method: MockSocketStream>>resetInStream (in category 'stream in') ----- - resetInStream - inStream := self streamSpecies new writeStream.! Item was removed: - ----- Method: MockSocketStream>>resetOutStream (in category 'stream out') ----- - resetOutStream - outStream := self streamSpecies new writeStream.! Item was removed: - ----- Method: MockSocketStream>>sendCommand: (in category 'stream out') ----- - sendCommand: aString - self outStream - nextPutAll: aString; - nextPutAll: String crlf.! Item was removed: - ----- Method: MockSocketStream>>space (in category 'stream out') ----- - space - self nextPut: Character space! Item was removed: - ----- Method: MockSocketStream>>streamSpecies (in category 'initialize-release') ----- - streamSpecies - - ^ binary ifTrue: [ByteArray] ifFalse: [ByteString]. - ! Item was removed: - ----- Method: MockSocketStream>>upToAll: (in category 'stream in') ----- - upToAll: delims - ^self inStream upToAll: delims.! Item was removed: - TestCase subclass: #SMTPClientTest - instanceVariableNames: 'smtp socket' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Protocols'! Item was removed: - ----- Method: SMTPClientTest>>setUp (in category 'running') ----- - setUp - socket := MockSocketStream on: ''. - smtp := SMTPClient new. - smtp stream: socket.! Item was removed: - ----- Method: SMTPClientTest>>testMailFrom (in category 'tests') ----- - 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).! Item was removed: - ClassTestCase subclass: #SocketStreamTest - instanceVariableNames: 'clientStream serverStream' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Kernel'! Item was removed: - ----- Method: SocketStreamTest>>setUp (in category 'running') ----- - 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. - ! Item was removed: - ----- Method: SocketStreamTest>>tearDown (in category 'running') ----- - tearDown - clientStream ifNotNil:[clientStream destroy]. - serverStream ifNotNil:[serverStream destroy].! Item was removed: - ----- Method: SocketStreamTest>>testNextIntoClose (in category 'tests - 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'. - ! Item was removed: - ----- Method: SocketStreamTest>>testNextIntoCloseNonSignaling (in category 'tests - 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'. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpTo (in category 'tests - 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'. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAfterCloseNonSignaling (in category 'tests - 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'.! Item was removed: - ----- Method: SocketStreamTest>>testUpToAfterCloseSignaling (in category 'tests - stream protocol') ----- - testUpToAfterCloseSignaling - "Tests correct behavior of #upToAll" - - clientStream nextPutAll:'A line of text'. - clientStream close. - self should: [serverStream upTo: Character cr] raise: ConnectionClosed. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAll (in category 'tests - 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'. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllAfterCloseNonSignaling (in category 'tests - 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'.! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllAfterCloseSignaling (in category 'tests - stream protocol') ----- - testUpToAllAfterCloseSignaling - "Tests correct behavior of #upToAll" - - clientStream nextPutAll:'A line of text'. - clientStream close. - self should: [serverStream upToAll: String crlf] raise: ConnectionClosed. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllAsciiVsBinary (in category 'tests - 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'. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllCrlfAscii (in category 'tests - stream protocol') ----- - testUpToAllCrlfAscii - "Tests correct behavior of #upToAll with a two-byte delimiter in ascii mode" - self testUpToAllDelimiter: String crlf - input: 'A header', String crlf, 'and a body' - expected: {'A header'. 'and a body'} - binary: false. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllCrlfBinary (in category 'tests - stream protocol') ----- - testUpToAllCrlfBinary - "Tests correct behavior of #upToAll with a two-byte delimiter in binary mode" - self testUpToAllDelimiter: String crlf - input: 'A header', String crlf, 'and a body' - expected: {'A header'. 'and a body'} - binary: true. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllCrlfCrlfAscii (in category 'tests - stream protocol') ----- - testUpToAllCrlfCrlfAscii - "Tests correct behavior of #upToAll with a four-byte delimiter in ascii mode" - self testUpToAllDelimiter: String crlfcrlf - input: 'A header', String crlfcrlf, 'and a body' - expected: {'A header'. 'and a body'} - binary: false. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllCrlfCrlfBinary (in category 'tests - stream protocol') ----- - testUpToAllCrlfCrlfBinary - "Tests correct behavior of #upToAll with a four-byte delimiter in binary mode" - self testUpToAllDelimiter: String crlfcrlf - input: 'A header', String crlfcrlf, 'and a body' - expected: {'A header'. 'and a body'} - binary: true. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllDelimiter:input:expected:binary: (in category 'tests - stream protocol') ----- - testUpToAllDelimiter: delimiter input: input expected: aCollection binary: useBinary - "General test of #upToAll." - clientStream nextPutAll: input; close. - serverStream shouldSignal: false. - useBinary ifTrue: [serverStream binary] ifFalse: [serverStream ascii]. - aCollection do: [:expected | | actual | - actual := (serverStream upToAll: delimiter) asString. - self assert: actual = expected]. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllEmptyPatternAscii (in category 'tests - stream protocol') ----- - testUpToAllEmptyPatternAscii - "Tests correct behavior of #upToAll with an empty delimiter string, in ascii mode" - self testUpToAllDelimiter: '' - input: 'xaxbxc' - expected: {'xaxbxc'} - binary: false. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllEmptyPatternBinary (in category 'tests - stream protocol') ----- - testUpToAllEmptyPatternBinary - "Tests correct behavior of #upToAll with an empty delimiter string, in binary mode" - self testUpToAllDelimiter: '' - input: 'xaxbxc' - expected: {'xaxbxc'} - binary: true. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllLimit (in category 'tests - 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'.! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllLongPatternAscii (in category 'tests - stream protocol') ----- - testUpToAllLongPatternAscii - "Tests correct behavior of #upToAll with a long delimiter string, in ascii mode" - self testUpToAllDelimiter: 'xxxxx' - input: 'xxxxxaxxxxbxxxxxc' - expected: {''. 'axxxxb'. 'c'} - binary: false. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllLongPatternBinary (in category 'tests - stream protocol') ----- - testUpToAllLongPatternBinary - "Tests correct behavior of #upToAll with a long delimiter string, in binary mode" - self testUpToAllDelimiter: 'xxxxx' - input: 'xxxxxaxxxxbxxxxxc' - expected: {''. 'axxxxb'. 'c'} - binary: true. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllMediumPatternAscii (in category 'tests - stream protocol') ----- - testUpToAllMediumPatternAscii - "Tests correct behavior of #upToAll with a two-character delimiter string, in ascii mode" - self testUpToAllDelimiter: 'xx' - input: 'xxaxbxxc' - expected: {''. 'axb'. 'c'} - binary: false. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllMediumPatternBinary (in category 'tests - stream protocol') ----- - testUpToAllMediumPatternBinary - "Tests correct behavior of #upToAll with a two-character delimiter string, in binary mode" - self testUpToAllDelimiter: 'xx' - input: 'xxaxbxxc' - expected: {''. 'axb'. 'c'} - binary: true. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllShortPatternAscii (in category 'tests - stream protocol') ----- - testUpToAllShortPatternAscii - "Tests correct behavior of #upToAll with a short delimiter string, in ascii mode" - self testUpToAllDelimiter: 'x' - input: 'xaxbxc' - expected: {''. 'a'. 'b'. 'c'} - binary: false. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllShortPatternAscii2 (in category 'tests - stream protocol') ----- - testUpToAllShortPatternAscii2 - "Tests correct behavior of #upToAll with a short delimiter string, in ascii mode" - self testUpToAllDelimiter: 'x' - input: 'axbxcx' - expected: {'a'. 'b'. 'c'. ''} - binary: false. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllShortPatternBinary (in category 'tests - stream protocol') ----- - testUpToAllShortPatternBinary - "Tests correct behavior of #upToAll with a short delimiter string, in binary mode" - self testUpToAllDelimiter: 'x' - input: 'xaxbxc' - expected: {''. 'a'. 'b'. 'c'} - binary: true. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllShortPatternBinary2 (in category 'tests - stream protocol') ----- - testUpToAllShortPatternBinary2 - "Tests correct behavior of #upToAll with a short delimiter string, in binary mode" - self testUpToAllDelimiter: 'x' - input: 'axbxcx' - expected: {'a'. 'b'. 'c'. ''} - binary: true. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAllTimeout (in category 'tests - 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. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToAsciiVsBinary (in category 'tests - 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'. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToEndClose (in category 'tests - 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'. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToEndCloseNonSignaling (in category 'tests - 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'. - ! Item was removed: - ----- Method: SocketStreamTest>>testUpToMax (in category 'tests - 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'.! Item was removed: - ----- Method: SocketStreamTest>>testUpToTimeout (in category 'tests - 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. - ! Item was removed: - TestCase subclass: #SocketTest - instanceVariableNames: 'listenerSocket clientSocket serverSocket' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Kernel'! Item was removed: - ----- Method: SocketTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ Smalltalk platformName = 'Win32' - ifTrue: [#(testSocketReuse)] - ifFalse: [#()]! Item was removed: - ----- Method: SocketTest>>listenerAddress (in category 'fixtures') ----- - listenerAddress - ^NetNameResolver addressForName: 'localhost' - ! Item was removed: - ----- Method: SocketTest>>listenerAddressForFamily: (in category 'fixtures') ----- - listenerAddressForFamily: addressFamily - ^NetNameResolver addressForName: 'localhost' family: addressFamily! Item was removed: - ----- Method: SocketTest>>listenerPort (in category 'fixtures') ----- - listenerPort - ^42324 - ! Item was removed: - ----- Method: SocketTest>>setUp (in category 'running') ----- - setUp - - listenerSocket := Socket newTCP listenOn: self listenerPort backlogSize: 4 interface: self listenerAddress. - ! Item was removed: - ----- Method: SocketTest>>tearDown (in category 'running') ----- - tearDown - - listenerSocket ifNotNil:[listenerSocket destroy]. - clientSocket ifNotNil:[clientSocket destroy]. - serverSocket ifNotNil:[serverSocket destroy]. - ! Item was removed: - ----- Method: SocketTest>>testClientConnect (in category 'tests') ----- - testClientConnect - "Tests a client socket connection" - - clientSocket := Socket newTCP. - clientSocket connectTo: (self listenerAddressForFamily: clientSocket addressFamily) port: self listenerPort. - clientSocket waitForConnectionFor: 2. - self assert: clientSocket isConnected! Item was removed: - ----- 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). - ! Item was removed: - ----- 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. - - ! Item was removed: - ----- Method: SocketTest>>testLocalAddress (in category 'tests') ----- - testLocalAddress - "Tests the various localAddress values for sockets" - - self testServerAccept. - self assert: listenerSocket localAddress equals: (self listenerAddressForFamily: listenerSocket addressFamily). - self assert: clientSocket localAddress equals: (self listenerAddressForFamily: clientSocket addressFamily). - self assert: serverSocket localAddress equals: (self listenerAddressForFamily: serverSocket addressFamily)! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: SocketTest>>testPeerName (in category 'tests') ----- - testPeerName - "None of these should throw an exception." - "This can actually take a while, depending on networks availability" - <timeout: 30> - - Socket new peerName. - self testServerAccept. - listenerSocket peerName. - clientSocket peerName. - serverSocket peerName.! Item was removed: - ----- Method: SocketTest>>testReceiveTimeout (in category 'tests') ----- - testReceiveTimeout - "Test data transfer and related methods" - - self testServerAccept. - self assert: (serverSocket receiveDataTimeout: 1) isEmpty.! Item was removed: - ----- 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. - ! Item was removed: - ----- 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. - ! Item was removed: - ----- 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. - ! Item was removed: - ----- 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). - ! Item was removed: - ----- Method: SocketTest>>testSocketReuse (in category 'tests') ----- - testSocketReuse - "Test for SO_REUSEADDR/SO_REUSEPORT. Should probably be called testUDPSocketReuse. - c.f. testTCPSocketReuse" - - | udp1 udp2 sendProc recvProc | - [ - | address port opt send1 recv2 received sent | - address := #[255 255 255 255]. "broadcast" - port := 31259. - udp1 := Socket newUDP. - udp1 setOption: 'SO_REUSEADDR' value: 1. - self assert: 0 equals: udp1 socketError description: 'Error occured while setting SO_REUSEADDR'. - opt := udp1 getOption: 'SO_REUSEADDR'. - self assert: opt first isZero & opt last isZero not description: 'SO_REUSEADDR couldn''t be set'. - udp1 setOption: 'SO_REUSEPORT' value: 1. - self assert: 0 equals: udp1 socketError description: 'Error occured while setting SO_REUSEPORT'. - opt := udp1 getOption: 'SO_REUSEPORT'. - self assert: opt first isZero & opt last isZero not description: 'SO_REUSEPORT couldn''t be set'. - udp1 setPort: port. - self assert: port equals: udp1 localPort. - udp1 setOption: 'SO_BROADCAST' value: 1. - send1 := UUID new. - - udp2 := Socket newUDP. - udp2 setOption: 'SO_REUSEADDR' value: 1. - self assert: 0 equals: udp2 socketError. - udp2 setOption: 'SO_REUSEPORT' value: 1. - self assert: 0 equals: udp2 socketError. - udp2 setPort: port. - self assert: port equals: udp2 localPort. - udp2 setOption: 'SO_BROADCAST' value: 1. - recv2 := UUID new. - - received := 0. - recvProc := [ - [received < 16] whileTrue:[ - received := received + (udp2 receiveDataInto: recv2 startingAt: received + 1) - "No need to yield here, because #receiveDataInto:startingAt: will either wait on the readSemaphore of the socket or signal an error." ] - ] newProcess. - sendProc := [ - udp1 setPeer: address port: port. - sent := (udp1 sendSomeData: send1 startIndex: 1 count: 16 for: 1). - ] newProcess. - recvProc resume. - sendProc resume. - (Delay forMilliseconds: 200) wait. - self - assert: sendProc isTerminated description: 'sendProc hasn''t terminated till the deadline'; - assert: recvProc isTerminated description: 'recvProc hasn''t terminated till the deadline'; - assert: 16 equals: sent description: ('{1} bytes were sent instead of 16' format: { sent }); - assert: send1 equals: recv2 description: 'sent and received bytes differ' - ] ensure:[ - udp1 ifNotNil: [ udp1 destroy ]. - udp2 ifNotNil: [ udp2 destroy ]. - sendProc ifNotNil: [ sendProc terminate ]. - recvProc ifNotNil: [ recvProc terminate ] - ]. - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: SocketTest>>testTCPSocketReuse (in category 'tests') ----- - testTCPSocketReuse - "Test for SO_REUSEADDR/SO_REUSEPORT using TCP sockets. c.f. testSocketReuse" - - | tcpSend tcpRecv sendProcess recvProcess | - [ - | address port opt send1 recv2 sent | - address := NetNameResolver addressForName: '127.0.0.1' timeout: 20. - port := 31259. - tcpSend := Socket newTCP. - tcpSend setOption: 'SO_REUSEADDR' value: 1. - self assert: 0 equals: tcpSend socketError description: 'Error occured while setting SO_REUSEADDR'. - opt := tcpSend getOption: 'SO_REUSEADDR'. - self assert: opt first isZero & opt last isZero not description: 'SO_REUSEADDR couldn''t be set'. - tcpSend setOption: 'SO_REUSEPORT' value: 1. - self assert: 0 equals: tcpSend socketError description: 'Error occured while setting SO_REUSEPORT'. - opt := tcpSend getOption: 'SO_REUSEPORT'. - self assert: opt first isZero & opt last isZero not description: 'SO_REUSEPORT couldn''t be set'. - "tcpSend setOption: 'TCP_NODELAY' value: 1." - send1 := UUID new. - - tcpRecv := Socket newTCP. - tcpRecv setOption: 'SO_REUSEADDR' value: 1. - self assert: 0 equals: tcpRecv socketError. - tcpRecv setOption: 'SO_REUSEPORT' value: 1. - self assert: 0 equals: tcpRecv socketError. - tcpRecv setPort: port. - self assert: port equals: tcpRecv localPort. - recv2 := UUID new. - - [| received | - recvProcess := Processor activeProcess. - received := 0. - tcpRecv waitForConnectionFor: 200. - [received < 16] whileTrue: - ["No need to yield here, because #receiveDataInto:startingAt: will either wait on the readSemaphore of the socket or signal an error." - received := received + (tcpRecv receiveDataInto: recv2 startingAt: received + 1)]] fork. - [sendProcess := Processor activeProcess. - tcpSend connectTo: address port: port. - sent := tcpSend sendData: send1] fork. - (Delay forMilliseconds: 200) wait. - self - assert: sendProcess isTerminated description: 'sendProc hasn''t terminated till the deadline'; - assert: recvProcess isTerminated description: 'recvProc hasn''t terminated till the deadline'; - assert: 16 equals: sent description: ('{1} bytes were sent instead of 16' format: { sent }); - assert: send1 equals: recv2 description: 'sent and received bytes differ'] - ensure: - [tcpSend ifNotNil: [ tcpSend destroy ]. - tcpRecv ifNotNil: [ tcpRecv destroy ]. - sendProcess ifNotNil: [ sendProcess terminate ]. - recvProcess ifNotNil: [ recvProcess terminate ]]! Item was removed: - ----- 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'). - ! Item was removed: - ClassTestCase subclass: #URITest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-URI'! - - !URITest commentStamp: 'pre 4/22/2022 21:05' prior: 0! - 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 - ! Item was removed: - ----- Method: URITest 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']. - ! Item was removed: - ----- Method: URITest 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']. - ! Item was removed: - ----- Method: URITest>>testDefaultDirRoundtrip (in category 'tests - file') ----- - testDefaultDirRoundtrip - | defaultDir defaultURI uriDir | - defaultDir := FileDirectory default. - defaultURI := defaultDir uri. - uriDir := FileDirectory uri: defaultURI. - self should: [defaultDir fullName = uriDir fullName]! Item was removed: - ----- Method: URITest>>testDirWithHash (in category 'tests - 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.! Item was removed: - ----- Method: URITest>>testDirectoryRoot (in category 'tests - file') ----- - testDirectoryRoot - - | rootDir uriRoot uriDir | - rootDir := FileDirectory root. - uriRoot := 'file:///' asURI. - uriDir := FileDirectory uri: uriRoot. - self should: [rootDir fullName = uriDir fullName]! Item was removed: - ----- Method: URITest>>testEquals (in category 'tests - comparing') ----- - testEquals - - | uri uriString | - uri := [:string | URI fromString: string]. - - uriString := 'http://squeak.org/'. - self assert: (uri value: uriString) = (uri value: uriString). - uriString := 'http://squeak.org/index.html'. - self assert: (uri value: uriString) = (uri value: uriString). - uriString := 'mailto:somebody at somewhere.nowhere#fragment'. - self assert: (uri value: uriString) = (uri value: uriString). - - self deny: (uri value: 'http://squeak.org') = (uri value: 'http://website.com').! Item was removed: - ----- Method: URITest>>testResolveAbnormal1 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal10 (in category 'tests - 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/']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal11 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal12 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal13 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal14 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal15 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal16 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal17 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal18 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal2 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal3 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal4 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal5 (in category 'tests - 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.']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal6 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal7 (in category 'tests - 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..']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal8 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveAbnormal9 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal1 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal10 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal11 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal12 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal13 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal14 (in category 'tests - 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/']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal15 (in category 'tests - 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/']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal16 (in category 'tests - 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/']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal17 (in category 'tests - 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/']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal18 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal19 (in category 'tests - 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/']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal2 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal20 (in category 'tests - 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/']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal21 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal3 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal4 (in category 'tests - 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/']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal5 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal6 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal7 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal8 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testResolveNormal9 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testSchemeAbsoluteFail1 (in category 'tests - parsing') ----- - testSchemeAbsoluteFail1 - self should: [URI fromString: 'http:'] raise: IllegalURIException! Item was removed: - ----- Method: URITest>>testSchemeAbsolutePass1 (in category 'tests - 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]! Item was removed: - ----- Method: URITest>>testSchemeAbsolutePass2 (in category 'tests - 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]! Item was removed: - ----- Method: URITest>>testSchemeAbsolutePass3 (in category 'tests - 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]. - ! Item was removed: - ----- Method: URITest>>testSchemeAbsolutePass4 (in category 'tests - 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']. - ! Item was removed: - ----- Method: URITest>>testSchemeAbsolutePass5 (in category 'tests - 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']. - ! Item was removed: - TestCase subclass: #UUIDPrimitivesTest - instanceVariableNames: '' - classVariableNames: 'Default' - poolDictionaries: '' - category: 'NetworkTests-UUID'! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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]. - - ! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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]] - ! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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]]] - ! Item was removed: - TestCase subclass: #UUIDTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-UUID'! Item was removed: - ----- Method: UUIDTest>>testComparison (in category 'tests') ----- - 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 ]! Item was removed: - ClassTestCase subclass: #UrlSubclassesTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'NetworkTests-Url'! Item was removed: - ----- Method: UrlSubclassesTest class>>isAbstract (in category 'Testing') ----- - isAbstract - - ^ self = UrlSubclassesTest! Item was removed: - ----- Method: UrlSubclassesTest>>assertUrl:equals: (in category 'assertions') ----- - assertUrl: aString equals: anotherString - - self - assert: (self createUrlFrom: aString) = (self createUrlFrom: anotherString) - description: ('Url {1} is not equal to {2}' format: {aString . anotherString}).! Item was removed: - ----- Method: UrlSubclassesTest>>createUrlFrom: (in category 'private') ----- - createUrlFrom: aString - - self subclassResponsibility.! Item was removed: - ----- Method: UrlSubclassesTest>>denyUrl:equals: (in category 'assertions') ----- - denyUrl: aString equals: anotherString - - self - deny: (self createUrlFrom: aString) = (self createUrlFrom: anotherString) - description: ('Url {1} is equal to {2} but should not be.' format: {aString . anotherString}).! Item was removed: - 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! Item was removed: - ----- Method: UrlTest>>testAbsoluteBrowser (in category 'tests - absolute urls') ----- - 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. - ! Item was removed: - ----- Method: UrlTest>>testAbsoluteFILE (in category 'tests - absolute urls') ----- - 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'.! Item was removed: - ----- Method: UrlTest>>testAbsoluteFILE2 (in category 'tests - absolute urls') ----- - 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'.! Item was removed: - ----- Method: UrlTest>>testAbsoluteFILE3 (in category 'tests - absolute urls') ----- - 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! Item was removed: - ----- Method: UrlTest>>testAbsoluteFTP (in category 'tests - absolute urls') ----- - 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. - ! Item was removed: - ----- Method: UrlTest>>testAbsoluteHTTP (in category 'tests - absolute urls') ----- - 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'.! Item was removed: - ----- Method: UrlTest>>testAbsolutePortErrorFix (in category 'tests - absolute urls') ----- - 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.! Item was removed: - ----- Method: UrlTest>>testAbsoluteTELNET (in category 'tests - absolute urls') ----- - 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'. - ! Item was removed: - ----- 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]! Item was removed: - ----- Method: UrlTest>>testFromFileNameOrUrlString (in category 'tests') ----- - 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.! Item was removed: - ----- Method: UrlTest>>testRelativeFILE (in category 'tests - relative') ----- - 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. - - ! Item was removed: - ----- Method: UrlTest>>testRelativeFTP (in category 'tests - relative') ----- - testRelativeFTP - - baseUrl := 'ftp://somewhere/some/dir/?query#fragment' asUrl. - url := baseUrl newFromRelativeText: 'ftp://a.b'. - - self assert: url asString = 'ftp://a.b/'.! Item was removed: - ----- Method: UrlTest>>testRelativeFTP2 (in category 'tests - relative') ----- - testRelativeFTP2 - - baseUrl := 'ftp://somewhere/some/dir/?query#fragment' asUrl. - url := baseUrl newFromRelativeText: 'ftp:xyz'. - - - self assert: url asString = 'ftp://somewhere/some/dir/xyz'.! Item was removed: - ----- Method: UrlTest>>testRelativeFTP3 (in category 'tests - relative') ----- - testRelativeFTP3 - - baseUrl := 'ftp://somewhere/some/dir/?query#fragment' asUrl. - url := baseUrl newFromRelativeText: 'http:xyz'. - - self assert: url asString = 'http://xyz/'.! Item was removed: - ----- Method: UrlTest>>testRelativeHTTP (in category 'tests - relative') ----- - 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'.! Item was removed: - ----- 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'.! Item was removed: - ----- 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'. - ! Item was removed: - ----- 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 ]. - - ! Item was removed: - ----- 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: $/)]]. - ! Item was removed: - ----- 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 ] ]. - - ! Item was removed: - ----- 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 |