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: 'lr 11/7/2009 18:32'!
tests01BrowserCreatesWindow
| widget |
widget := self buildWindow.
self assert: (widget isKindOf: OBWebWindow).
self assert: widget model == model! !
!OBWebBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
tests03ColumnPanelAddsColumns
| widget |
widget := self buildNavigationPanel.
self assert: widget children size = 4.
widget children do: [ :ea | self assert: (ea isKindOf: OBWebPane) ]! !
!OBWebBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'!
tests04ColumnAddsList
| pane |
pane := self build: self columnWithFilter.
self assert: (pane isKindOf: OBWebPane).
self assert: (pane children first isKindOf: OBWebList)! !
!OBWebBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
test01ArgumentsCanBeExplicit
| message |
message := OBAjaxMessage receiver: 'abc'
selector: #test:with:
arguments: #(#a #b).
self assert: message arguments = #(#a #b)! !
!OBAjaxMessageTest methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
test01EmptyWindow
| widget |
widget := OBWebWindow id: self id
model: self.
self assert: widget contents = self expectedWindowHtml! !
!OBHtmlGenerationTest methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
testEscapeValue
| escapeVal |
escapeVal := OBSubcomputation do:
[ :subcomp |
subcomp escape: [ :k | 1 ].
2 ].
self assert: escapeVal = 1! !
!OBSubcontinuationTest methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
testSimpleCallSC
| continuation |
OBSubcomputation do: [ :subcomp | subcomp escape: [ :k | continuation := k ] ].
self assert: (continuation value: true)! !
!OBSubcontinuationTest methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
setUp
hasIcons := true! !
!OBWebListTest methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
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: 'lr 11/7/2009 18:32'!
setUp
id := OBWebIdentifier seed: 44355! !
!OBWebWindowTest methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'!
test01InitializesWithWidgetInit
| list init |
list := self createWidget.
init := String streamContents: [ :s | list jsInitializeOn: s ].
self assert: init = 'Widget.init("wan18u9s6ubfe77f1ug6yo74uv"); '! !