SystemOrganization addCategory: #'OB-Tests-Web'!
OBBuilderTest subclass: #OBWebBuilderTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBWebBuilderTest methodsFor: 'building' stamp: 'cwp 7/8/2007 01:21'!
builderClass
^ OBWebBuilder! !
!OBWebBuilderTest methodsFor: 'tests' stamp: 'cwp 3/13/2007 22:14'!
tests01BrowserCreatesWindow
| widget |
widget _ self buildWindow.
self assert: (widget isKindOf: OBWebWindow).
self assert: widget model == model.! !
!OBWebBuilderTest methodsFor: 'tests' stamp: 'cwp 3/13/2007 22:19'!
tests02BrowserAddsPanels
| widget |
widget _ self buildWindow.
self assert: widget children size = 2.
self assert: (widget children first isKindOf: OBWebScroller).
self assert: (widget children second isKindOf: OBWebText).! !
!OBWebBuilderTest methodsFor: 'tests' stamp: 'cwp 3/13/2007 22:21'!
tests03ColumnPanelAddsColumns
| widget |
widget _ self buildNavigationPanel.
self assert: widget children size = 4.
widget children do: [:ea | self assert: (ea isKindOf: OBWebPane)].! !
!OBWebBuilderTest methodsFor: 'tests' stamp: 'cwp 7/8/2007 01:06'!
tests04ColumnAddsList
| pane |
pane _ self build: self columnWithFilter.
self assert: (pane isKindOf: OBWebPane).
self assert: (pane children first isKindOf: OBWebList)! !
!OBWebBuilderTest methodsFor: 'tests' stamp: 'cwp 7/8/2007 01:13'!
tests05ColumnAddsButton
| pane |
pane _ self build: self columnWithFilter.
self assert: (pane isKindOf: OBWebPane).
self assert: (pane children second isKindOf: OBWebButtonBar)! !
TestCase subclass: #OBAjaxMessageTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBAjaxMessageTest methodsFor: 'as yet unclassified' stamp: 'cwp 5/21/2007 00:07'!
test01ArgumentsCanBeExplicit
| message |
message _ OBAjaxMessage
receiver: 'abc'
selector: #test:with:
arguments: #(a b).
self assert: message arguments = #(a b)! !
!OBAjaxMessageTest methodsFor: 'as yet unclassified' stamp: 'cwp 5/21/2007 00:07'!
test02ArgumentsCanBeLazy
| message |
message _ OBAjaxMessage
receiver: 'abc'
selector: #test:with:
arguments: [Array with: #a with: #b].
self assert: message arguments = #(a b)! !
TestCase subclass: #OBHtmlGenerationTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBHtmlGenerationTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/2/2007 01:34'!
expectedWindowHtml
^ '
browser'! !
!OBHtmlGenerationTest methodsFor: 'as yet unclassified' stamp: 'cwp 9/12/2007 22:41'!
expectedWindowWithChildHtml
^ 'browser'! !
!OBHtmlGenerationTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/24/2006 14:46'!
id
^ OBWebIdentifier random: (Random seed: 32445)! !
!OBHtmlGenerationTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/10/2007 00:00'!
test01EmptyWindow
| widget |
widget _ OBWebWindow id: self id model: self.
self assert: widget contents = self expectedWindowHtml.
! !
!OBHtmlGenerationTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/10/2007 00:00'!
test02WindowWithChild
| widget actual expected |
widget _ OBWebWindow id: self id model: self.
widget addChild: (OBWebText id: self id model: self).
actual _ widget contents.
expected _ self expectedWindowWithChildHtml.
self assert: actual = expected
! !
!OBHtmlGenerationTest methodsFor: 'as yet unclassified' stamp: 'cwp 5/21/2007 00:30'!
text
^ 'This is a tast'! !
TestCase subclass: #OBSubcontinuationTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBSubcontinuationTest methodsFor: 'as yet unclassified' stamp: 'cwp 2/11/2007 17:42'!
doSubcomp1: sc
| i param |
i _ 0.
param _ sc escape:
[:k |
i _ i + 1.
k].
i _ i + 1.
^ i + param! !
!OBSubcontinuationTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/14/2007 22:57'!
testEscapeValue
| escapeVal |
escapeVal _ OBSubcomputation do:
[:subcomp |
subcomp escape: [:k | 1].
2].
self assert: escapeVal = 1.
! !
!OBSubcontinuationTest methodsFor: 'as yet unclassified' stamp: 'cwp 6/18/2007 23:37'!
testMethodTempSideEffects
"This test demonstrates that subcontinuations can have side effects
on temporary variables outside of the subcomputation. Even though
i is declared inside the subcomputation, it's actually stored in the
activation context for this method. It's incremented in the escape block
and not restored when the continuation is activated."
| continuation param i |
OBSubcomputation do:
[:sc |
i _ 0.
param _ sc escape:
[:k |
continuation _ k.
i _ i + 1].
i + param].
self assert: i = 1.
self assert: (continuation value: 2) = 3.
self assert: (continuation value: 3) = 4.! !
!OBSubcontinuationTest methodsFor: 'as yet unclassified' stamp: 'cwp 6/18/2007 23:37'!
testMethodTemps
"This test demonstrates that the temps in #doSubcomp1: are
restored each time the subcontinuation is evaluated."
| continuation |
continuation _ OBSubcomputation do: [:sc | self doSubcomp1: sc].
self assert: (continuation value: 1) = 2.
self assert: (continuation value: 2) = 3.! !
!OBSubcontinuationTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/14/2007 23:46'!
testResume
| continuation sc1 sc2 |
OBSubcomputation do:
[:subcomp |
sc1 _ subcomp.
sc2 _ subcomp escape: [:k | continuation _ k]].
OBSubcomputation resume: continuation.
self assert: sc1 class = OBSubcomputation.
self assert: sc2 class = OBSubcomputation.
self deny: sc1 == sc2! !
!OBSubcontinuationTest methodsFor: 'as yet unclassified' stamp: 'cwp 6/18/2007 23:37'!
testSimpleCallSC
| continuation |
OBSubcomputation do:
[:subcomp |
subcomp escape: [:k | continuation _ k]].
self assert: (continuation value: true)! !
!OBSubcontinuationTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/14/2007 23:00'!
testTerminate
| result |
result _ OBSubcomputation do:
[:subcomp |
subcomp terminate: 1.
2].
self assert: result = 1.
! !
TestCase subclass: #OBWebIdentifierTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBWebIdentifierTest methodsFor: 'as yet unclassified' stamp: 'cwp 1/27/2008 01:38'!
test01DefaultSize
| id |
id _ OBWebIdentifier new.
self assert: id asNumber size = 16! !
!OBWebIdentifierTest methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2007 00:14'!
test02Print
| id |
id := OBWebIdentifier random: (Random seed: 32655).
self assert: id printString = 'w5hrndt4hbpbym40b4s1p5qw5e'! !
TestCase subclass: #OBWebLinkTest
instanceVariableNames: 'delivered link'
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/30/2007 21:37'!
ackMessage
delivered _ #ackMessage! !
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/30/2007 21:38'!
handleMessage: aMessage
self perform: aMessage selector withArguments: aMessage arguments! !
!OBWebLinkTest methodsFor: 'support' stamp: 'cwp 10/31/2007 00:33'!
handleOpenWindow: aRequest
aRequest resume: (OBWebWindow new)! !
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/31/2007 00:01'!
identifier
^ 'griffle'! !
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/30/2007 21:48'!
interrupt
OBInformRequest message: 'test'.
delivered _ #resumed! !
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/31/2007 00:12'!
raiseBrowse
OBBrowseRequest signal: (OBSystemBrowser new)! !
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/31/2007 00:45'!
raiseChoice
OBChoiceRequest labels: #('alpha' 'beta' 'gamma')! !
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/30/2007 23:28'!
raiseInform
OBInformRequest message: 'test'! !
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/31/2007 00:54'!
raiseMenu
OBWebMenu new
add: '1' target: 1 selector: #yourself;
open! !
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/31/2007 01:01'!
raiseText
OBTextRequest prompt: 'gimme text!!'! !
!OBWebLinkTest methodsFor: 'support' stamp: 'cwp 10/30/2007 23:36'!
resultOf: aSelector
^ (self send: aSelector) first! !
!OBWebLinkTest methodsFor: 'support' stamp: 'cwp 10/30/2007 23:24'!
send: aSelector
^ self send: aSelector arguments: #()! !
!OBWebLinkTest methodsFor: 'support' stamp: 'cwp 10/31/2007 22:04'!
send: aSelector arguments: aCollection
| message |
message := OBAjaxMessage
receiver: 'foo'
selector: aSelector
arguments: aCollection.
^[link processMessage: message] on: OBWindowRequest
do: [:req | req handleWith: self]! !
!OBWebLinkTest methodsFor: 'messages' stamp: 'cwp 10/30/2007 23:09'!
sendMessage
| message |
message _ OBAjaxMessage receiver: 'fo' selector: #open arguments: #().
message queue! !
!OBWebLinkTest methodsFor: 'support' stamp: 'cwp 10/31/2007 22:04'!
setUp
link := OBWebLink new.
link at: 'foo' put: self! !
!OBWebLinkTest methodsFor: 'tests' stamp: 'cwp 10/31/2007 00:36'!
testBrowseRequest
| outgoing |
outgoing := (self send: #raiseBrowse) first.
self assert: outgoing selector = 'openWindow'.
self assert: (outgoing arguments first beginsWith: '/windows')! !
!OBWebLinkTest methodsFor: 'tests' stamp: 'cwp 10/31/2007 00:45'!
testChoiceRequest
| outgoing |
outgoing := (self send: #raiseChoice) first.
self assert: outgoing selector = 'requestChoice'! !
!OBWebLinkTest methodsFor: 'tests' stamp: 'cwp 10/30/2007 23:23'!
testContinuation
self send: #interrupt.
self send: #continue: arguments: #(value).
self assert: delivered = #resumed! !
!OBWebLinkTest methodsFor: 'tests' stamp: 'cwp 10/30/2007 23:20'!
testDelivery
self send: #ackMessage.
self assert: delivered == #ackMessage! !
!OBWebLinkTest methodsFor: 'tests' stamp: 'cwp 10/31/2007 22:04'!
testDoesntQueueDuplicateMessages
| message |
message := OBAjaxMessage
receiver: self identifier
selector: #ackMessage
arguments: #().
link queueMessage: message.
link queueMessage: message copy.
self assert: link flushQueue size = 1! !
!OBWebLinkTest methodsFor: 'tests' stamp: 'cwp 10/30/2007 23:54'!
testInformRequest
| outgoing |
outgoing := (self send: #raiseInform) first.
self assert: outgoing selector = 'inform'! !
!OBWebLinkTest methodsFor: 'tests' stamp: 'cwp 10/31/2007 00:55'!
testMenuRequest
| outgoing |
outgoing := (self send: #raiseMenu) first.
self assert: outgoing selector = #openMenu! !
!OBWebLinkTest methodsFor: 'tests' stamp: 'cwp 10/31/2007 00:02'!
testQueue
| outgoing |
outgoing := (self send: #sendMessage) first.
self assert: outgoing selector = #open! !
!OBWebLinkTest methodsFor: 'tests' stamp: 'cwp 10/31/2007 01:02'!
testTextRequest
| outgoing |
outgoing := (self send: #raiseText) first.
self assert: outgoing selector = #requestText! !
TestCase subclass: #OBWebListTest
instanceVariableNames: 'hasIcons'
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBWebListTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/25/2006 11:56'!
createList
^ OBWebList
id: (OBWebIdentifier random: (Random seed: 43222))
model: self! !
!OBWebListTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/12/2007 13:54'!
iconAt: anInteger
^ hasIcons ifTrue: [#ico] ifFalse: [nil]! !
!OBWebListTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/25/2006 12:05'!
list
^ #('Alpha' 'Beta' 'Gamma')! !
!OBWebListTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/25/2006 12:05'!
selection
^ 2! !
!OBWebListTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/12/2007 13:54'!
setUp
hasIcons _ true! !
!OBWebListTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/12/2007 12:33'!
test01InitializationJavascript
| list init |
list _ self createList.
init _ String streamContents: [:s | list jsInitializeOn: s].
self assert: init = 'Widget.get("wan18u9s6ubfe77f1ug6yo74uv").update({"items": ["Alpha", "Beta", "Gamma"], "icons": ["ico", "ico", "ico"], "selection": 1}); '! !
!OBWebListTest methodsFor: 'as yet unclassified' stamp: 'cwp 8/12/2007 13:54'!
test01InitializationNoIcons
| list init |
list _ self createList.
hasIcons _ false.
init _ String streamContents: [:s | list jsInitializeOn: s].
self assert: init = 'Widget.get("wan18u9s6ubfe77f1ug6yo74uv").update({"items": ["Alpha", "Beta", "Gamma"], "icons": [], "selection": 1}); '! !
TestCase subclass: #OBWebMenuItemTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBWebMenuItemTest methodsFor: 'as yet unclassified' stamp: 'cwp 5/25/2007 00:22'!
testSerialization
| item json |
item _ OBWebMenuItem
label: 'test'
target: self
selector: #yourself.
json _ String streamContents: [:stream | item jsonWriteOn: stream].
self assert: json = '{"label": "test", "isEnabled": true}'! !
TestCase subclass: #OBWebMenuTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBWebMenuTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/8/2007 01:16'!
testAddSubmenu
| menu submenu actual expected |
menu _ OBWebMenu seed: 3559543.
submenu _ menu addSubmenu: 'submenu' enabled: true.
submenu initializeWithId: (OBWebIdentifier seed: 3559543).
submenu add: 'test' target: self selector: #yourself.
actual _ String streamContents: [:s | menu jsonWriteOn: s].
expected _ '{"id": "w9cq4xll13c3bh4r1fn31lvsgr", "items": [{"label": "submenu", "isEnabled": true}]}'.
self assert: actual = expected! !
!OBWebMenuTest methodsFor: 'as yet unclassified' stamp: 'cwp 6/1/2007 14:40'!
testSerialization
| menu json |
menu _ OBWebMenu seed: 3559543.
menu add: 'test' target: self selector: #yourself.
json _ String streamContents: [:s | menu jsonWriteOn: s].
self assert: json = '{"id": "w9cq4xll13c3bh4r1fn31lvsgr", "items": [{"label": "test", "isEnabled": true}]}'! !
TestCase subclass: #OBWebScrollerTest
instanceVariableNames: 'columns'
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBWebScrollerTest methodsFor: 'as yet unclassified' stamp: 'cwp 5/27/2007 20:28'!
announcer
^ OBAnnouncer new! !
!OBWebScrollerTest methodsFor: 'as yet unclassified' stamp: 'cwp 7/25/2007 23:46'!
buildScroller
| builder |
builder := OBWebBuilder new.
^builder scroller: self with: [columns do: [:ea | ea buildOn: builder]]! !
!OBWebScrollerTest methodsFor: 'as yet unclassified' stamp: 'cwp 5/27/2007 20:32'!
columns
^ columns! !
!OBWebScrollerTest methodsFor: 'as yet unclassified' stamp: 'cwp 6/1/2007 14:36'!
sizing
^ columns size! !
!OBWebScrollerTest methodsFor: 'as yet unclassified' stamp: 'cwp 6/1/2007 16:57'!
testPushPane
| scroller request |
columns _ OrderedCollection new.
3 timesRepeat: [columns add: (OBColumn inPanel: self)].
scroller _ self buildScroller.
columns add: (OBColumn inPanel: self).
[self changed: #columns]
on: OBInteractionRequest
do: [:req | request _ req].
self assert: (request isKindOf: OBAjaxResponse).
self assert: request message selector = 'push'.
self assert: scroller children size = 4.! !
TestCase subclass: #OBWebTextTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBWebTextTest methodsFor: 'as yet unclassified' stamp: 'cwp 6/18/2007 19:18'!
createText
| widget |
widget _ OBWebText
id: (OBWebIdentifier random: (Random seed: 43222))
model: self.
[widget update: #text]
on: OBAjaxResponse
do: [:response].
^ widget! !
!OBWebTextTest methodsFor: 'as yet unclassified' stamp: 'cwp 7/14/2007 00:16'!
test01InitializesWithTextAndSelection
| text init |
text _ self createText.
init _ String streamContents: [:s | text jsInitializeOn: s].
self assert: init = 'Widget.get("wan18u9s6ubfe77f1ug6yo74uv").init({"text": "This is a test", "bold": false}); '! !
!OBWebTextTest methodsFor: 'emulating' stamp: 'cwp 5/21/2007 00:28'!
text
^ 'This is a test'! !
TestCase subclass: #OBWebWindowTest
instanceVariableNames: 'id'
classVariableNames: ''
poolDictionaries: ''
category: 'OB-Tests-Web'!
!OBWebWindowTest methodsFor: 'emulating' stamp: 'cwp 10/25/2006 19:06'!
addWithAllChildrenTo: anIdentityDictionary
anIdentityDictionary at: self identifier put: self! !
!OBWebWindowTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/25/2006 12:15'!
createWidget
^ OBWebWindow
id: (OBWebIdentifier random: (Random seed: 43222))
model: self! !
!OBWebWindowTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/25/2006 13:52'!
id
^ id! !
!OBWebWindowTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/25/2006 13:52'!
identifier
^ id printString! !
!OBWebWindowTest methodsFor: 'as yet unclassified' stamp: 'cwp 10/25/2006 18:53'!
setUp
id _ OBWebIdentifier seed: 44355.
! !
!OBWebWindowTest methodsFor: 'as yet unclassified' stamp: 'cwp 5/31/2007 21:01'!
test01InitializesWithWidgetInit
| list init |
list _ self createWidget.
init _ String streamContents: [:s | list jsInitializeOn: s].
self assert: init = 'Widget.init("wan18u9s6ubfe77f1ug6yo74uv"); '! !