browser

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 10/8/2010 10:48'! testMethodTemps "This test demonstrates that the temps in #doSubcomp1: are restored each time the subcontinuation is evaluated." self flag: 'This test fails due to true closure semantics.' " | 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"); '! !