[Seaside] Testing...here's the code, sorry
C. David Shaffer
cdshaffer at acm.org
Sat Jul 3 21:15:18 CEST 2004
-------------- next part --------------
SystemOrganization addCategory: #SeasideTesting!
WADecoration subclass: #SCAnswerChecker
instanceVariableNames: 'hasAnswer answerValue '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
TestCase subclass: #SCComponentTest
instanceVariableNames: 'app requests pseudomain '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
WARenderLoop subclass: #SCRenderLoop
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
SCComponentTest subclass: #SCSampleComponentTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
Object subclass: #SCSeasideStateMarker
instanceVariableNames: 'sessionId continuationId '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
SCSeasideStateMarker subclass: #SCSeasideAnchor
instanceVariableNames: 'fullUrl anchorNumber path label '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
WAComponent subclass: #SCTestComponent1
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
WAComponent subclass: #SCTestComponent2
instanceVariableNames: 'firstSent secondSent thirdSent '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
WAComponent subclass: #SCTestComponent3
instanceVariableNames: 'field1 field2 button1WasPressed button2WasPressed '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
WAComponent subclass: #SCTestRunner
instanceVariableNames: 'case result '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
WAComponent subclass: #SCTestTracker
instanceVariableNames: 'case '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
WAApplication subclass: #SCTesterApplication
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
WARenderLoopMain subclass: #SCTestingPseudomain
instanceVariableNames: 'renderLoop checker '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
Object subclass: #SCXMLElementWrapper
instanceVariableNames: 'xmlElement '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
SCXMLElementWrapper subclass: #SCParsedSeasideDocument
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
SCXMLElementWrapper subclass: #SCSeasideForm
instanceVariableNames: 'inputs buttons inputValues '
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
SCComponentTest subclass: #WAAllTestsTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SeasideTesting'!
SCAnswerChecker class
instanceVariableNames: ''!
SCComponentTest class
instanceVariableNames: ''!
SCRenderLoop class
instanceVariableNames: ''!
SCSampleComponentTest class
instanceVariableNames: ''!
SCSeasideStateMarker class
instanceVariableNames: ''!
SCSeasideAnchor class
instanceVariableNames: ''!
SCTestComponent1 class
instanceVariableNames: ''!
SCTestComponent2 class
instanceVariableNames: ''!
SCTestComponent3 class
instanceVariableNames: ''!
SCTestRunner class
instanceVariableNames: ''!
SCTestTracker class
instanceVariableNames: ''!
SCTesterApplication class
instanceVariableNames: ''!
SCTestingPseudomain class
instanceVariableNames: ''!
SCXMLElementWrapper class
instanceVariableNames: ''!
SCParsedSeasideDocument class
instanceVariableNames: ''!
SCSeasideForm class
instanceVariableNames: ''!
WAAllTestsTest class
instanceVariableNames: ''!
!SCTesterApplication commentStamp: 'cds 6/18/2004 20:46' prior: 0!
Just need to expose the session registry!
!SCSeasideForm methodsFor: 'posting' stamp: 'cds 6/20/2004 21:08'!
actionUrl
^ xmlElement attributeAt: 'action'! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/24/2004 10:28'!
activateCheckboxWithId: stringId
self setCheckboxWithId: stringId to: true! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/24/2004 00:25'!
activateRadioButtonWithId: stringId
| elem |
elem _ self inputXMLElementWithId: stringId.
(elem attributeAt: 'type') = 'radio' ifFalse: [self error: 'Not a radio button'].
self
inputWithName: (elem attributeAt: 'name')
value: (elem attributeAt: 'value')! !
!SCXMLElementWrapper methodsFor: 'parts' stamp: 'cds 6/23/2004 14:04'!
allElements
| result |
result _ OrderedCollection new.
self allElementsIn: xmlElement addTo: result.
^ result! !
!SCXMLElementWrapper methodsFor: 'parts' stamp: 'cds 6/20/2004 18:16'!
allElementsIn: element addTo: result
result add: element.
element
elementsDo: [:subElement | self allElementsIn: subElement addTo: result]! !
!SCXMLElementWrapper methodsFor: 'parts' stamp: 'cds 6/20/2004 18:16'!
allElementsNamed: tagName in: element addTo: result
element name = tagName
ifTrue: [result add: element]
ifFalse:
[element elementsDo:
[:subElement |
self
allElementsNamed: tagName
in: subElement
addTo: result]]! !
!SCSeasideAnchor methodsFor: 'accessing' stamp: 'cds 6/18/2004 14:19'!
anchorNumber
^anchorNumber! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 09:49'!
anchorNumber: number
| num |
num := number isString ifTrue: [number] ifFalse: [number asString].
^self anchors detect: [:each | each anchorNumber = num] ifNone: []! !
!SCSeasideAnchor methodsFor: 'accessing' stamp: 'cds 6/18/2004 14:19'!
anchorNumber: anObject
anchorNumber := anObject! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/19/2004 21:55'!
anchorWithId: aString
^self
anchorWithId: aString
ifNone: []! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/19/2004 21:54'!
anchorWithId: aString ifNone: aBlock
| res |
res _ self elementWithId: aString ifNone: [].
^res ifNil: aBlock ifNotNil: [SCSeasideAnchor fromXMLElement: res]! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/23/2004 14:05'!
anchorWithLabel: aString
^ self anchors detect: [:anchor | anchor label = aString] ifNone: []! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 18:18'!
anchors
| result |
result _ OrderedCollection new.
self
allElementsNamed: #a
in: xmlElement
addTo: result.
result _ result
select: [:each | each attributes includesKey: #href].
^ result
collect: [:each | SCSeasideAnchor fromXMLElement: each]! !
!SCTestingPseudomain methodsFor: 'accessing' stamp: 'cds 6/19/2004 20:46'!
answerChecker
^checker! !
!SCAnswerChecker methodsFor: 'accessing' stamp: 'cds 6/19/2004 20:47'!
answerValue
^answerValue! !
!SCSeasideAnchor methodsFor: 'converting' stamp: 'cds 6/19/2004 19:52'!
asString
^ fullUrl! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 7/1/2004 11:48'!
back
self requests removeLast.
^ self requests last value! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 00:46'!
backAndRefresh
self back.
^self refresh! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 18:18'!
bodyElement
^ xmlElement
elementAt: #body! !
!WAHtmlTest methodsFor: '*SeasideTesting' stamp: 'cds 6/24/2004 00:41'!
booleanList
^booleanList! !
!SCTestComponent3 methodsFor: 'callbacks' stamp: 'cds 6/19/2004 22:46'!
button1Pressed
button1WasPressed _ true! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:46'!
button1WasPressed
^button1WasPressed! !
!SCTestComponent3 methodsFor: 'callbacks' stamp: 'cds 6/19/2004 22:46'!
button2Pressed
button2WasPressed _ true! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:46'!
button2WasPressed
^ button2WasPressed! !
!SCSeasideForm methodsFor: 'buttons' stamp: 'cds 6/25/2004 17:00'!
buttonWithValue: aString
^self buttons detect: [:each | (each attributeAt: 'value' ifAbsent: []) = aString] ifNone: []! !
!SCSeasideForm methodsFor: 'buttons' stamp: 'cds 6/20/2004 18:32'!
buttons
^buttons! !
!SCTestComponent1 class methodsFor: 'seaside' stamp: 'cds 6/19/2004 00:31'!
canBeRoot
^true! !
!SCTestComponent2 class methodsFor: 'seaside' stamp: 'cds 6/18/2004 21:18'!
canBeRoot
^true! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 19:54'!
checkForSessionInUrl: aString
| a |
a _ SCSeasideAnchor fromHref: aString.
^a! !
!WAHtmlRenderer methodsFor: '*SeasideTesting-override' stamp: 'cds 6/24/2004 10:35'!
checkboxWithValue: aBoolean callback: callbackBlock
| value originalAttributes |
value _ ValueHolder new.
originalAttributes _ attributeBuffer.
attributeBuffer _ nil.
self
hiddenInputWithCallback: [value contents: false].
attributeBuffer _ originalAttributes.
self attributeAt: 'checked' put: aBoolean.
self
valueInputOfType: 'checkbox'
value: 'true'
callback: [value contents: true].
callbackBlock fixTemps.
self
hiddenInputWithCallback: [callbackBlock value: value contents]! !
!SCSeasideForm methodsFor: 'private-inputs' stamp: 'cds 6/24/2004 10:28'!
clearInputWithName: aName
^ self inputValues removeKey: aName! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 7/1/2004 12:00'!
component
^pseudomain component! !
!SCTestingPseudomain methodsFor: 'accessing' stamp: 'cds 6/19/2004 18:41'!
component
^ renderLoop root! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 7/1/2004 12:00'!
componentAnswered: value
| checker |
checker := pseudomain answerChecker.
^checker hasAnswer and: [checker answerValue = value]! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 7/1/2004 12:00'!
configureApplicationForComponent: aComponent
app preferenceAt: #deploymentMode put: true.
pseudomain := SCTestingPseudomain new.
app preferenceAt: #mainClass put: pseudomain! !
!SCSeasideStateMarker methodsFor: 'accessing' stamp: 'cds 6/18/2004 13:23'!
continuationId
^continuationId! !
!SCSeasideStateMarker methodsFor: 'accessing' stamp: 'cds 6/18/2004 13:23'!
continuationId: anObject
continuationId := anObject! !
!SCTestingPseudomain methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:46'!
createRoot
| comp |
checker _ SCAnswerChecker new.
comp _ super createRoot.
comp addDecoration: checker.
^ comp! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/24/2004 10:28'!
deactivateCheckboxWithId: stringId
self setCheckboxWithId: stringId to: false! !
!SCXMLElementWrapper methodsFor: 'parts' stamp: 'cds 6/20/2004 18:16'!
elementWithId: aString ifNone: aBlock
^self allElements
detect: [:each | (each
attributeAt: 'id'
ifAbsent: [])
= aString]
ifNone: aBlock! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/20/2004 20:51'!
establishSession
| req |
req := HttpRequest
readFromStream: (self httpGetRequestStreamFor: app baseUrl asString).
^SCParsedSeasideDocument
fromResponse: (self issueRequestUntilNotMoved: req)! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:43'!
field1
^field1! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:43'!
field1: anObject
field1 := anObject! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:43'!
field2
^field2! !
!SCTestComponent3 methodsFor: 'accessing' stamp: 'cds 6/19/2004 22:43'!
field2: anObject
field2 := anObject! !
!SCTestComponent2 methodsFor: 'accessing' stamp: 'cds 6/18/2004 14:45'!
firstSent
^firstSent! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/20/2004 20:51'!
followAnchor: anAnchor
| req |
self assert: anAnchor notNil.
req := HttpRequest
readFromStream: (self httpGetRequestStreamFor: anAnchor asString).
^SCParsedSeasideDocument
fromResponse: (self issueRequestUntilNotMoved: req)! !
!SCTestRunner class methodsFor: 'instance creation' stamp: 'cds 7/2/2004 15:20'!
forCase: aTestCase
^ self new initializeForCase: aTestCase! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/19/2004 23:05'!
formWithId: aString
^ self formWithId: aString ifNone: []! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 18:27'!
formWithId: aString ifNone: aBlock
| res |
res _ self
elementWithId: aString
ifNone: [].
^ res
ifNil: aBlock
ifNotNil: [SCSeasideForm fromXMLElement: res]! !
!SCParsedSeasideDocument methodsFor: 'parts' stamp: 'cds 6/20/2004 18:27'!
forms
| result |
result _ OrderedCollection new.
self
allElementsNamed: #form
in: xmlElement
addTo: result.
^ result
collect: [:each | SCSeasideForm fromXMLElement: each]! !
!SCSeasideAnchor class methodsFor: 'instance creation' stamp: 'cds 6/18/2004 13:23'!
fromHref: aString
^self new initializeFromHref: aString! !
!SCParsedSeasideDocument class methodsFor: 'instance creation' stamp: 'cds 6/18/2004 15:22'!
fromResponse: aResponse
aResponse contents reset.
^ self fromStream: aResponse contents! !
!SCParsedSeasideDocument class methodsFor: 'instance creation' stamp: 'cds 6/20/2004 18:21'!
fromStream: aStream
| xmlDoc |
xmlDoc _ XMLDOMParser parseDocumentFrom: aStream.
^ self fromXMLDoc: xmlDoc! !
!SCParsedSeasideDocument class methodsFor: 'instance creation' stamp: 'cds 6/20/2004 18:25'!
fromXMLDoc: aDoc
^ self
fromXMLElement: (aDoc elementAt: #html)! !
!SCSeasideAnchor class methodsFor: 'instance creation' stamp: 'cds 6/19/2004 19:45'!
fromXMLElement: anXMLElement
^ self new initializeFromXMLElement: anXMLElement! !
!SCXMLElementWrapper class methodsFor: 'instance creation' stamp: 'cds 6/20/2004 18:17'!
fromXMLElement: anElement
^ self new initializeFromXMLElement: anElement! !
!SCSeasideAnchor methodsFor: 'accessing' stamp: 'cds 6/19/2004 19:51'!
fullUrl: aString
fullUrl _ aString! !
!SCAnswerChecker methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:45'!
handleAnswer: anObject
(super handleAnswer: anObject)
ifFalse: [hasAnswer _ true.
answerValue _ anObject]
ifTrue: [^true].
^ false! !
!SCTesterApplication methodsFor: 'accessing' stamp: 'cds 6/18/2004 20:46'!
handlerWithKey: aKey
^handlersByKey at: aKey ifAbsent: []! !
!SCAnswerChecker methodsFor: 'accessing' stamp: 'cds 6/19/2004 20:47'!
hasAnswer
^hasAnswer! !
!WAComponent class methodsFor: '*SeasideTesting' stamp: 'cds 7/3/2004 14:58'!
hasTestSuite
^self suite notNil! !
!SCSeasideForm methodsFor: 'posting' stamp: 'cds 6/25/2004 17:06'!
httpDataWithButton: button
| resultStream |
resultStream _ WriteStream on: ''.
button attributes
at: 'name'
ifPresent: [:buttonName |
resultStream nextPutAll: buttonName.
button attributes at: 'value' ifPresent: [:value | resultStream nextPut: $=; nextPutAll: value].
self inputValues notEmpty
ifTrue: [resultStream nextPut: $&]].
self inputValues keys
do: [:key | self
writeHttpDataFor: key
value: (self inputValues at: key)
on: resultStream]
separatedBy: [resultStream nextPut: $&].
^ resultStream contents! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/21/2004 01:01'!
httpGetRequestStreamFor: url
^ ('GET ' , url , ' HTTP/1.0' , String crlf) readStream! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/21/2004 01:34'!
httpPostRequestStreamForUrl: url data: postData
^ ('POST ' , url , ' HTTP/1.0 ' , String crlf , 'Content-Length: ' , postData size printString , String crlf , 'Content-type: application/x-www-form-urlencoded' , String crlf , String crlf , postData) readStream! !
!XMLTokenizer methodsFor: '*SeasideTesting-overrides' stamp: 'cds 6/22/2004 23:49'!
initEntities
| ents |
ents _ Dictionary new.
ents
at: 'amp'
put: (DTDEntityDeclaration name: 'amp' value: $&);
at: 'quot'
put: (DTDEntityDeclaration name: 'amp' value: $");
at: 'apos'
put: (DTDEntityDeclaration name: 'apos' value: $');
at: 'gt'
put: (DTDEntityDeclaration name: 'gt' value: $>);
at: 'lt'
put: (DTDEntityDeclaration name: 'lt' value: $<);
at: 'nbsp'
put: (DTDEntityDeclaration name: 'nbsp' value: Character space).
^ ents! !
!SCTestComponent2 methodsFor: 'initialization' stamp: 'cds 6/19/2004 00:44'!
initialize
super initialize.
self session registerObjectForBacktracking: self.
firstSent _ false.
secondSent _ false.
thirdSent _ false! !
!SCTestRunner methodsFor: 'initialization' stamp: 'cds 7/3/2004 14:33'!
initializeForCase: aTestCase
case := aTestCase.
result := aTestCase run! !
!SCSeasideAnchor methodsFor: 'initialize' stamp: 'cds 6/19/2004 19:51'!
initializeFromHref: aString
| parts |
self fullUrl: aString.
parts _ aString findTokens: '?'.
parts isEmpty
ifTrue: [^ self].
self path: parts first.
parts size > 1
ifTrue: [(parts second findTokens: '&')
do: [:each | self variableFromString: each]]! !
!SCSeasideAnchor methodsFor: 'initialize' stamp: 'cds 6/23/2004 14:09'!
initializeFromXMLElement: anXMLElement
self
initializeFromHref: (anXMLElement attributeAt: 'href').
label _ anXMLElement contents first string! !
!SCSeasideForm methodsFor: 'initialize' stamp: 'cds 6/27/2004 00:07'!
initializeFromXMLElement: anXMLElement
super initializeFromXMLElement: anXMLElement.
inputs _ OrderedCollection new.
self
allElementsNamed: #input
in: xmlElement
addTo: inputs.
self
allElementsNamed: #select
in: xmlElement
addTo: inputs.
self
allElementsNamed: #textarea
in: xmlElement
addTo: inputs.
buttons _ inputs
select: [:each | (each
attributeAt: 'type'
ifAbsent: [])
= 'submit'].
self initializeValuesFromCurrentInputs! !
!SCXMLElementWrapper methodsFor: 'initialize' stamp: 'cds 6/20/2004 18:17'!
initializeFromXMLElement: anElement
xmlElement _ anElement! !
!SCSeasideForm methodsFor: 'initialize' stamp: 'cds 6/25/2004 17:16'!
initializeValuesFromCurrentInputs
| value name shouldSet type |
(inputs reject: [:each | (each attributeAt: 'type') = 'submit'])
do: [:each |
name _ each attributeAt: 'name'.
value _ each attributes
at: 'value'
ifAbsent: [].
shouldSet _ name notNil.
type _ each attributeAt: 'type'.
((type = 'radio'
or: [type = 'checkbox'])
and: [(each
attributeAt: 'checked'
ifAbsent: [])
~= 'checked'])
ifTrue: [shouldSet _ false].
shouldSet
ifTrue: [self inputWithName: name value: value]]! !
!SCSeasideForm methodsFor: 'private-inputs' stamp: 'cds 6/20/2004 18:30'!
inputValues
^ inputValues
ifNil: [inputValues _ Dictionary new]! !
!SCSeasideForm methodsFor: 'private-inputs' stamp: 'cds 6/24/2004 00:17'!
inputWithName: stringName value: stringValue
(self inputXMLElementWithName: stringName)
ifNil: [self error: 'No such input element'].
self inputValues
at: stringName
put: stringValue! !
!SCSeasideForm methodsFor: 'private-inputs' stamp: 'cds 6/24/2004 00:13'!
inputXMLElementWithId: anId
^inputs detect: [:each | (each attributes at: 'id' ifAbsent: []) = anId]
ifNone: []! !
!SCSeasideForm methodsFor: 'private-inputs' stamp: 'cds 6/24/2004 00:17'!
inputXMLElementWithName: aName
^ inputs
detect: [:each | (each attributes
at: 'name'
ifAbsent: [])
= aName]
ifNone: []! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 7/1/2004 11:49'!
issueRequest: anHttpRequest
| result |
result _ WAKom default processHttpRequest: anHttpRequest.
self requests add: anHttpRequest -> result.
^result! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/20/2004 20:51'!
issueRequestUntilNotMoved: anHttpRequest
| response req newUrl |
req := anHttpRequest.
[response := self issueRequest: req.
response status = #tempMoved]
whileTrue:
[self requests removeLast.
newUrl := response fields at: 'Location'.
self checkForSessionInUrl: newUrl.
req := HttpRequest readFromStream: (self httpGetRequestStreamFor: newUrl)].
^response! !
!SCSeasideAnchor methodsFor: 'accessing' stamp: 'cds 6/23/2004 14:06'!
label
^label! !
!WAHtmlTest methodsFor: '*SeasideTesting' stamp: 'cds 6/25/2004 17:18'!
message
^message! !
!SCSeasideForm methodsFor: 'private-inputs' stamp: 'cds 6/24/2004 00:20'!
nameForElementWithId: aString
^ (self inputXMLElementWithId: aString)
attributeAt: 'name'! !
!SCTestingPseudomain methodsFor: 'hack' stamp: 'cds 6/18/2004 20:31'!
new
^self! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/18/2004 20:51'!
newApplicationForComponent: aComponentClass
app _ SCTesterApplication path: aComponentClass name.
app configuration addAncestor: WARenderLoopConfiguration localConfiguration.
app preferenceAt: #rootComponent put: aComponentClass.
WADispatcher default registerEntryPoint: app at: aComponentClass name.
self configureApplicationForComponent: aComponentClass.
^ app! !
!WAHtmlTest methodsFor: '*SeasideTesting' stamp: 'cds 6/25/2004 16:54'!
number
^number! !
!SCSeasideForm methodsFor: 'private-inputs' stamp: 'cds 6/25/2004 16:52'!
optionValuesByTextForSelect: aSelectElement
| optionElements result |
optionElements _ aSelectElement elements
select: [:each | each name = 'option'].
result _ Dictionary new.
optionElements
do: [:each | result at: (each contents first string) put: (each attributeAt: 'value') ].
^result! !
!SCSeasideAnchor methodsFor: 'accessing' stamp: 'cds 6/19/2004 19:54'!
path: aString
path _ aString! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 7/1/2004 11:48'!
refresh
^ SCParsedSeasideDocument
fromResponse: (self issueRequestUntilNotMoved: self requests last key)! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/18/2004 15:13'!
removeApplication
WADispatcher default removeEntryPoint: app.! !
!SCTestRunner methodsFor: 'rendering' stamp: 'cds 7/3/2004 14:55'!
renderBrowserAnchorFor: aTestCase on: html
| browser |
html
anchorWithPopupAction: [browser _ WABrowser fullOnClass: aTestCase class.
browser model selectedMessageName: aTestCase selector.
self call: browser]
extent: 825 at 560
text: 'Browse'! !
!WAHtmlTest methodsFor: '*SeasideTesting-override' stamp: 'cds 6/24/2004 10:30'!
renderCheckboxesOn: html
html text: booleanList.
html paragraph.
html cssId: 'checkbox-form'.
html
form: [booleanList
do: [:assoc |
html text: assoc key;
space.
html cssId: 'cb-' , assoc key asString.
html
checkboxWithValue: assoc value
callback: [:b | assoc value: b].
html break].
html submitButton]! !
!SCTestComponent1 methodsFor: 'rendering' stamp: 'cds 6/19/2004 20:26'!
renderContentOn: html
html text: 'hello'! !
!SCTestComponent2 methodsFor: 'accessing' stamp: 'cds 6/19/2004 21:55'!
renderContentOn: html
self firstSent
ifFalse: [html
anchorWithAction: [self sendFirst]
text: 'first link'].
html text: 'hello'.
self secondSent
ifFalse: [html cssId: 'second'.
html
anchorWithAction: [self sendSecond]
text: 'second link'].
self thirdSent
ifFalse: [
html cssId: 'third'.
html
anchorWithAction: [self sendThird]
text: 'third link']! !
!SCTestComponent3 methodsFor: 'rendering' stamp: 'cds 6/19/2004 22:47'!
renderContentOn: html
html
form: [html text: 'field1: '.
html textInputOn: #field1 of: self.
html br.
html text: 'field2: '.
html textInputOn: #field2 of: self.
html br.
html cssId: 'button1'.
html
submitButtonWithAction: [self button1Pressed].
html cssId: 'button2'.
html
submitButtonWithAction: [self button2Pressed]]! !
!SCTestRunner methodsFor: 'rendering' stamp: 'cds 7/3/2004 12:23'!
renderContentOn: html
html heading: case name level: 2.
html text: result printString.
html hr.
self renderFailedOn: html.
self renderErrorOn: html.
self renderPassedOn: html.
html br.
html
anchorWithAction: [self answer]
text: 'close'! !
!WAHalo methodsFor: '*SeasideTesting-override' stamp: 'cds 7/3/2004 15:01'!
renderContentOn: html
html
divClass: 'halo'
with: [html
divClass: 'halo-header'
with: [html
divClass: 'halo-icons'
with: [html
divClass: 'halo-mode'
with: [html text: '['.
html
anchorWithAction: [self renderMode]
text: 'R'.
html text: ' | '.
html
anchorWithAction: [self sourceMode]
text: 'S'.
html text: ']'].
html text: target class name.
html space.
self
renderHalo: 'Halo-Debug'
withPopup: [WABrowser fullOnClass: target class]
on: html.
self
renderHalo: 'Halo-View'
withPopup: [WAInspector on: target]
on: html.
self
renderHalo: 'Halo-Paint'
withPopup: [WAViewer on: target]
on: html.
(target class hasTestSuite)
ifTrue: [self
renderHalo: 'Halo-Tile'
withPopup: [SCTestRunner forCase: target class suite]
on: html]]].
html
divClass: 'halo-contents'
with: [self perform: mode contents with: html]]! !
!SCTestRunner methodsFor: 'rendering' stamp: 'cds 7/3/2004 14:56'!
renderErrorOn: html
html heading: 'Errors:' level: 3.
result errors
do: [:each |
html cssClass: 'error-test'.
html
span: [html text: each printString].
html space.
html
anchorWithAction: [each debug]
text: 'Debug'.
html space.
self renderBrowserAnchorFor: each on: html.
html br].
html hr! !
!SCTestRunner methodsFor: 'rendering' stamp: 'cds 7/3/2004 14:52'!
renderFailedOn: html
html heading: 'Failed:' level: 3.
result failures
do: [:each |
html cssClass: 'failed-test'.
html span: each printString.
html space.
html
anchorWithAction: [each debugAsFailure]
text: 'Debug'.
html space.
self renderBrowserAnchorFor: each on: html.
html br].
html hr! !
!SCTestRunner methodsFor: 'rendering' stamp: 'cds 7/3/2004 14:56'!
renderPassedOn: html
html heading: 'Passed:' level: 3.
result passed
do: [:each |
html cssClass: 'passed-test'.
html span: each printString.
html space.
self renderBrowserAnchorFor: each on: html.
html br].
html hr! !
!WAHtmlTest methodsFor: '*SeasideTesting-override' stamp: 'cds 6/24/2004 00:34'!
renderRadioButtonsOn: html
html text: booleanList.
html paragraph.
html cssId: 'radio-form'.
html
form: [booleanList
do: [:assoc |
| group |
group _ html radioGroup.
html text: assoc key;
space.
html cssId: assoc key asString , '-on'.
html
radioButtonInGroup: group
selected: assoc value
callback: [assoc value: true].
html cssId: assoc key asString , '-off'.
html
radioButtonInGroup: group
selected: assoc value not
callback: [assoc value: false].
html break].
html submitButton]! !
!WADispatcherEditor methodsFor: '*SeasideTesting-override' stamp: 'cds 7/3/2004 15:01'!
renderRowForEntryPoint: anEntryPoint named: aString on: html
| rootClass |
html
tableRowWith: [html anchorWithUrl: anEntryPoint basePath do: aString]
with: [html
anchorWithAction: [self configure: anEntryPoint]
text: 'configure'.
html space;
anchorWithAction: [self remove: anEntryPoint]
text: 'remove'.
rootClass _ anEntryPoint preferenceAt: #rootComponent.
(rootClass notNil
and: [rootClass hasTestSuite])
ifTrue: [html space;
anchorWithAction: [self test: rootClass]
text: 'test']]! !
!WAHtmlTest methodsFor: '*SeasideTesting-override' stamp: 'cds 6/25/2004 16:45'!
renderSelectsOn: html
html text: number.
html paragraph.
html cssId: 'select-form'.
html
form: [html cssId: 'select-list'.
html
selectFromList: (1 to: 10)
selected: number
callback: [:i | number _ i].
html submitButton]! !
!WAHtmlTest methodsFor: '*SeasideTesting-override' stamp: 'cds 6/25/2004 16:57'!
renderSubmitButtonsOn: html
html text: number.
html paragraph.
html cssId: 'button-form'.
html
form: [(1 to: 10)
do: [:i |
html
submitButtonWithAction: [number _ i]
text: i.
html space]]! !
!WAHtmlTest methodsFor: '*SeasideTesting-override' stamp: 'cds 6/27/2004 00:07'!
renderTextAreaOn: html
html cssId: 'textarea-form'.
html
form: [html text: message.
html paragraph.
html cssId: 'textarea-message'.
html
textAreaWithValue: message
callback: [:v | message _ v].
html break; submitButton]! !
!WAHtmlTest methodsFor: '*SeasideTesting-override' stamp: 'cds 6/25/2004 17:23'!
renderTextInputOn: html
html cssId: 'textInput-form'.
html
form: [html text: message.
html paragraph.
html cssId: 'text-message'.
html
textInputWithValue: message
callback: [:v | message _ v].
html submitButton]! !
!SCComponentTest methodsFor: 'accessing' stamp: 'cds 6/18/2004 20:24'!
requests
^requests ifNil: [requests _ OrderedCollection new]! !
!SCRenderLoop methodsFor: 'accessing' stamp: 'cds 6/19/2004 18:43'!
root
^root! !
!SCTestComponent2 methodsFor: 'accessing' stamp: 'cds 6/18/2004 14:45'!
secondSent
^secondSent! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/25/2004 16:53'!
selectListWithId: aStringId optionWithText: text
| elem d value |
elem _ self inputXMLElementWithId: aStringId.
elem name = 'select'
ifFalse: [self error: 'Not a select'].
((d _ self optionValuesByTextForSelect: elem)
includesKey: text)
ifFalse: [self error: 'No such option'].
value _ d at: text.
self
inputWithName: (elem attributeAt: 'name')
value: value! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 6/22/2004 23:46'!
selectedComponent
^self component contents selectedComponent! !
!SCTestComponent2 methodsFor: 'callbacks' stamp: 'cds 6/18/2004 14:45'!
sendFirst
firstSent _ true! !
!SCTestComponent2 methodsFor: 'callbacks' stamp: 'cds 6/18/2004 14:45'!
sendSecond
secondSent _ true! !
!SCTestComponent2 methodsFor: 'callbacks' stamp: 'cds 6/19/2004 20:39'!
sendThird
thirdSent _ true.
self answer: 1234! !
!SCSeasideStateMarker methodsFor: 'accessing' stamp: 'cds 6/18/2004 13:23'!
sessionId
^sessionId! !
!SCSeasideStateMarker methodsFor: 'accessing' stamp: 'cds 6/18/2004 13:23'!
sessionId: anObject
sessionId := anObject! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/24/2004 10:27'!
setCheckboxWithId: stringId to: aBoolean
| elem |
elem _ self inputXMLElementWithId: stringId.
(elem attributeAt: 'type')
= 'checkbox'
ifFalse: [self error: 'Not a checkbox'].
aBoolean ifTrue: [self
inputWithName: (elem attributeAt: 'name')
value: (elem attributeAt: 'value')]
ifFalse: [self clearInputWithName: (elem attributeAt: 'name')]! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:36'!
setUp
requests _ OrderedCollection new! !
!SCTestingPseudomain methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 18:43'!
start: aRequest
self session redirect.
(renderLoop _ SCRenderLoop new root: self createRoot) run! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/21/2004 01:34'!
submitForm: form pressingButton: button
| req url |
self assert: form notNil.
url _ form actionUrl.
req _ HttpRequest
readFromStream: (self
httpPostRequestStreamForUrl: url
data: (form httpDataWithButton: button)).
^ SCParsedSeasideDocument
fromResponse: (self issueRequestUntilNotMoved: req)! !
!WAComponent class methodsFor: '*SeasideTesting' stamp: 'cds 7/3/2004 14:59'!
suite
^(Smalltalk hasClassNamed: self testSuiteName) ifTrue: [Smalltalk classNamed: self testSuiteName] ifFalse: []! !
!SCComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:25'!
tearDown
self removeApplication.
! !
!WADispatcherEditor methodsFor: '*SeasideTesting' stamp: 'cds 7/2/2004 15:22'!
test: rootClass
self
call: (SCTestRunner forCase: rootClass suite)! !
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:38'!
testAnswer
| result |
self newApplicationForComponent: SCTestComponent2.
result _ self establishSession.
result _ self
followAnchor: (result anchorNumber: 3).
self assert: (self componentAnswered: 1234)! !
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 20:36'!
testBack
| result |
self newApplicationForComponent: SCTestComponent2.
result _ self establishSession.
result _ self
followAnchor: (result anchorNumber: 1).
self assert: self component firstSent.
self deny: self component secondSent.
result _ self
followAnchor: (result anchorNumber: 1).
self backAndRefresh.
self assert: self component firstSent.
self deny: self component secondSent! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 6/25/2004 17:01'!
testButtons
| result form |
self newApplicationForComponent: WAHtmlTest.
result _ self establishSession.
form _ result formWithId: 'button-form'.
result _ self submitForm: form pressingButton: (form buttonWithValue: '5').
self assert: self component number = 5.
form _ result formWithId: 'button-form'.
result _ self submitForm: form pressingButton: (form buttonWithValue: '1').
self assert: self component number = 1.! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 6/25/2004 16:45'!
testCheckbox
| result form |
self newApplicationForComponent: WAHtmlTest.
result _ self establishSession.
form _ result formWithId: 'checkbox-form'.
form activateCheckboxWithId: 'cb-a'.
result _ self submitForm: form pressingButton: form buttons first.
self assert: self component booleanList first value.
form _ result formWithId: 'checkbox-form'.
form deactivateCheckboxWithId: 'cb-a'.
result _ self submitForm: form pressingButton: form buttons first.
self deny: self component booleanList first value.
! !
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 19:59'!
testComponent1
| result |
self newApplicationForComponent: SCTestComponent1.
result := self establishSession.
self assert: result bodyElement contents first string = 'hello'! !
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/19/2004 21:56'!
testComponent2
| result |
self newApplicationForComponent: SCTestComponent2.
result _ self establishSession.
result _ self
followAnchor: (result anchorNumber: 1).
self assert: self component firstSent.
self deny: self component secondSent.
result _ self
followAnchor: (result anchorWithId: 'second').
self assert: self component firstSent.
self assert: self component secondSent! !
!SCSampleComponentTest methodsFor: 'as yet unclassified' stamp: 'cds 6/24/2004 00:19'!
testComponent3
| result form |
self newApplicationForComponent: SCTestComponent3.
result _ self establishSession.
form _ result forms first.
form textInputWithId: 'field1' value: 'bob'.
form textInputWithId: 'field2' value: 'jane'.
result _ self submitForm: form pressingButton: form buttons first.
self assert: self component field1 = 'bob'.
self assert: self component field2 = 'jane'! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 7/3/2004 12:22'!
testError
| result form |
self newApplicationForComponent: WAAllTests.
result _ self establishSession.
result _ self
followAnchor: (result anchorWithLabel: 'Input').
self assert: self selectedComponent class = WAInputTest.
self assert: self selectedComponent integer = 42.
form _ result forms first.
form textInputWithId: 'nilString' value: 'bob'.
result _ self submitForm: form pressingButton: form buttons first.
self zork! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 6/27/2004 18:47'!
testException
| result form |
self newApplicationForComponent: WAExceptionTest.
form _ self establishSession forms first.
result _ self
submitForm: form
pressingButton: (form buttonWithValue: 'Yes').
self assert: result bodyElement elements first contents first string = 'Caught: Error: foo'! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 7/3/2004 14:54'!
testFailure
| result form |
self newApplicationForComponent: WAAllTests.
result _ self establishSession.
result _ self
followAnchor: (result anchorWithLabel: 'Input').
self assert: self selectedComponent class = WAInputTest.
self assert: self selectedComponent integer = 42.
form _ result forms first.
form textInputWithId: 'nilString' value: 'bob'.
result _ self submitForm: form pressingButton: form buttons first.
self assert: self selectedComponent nilString = 'some other name'! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 6/27/2004 19:05'!
testNavigation
| result form |
self newApplicationForComponent: WAAllTests.
result _ self establishSession.
result _ self
followAnchor: (result anchorWithLabel: 'Input').
self assert: self selectedComponent class = WAInputTest.
self assert: self selectedComponent integer = 42.
form _ result forms first.
form textInputWithId: 'nilString' value: 'bob'.
result _ self submitForm: form pressingButton: form buttons first.
self assert: self selectedComponent nilString = 'bob'.
result _ self
followAnchor: (result anchorWithLabel: 'Html').
self assert: self selectedComponent class = WAHtmlTest.
form _ result formWithId: 'radio-form'.
form activateRadioButtonWithId: 'a-on'.
result _ self submitForm: form pressingButton: form buttons first.
self assert: self selectedComponent booleanList first value.
form _ result formWithId: 'radio-form'.
form activateRadioButtonWithId: 'a-off'.
result _ self submitForm: form pressingButton: form buttons first.
self deny: self selectedComponent booleanList first value.
result _ self
followAnchor: (result anchorWithLabel: 'Parent').
self assert: self selectedComponent class = WAParentTest.
result _ self
followAnchor: (result anchorWithLabel: 'swap parent').
self assert: result bodyElement elements first contents first string = 'foo'.
self assert: (result anchorWithLabel: 'Html') isNil.
form _ result forms first.
result _ self submitForm: form pressingButton: form buttons first.
self assert: (result anchorWithLabel: 'Html') notNil! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 6/25/2004 17:17'!
testSelect
| result form |
self newApplicationForComponent: WAHtmlTest.
result _ self establishSession.
form _ result formWithId: 'select-form'.
form selectListWithId: 'select-list' optionWithText: '7'.
result _ self submitForm: form pressingButton: form buttons first.
self assert: self component number = 7.
form _ result formWithId: 'select-form'.
self
should: [form selectListWithId: 'select-list' optionWithText: '15']
raise: Error.
form selectListWithId: 'select-list' optionWithText: '2'.
result _ self submitForm: form pressingButton: form buttons first.
self assert: self component number = 2.
self assert: (form buttonWithValue: '22') isNil! !
!WAComponent class methodsFor: '*SeasideTesting' stamp: 'cds 7/3/2004 15:00'!
testSuiteName
^(self name , 'Test') asSymbol! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 6/27/2004 00:08'!
testTextAreaInput
| result form |
self newApplicationForComponent: WAHtmlTest.
result _ self establishSession.
form _ result formWithId: 'textarea-form'.
self assert: form xmlElement elements first contents first string = 'Hello world!!'.
self assert: self component message = 'Hello world!!'.
form textInputWithId: 'textarea-message' value: 'bob'.
result _ self submitForm: form pressingButton: form buttons first.
form _ result formWithId: 'textarea-form'.
self assert: form xmlElement elements first contents first string = 'bob'.
self assert: self component message = 'bob'! !
!WAAllTestsTest methodsFor: 'tests' stamp: 'cds 6/25/2004 17:24'!
testTextInput
| result form |
self newApplicationForComponent: WAHtmlTest.
result _ self establishSession.
form _ result formWithId: 'textInput-form'.
self assert: form xmlElement elements first contents first string = 'Hello world!!'.
self assert: self component message = 'Hello world!!'.
form textInputWithId: 'text-message' value: 'bob'.
result _ self submitForm: form pressingButton: form buttons first.
form _ result formWithId: 'textInput-form'.
self assert: form xmlElement elements first contents first string = 'bob'.
self assert: self component message = 'bob'! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/24/2004 00:21'!
textInputWithId: stringId value: stringValue
self inputWithName: (self nameForElementWithId: stringId) value: stringValue! !
!SCSeasideForm methodsFor: 'inputs' stamp: 'cds 6/24/2004 00:18'!
textInputWithName: stringName value: stringValue
self inputWithName: stringName value: stringValue ! !
!SCTestComponent2 methodsFor: 'accessing' stamp: 'cds 6/19/2004 00:41'!
thirdSent
^thirdSent! !
!SCSeasideAnchor methodsFor: 'initialize' stamp: 'cds 6/18/2004 14:19'!
variableFromString: aString
| parts |
parts _ aString findTokens: '='.
parts isEmpty
ifTrue: [^ nil].
parts size = 1
ifTrue: [^ self anchorNumber: parts first].
parts first = '_s'
ifTrue: [^ self sessionId: parts second].
parts first = '_k'
ifTrue: [^ self continuationId: parts second]! !
!SCSeasideForm methodsFor: 'posting' stamp: 'cds 6/24/2004 00:21'!
writeHttpDataFor: key value: value on: stream
| name |
name _ key.
value
ifNil: [^ stream nextPutAll: name].
value isString
ifTrue: [stream nextPutAll: name;
nextPut: $=;
nextPutAll: value]
ifFalse: [value
do: [:each | self
writeHttpDataFor: key
value: each
on: stream]
separatedBy: [stream nextPut: $&]]! !
!SCXMLElementWrapper methodsFor: 'parts' stamp: 'cds 6/25/2004 17:21'!
xmlElement
^xmlElement! !
More information about the Seaside
mailing list