Squeak-dev June 2015

squeak-dev@lists.squeakfoundation.org

35 participants
162 discussions

Squeak 4.6: WebClient-HTTP-topa.2.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of WebClient-HTTP to project Squeak 4.6: http://source.squeak.org/squeak46/WebClient-HTTP-topa.2.mcz ==================== Summary ==================== Name: WebClient-HTTP-topa.2 Author: topa Time: 20 April 2015, 2:36:49.456 pm UUID: c28c613c-a2f9-443b-a431-191aff2b96ca Ancestors: WebClient-HTTP-ar.1 Fix for missing CrLf global ==================== Snapshot ==================== ----- Method: HTTPSocket class>>httpGet:args:user:passwd: (in category '*WebClient-HTTP-override') ----- httpGet: url args: args user: user passwd: passwd "Upload the contents of the stream to a file on the server. WARNING: This method will send a basic auth header proactively. This is necessary to avoid breaking MC and SqueakSource since SS does not return a 401 when accessing a private (global no access) repository." | urlString xhdrs client resp progress | "Normalize the url" urlString := (Url absoluteFromText: url) asString. "Some raw extra headers which historically have been added" xhdrs := HTTPProxyCredentials, HTTPBlabEmail. "may be empty" client := WebClient new. client username: user; password: passwd. ^[resp := client httpGet: urlString do:[:req| "HACK: Proactively send a basic auth header. See comment above." req headerAt: 'Authorization' put: 'Basic ', (user, ':', passwd) base64Encoded. "Accept anything" req addHeader: 'Accept' value: '*/*'. "Add the additional headers" (WebUtils readHeadersFrom: xhdrs readStream) do:[:assoc| req addHeader: assoc key value: assoc value]]. progress := [:total :amount| (HTTPProgress new) total: total; amount: amount; signal: 'Downloading...' ]. "Simulate old HTTPSocket return behavior" (resp code between: 200 and: 299) ifTrue:[^(RWBinaryOrTextStream with: (resp contentWithProgress: progress)) reset] ifFalse:[resp asString, resp content]. ] ensure:[client destroy]. ! ----- Method: HTTPSocket class>>httpGetDocument:args:accept:request: (in category '*WebClient-HTTP-override') ----- httpGetDocument: url args: args accept: mimeType request: requestString "Return the exact contents of a web object. Asks for the given MIME type. If mimeType is nil, use 'text/html'. An extra requestString may be submitted and must end with crlf. The parsed header is saved. Use a proxy server if one has been registered. tk 7/23/97 17:12" "Note: To fetch raw data, you can use the MIME type 'application/octet-stream'." | client xhdrs resp urlString progress | "Normalize the url" urlString := (Url absoluteFromText: url) asString. args ifNotNil: [ urlString := urlString, (self argString: args) ]. "Some raw extra headers which historically have been added" xhdrs := HTTPProxyCredentials, HTTPBlabEmail, "may be empty" requestString. "extra user request. Authorization" client := WebClient new. ^[resp := client httpGet: urlString do:[:req| "Add ACCEPT header" mimeType ifNotNil:[req headerAt: 'Accept' put: mimeType]. "Always accept plain text" req addHeader: 'Accept' value: 'text/html'. "Add the additional headers" (WebUtils readHeadersFrom: xhdrs readStream) do:[:assoc| req addHeader: assoc key value: assoc value]]. progress := [:total :amount| (HTTPProgress new) total: total; amount: amount; signal: 'Downloading...' ]. "Simulate old HTTPSocket return behavior" (resp code between: 200 and: 299) ifTrue:[MIMEDocument contentType: resp contentType content: (resp contentWithProgress: progress) url: url] ifFalse:[resp asString, resp content]. ] ensure:[client destroy]. ! ----- Method: HTTPSocket class>>httpPost:args:user:passwd: (in category '*WebClient-HTTP-override') ----- httpPost: url args: args user: user passwd: passwd "WARNING: This method will send a basic auth header proactively. This is necessary to avoid breaking MC and SqueakSource since SS does not return a 401 when accessing a private (global no access) repository." | argString xhdrs client resp urlString | "Normalize the url" urlString := (Url absoluteFromText: url) asString. args ifNotNil: [ argString := self argString: args. argString first = $? ifTrue: [argString := argString allButFirst]. ]. "Some raw extra headers which historically have been added" xhdrs := HTTPProxyCredentials, HTTPBlabEmail. "may be empty" client := WebClient new. client username: (user ifEmpty:[nil]); password: (passwd ifEmpty:[nil]). ^[resp := client httpPost: urlString content: (argString ifNil:['']) type: 'application/x-www-form-urlencoded' do:[:req| "HACK: Proactively send a basic auth header. See comment above." req headerAt: 'Authorization' put: 'Basic ', (user, ':', passwd) base64Encoded. "Accept anything" req addHeader: 'Accept' value: '*/*'. "Add the additional headers" (WebUtils readHeadersFrom: xhdrs readStream) do:[:assoc| req addHeader: assoc key value: assoc value]]. "Simulate old HTTPSocket return behavior" (resp code between: 200 and: 299) ifTrue:[MIMEDocument contentType: resp contentType content: resp content url: url] ifFalse:[resp asString, resp content]. ] ensure:[client destroy]. ! ----- Method: HTTPSocket class>>httpPost:content:type:accept:request: (in category '*WebClient-HTTP-override') ----- httpPost: url content: postData type: contentType accept: mimeType request: requestString "like httpGET, except it does a POST instead of a GET. POST allows data to be uploaded" | urlString xhdrs client resp | "Normalize the url" urlString := (Url absoluteFromText: url) asString. "Some raw extra headers which historically have been added" xhdrs := HTTPProxyCredentials, HTTPBlabEmail, "may be empty" requestString. "extra user request. Authorization" client := WebClient new. ^[resp := client httpPost: urlString content: (postData ifNil:['']) type: contentType do:[:req| "Add ACCEPT header" mimeType ifNotNil:[req headerAt: 'Accept' put: mimeType]. "Always accept plain text" req addHeader: 'Accept' value: 'text/html'. "Add the additional headers" (WebUtils readHeadersFrom: xhdrs readStream) do:[:assoc| req addHeader: assoc key value: assoc value]]. "Simulate old HTTPSocket return behavior" (resp code between: 200 and: 299) ifTrue:[MIMEDocument contentType: resp contentType content: resp content url: url] ifFalse:[resp asString, resp content]. ] ensure:[client destroy]. ! ----- Method: HTTPSocket class>>httpPostDocument:args:accept:request: (in category '*WebClient-HTTP-override') ----- httpPostDocument: url args: args accept: mimeType request: requestString "like httpGET, except it does a POST instead of a GET. POST allows data to be uploaded" | argString | args ifNotNil: [ argString := self argString: args. argString first = $? ifTrue: [argString := argString allButFirst]. ]. ^self httpPost: url content: argString type: 'application/x-www-form-urlencoded' accept: mimeType request: requestString! ----- Method: HTTPSocket class>>httpPostMultipart:args:accept:request: (in category '*WebClient-HTTP-override') ----- httpPostMultipart: url args: argsDict accept: mimeType request: requestString " do multipart/form-data encoding rather than x-www-urlencoded " | mimeBorder argsStream | mimeBorder := '----squeak-georgia-tech-', Time millisecondClockValue printString, '-csl-cool-stuff-----'. "encode the arguments dictionary" argsStream := WriteStream on: String new. argsDict associationsDo: [:assoc | assoc value do: [ :value | | fieldValue | "print the boundary" argsStream nextPutAll: '--', mimeBorder; crlf. " check if it's a non-text field " argsStream nextPutAll: 'Content-disposition: multipart/form-data; name="', assoc key, '"'. (value isKindOf: MIMEDocument) ifFalse: [fieldValue := value] ifTrue: [ argsStream nextPutAll: ' filename="'; nextPutAll: value url pathForFile; nextPut: $"; crlf; nextPutAll: 'Content-Type: '; nextPutAll: value contentType. fieldValue := (value content ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile] ifNotNil: [value content]) asString]. " Transcript show: 'field=', key, '; value=', fieldValue; cr. " argsStream crlf; crlf; nextPutAll: fieldValue; crlf ]]. argsStream nextPutAll: '--', mimeBorder, '--'. ^self httpPost: url content: argsStream contents type: 'multipart/form-data; boundary=', mimeBorder accept: mimeType request: requestString ! ----- Method: HTTPSocket class>>httpPostToSuperSwiki:args:accept:request: (in category '*WebClient-HTTP-override') ----- httpPostToSuperSwiki: url args: argsDict accept: mimeType request: requestString | mimeBorder argString | mimeBorder := '---------SuperSwiki',Time millisecondClockValue printString,'-----'. argString := String streamContents: [ :strm | strm nextPutAll: mimeBorder; crlf. argsDict associationsDo: [:assoc | assoc value do: [ :value | strm nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'; crlf; crlf; nextPutAll: value; crlf; crlf; nextPutAll: mimeBorder; crlf. ] ]. ]. ^self httpPost: url content: argString type: 'multipart/form-data; boundary=', mimeBorder accept: mimeType request: requestString ! ----- Method: HTTPSocket class>>httpPut:to:user:passwd: (in category '*WebClient-HTTP-override') ----- httpPut: contents to: url user: user passwd: passwd "Upload the contents of the stream to a file on the server WARNING: This method will send a basic auth header proactively. This is necessary to avoid breaking MC and SqueakSource since SS does not return a 401 when accessing a private (global no access) repository." | urlString xhdrs client resp | "Normalize the url" urlString := (Url absoluteFromText: url) asString. "Some raw extra headers which historically have been added" xhdrs := HTTPProxyCredentials, HTTPBlabEmail. "may be empty" client := WebClient new. client username: (user ifEmpty:[nil]); password: (passwd ifEmpty:[nil]). ^[resp := client httpPut: urlString content: contents type: nil do:[:req| "HACK: Proactively send a basic auth header. See comment above." req headerAt: 'Authorization' put: 'Basic ', (user, ':', passwd) base64Encoded. "Accept anything" req addHeader: 'Accept' value: '*/*'. "Add the additional headers" (WebUtils readHeadersFrom: xhdrs readStream) do:[:assoc| req addHeader: assoc key value: assoc value]]. "Simulate old HTTPSocket return behavior" resp asString, resp content ] ensure:[client destroy]. !

1 0

Squeak 4.6: ToolBuilder-Tests-cmm.1.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of ToolBuilder-Tests to project Squeak 4.6: http://source.squeak.org/squeak46/ToolBuilder-Tests-cmm.1.mcz ==================== Summary ==================== Name: ToolBuilder-Tests-cmm.1 Author: cmm Time: 15 December 2013, 4:25:47.507 pm UUID: e77685b9-ca09-40c0-b84e-6caee75f4075 Ancestors: ToolBuilder-Tests contains the specification that a compliant ToolBuilder must fulfill, together with the unit tests for ToolBuilder-Kernel. ==================== Snapshot ==================== SystemOrganization addCategory: #'ToolBuilder-Tests'! TestCase subclass: #PluggableMenuItemSpecTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Tests'! ----- Method: PluggableMenuItemSpecTests>>testBeCheckableMakesItemCheckable (in category 'as yet unclassified') ----- testBeCheckableMakesItemCheckable | itemSpec | itemSpec := PluggableMenuItemSpec new. itemSpec beCheckable. self assert: itemSpec isCheckable description: 'Item not checkable'.! ----- Method: PluggableMenuItemSpecTests>>testByDefaultNotCheckable (in category 'as yet unclassified') ----- testByDefaultNotCheckable | itemSpec | itemSpec := PluggableMenuItemSpec new. self deny: itemSpec isCheckable.! ----- Method: PluggableMenuItemSpecTests>>testNoMarkerMakesItemChecked (in category 'as yet unclassified') ----- testNoMarkerMakesItemChecked | itemSpec | itemSpec := PluggableMenuItemSpec new. itemSpec label: '<no>no'. itemSpec analyzeLabel. self assert: itemSpec isCheckable description: 'item not checkable'. self deny: itemSpec checked description: 'item checked'.! ----- Method: PluggableMenuItemSpecTests>>testOffMarkerMakesItemChecked (in category 'as yet unclassified') ----- testOffMarkerMakesItemChecked | itemSpec | itemSpec := PluggableMenuItemSpec new. itemSpec label: '<off>off'. itemSpec analyzeLabel. self assert: itemSpec isCheckable description: 'item not checkable'. self deny: itemSpec checked description: 'item checked'.! ----- Method: PluggableMenuItemSpecTests>>testOnMarkerMakesItemChecked (in category 'as yet unclassified') ----- testOnMarkerMakesItemChecked | itemSpec | itemSpec := PluggableMenuItemSpec new. itemSpec label: '<on>on'. itemSpec analyzeLabel. self assert: itemSpec isCheckable description: 'item not checkable'. self assert: itemSpec isCheckable description: 'item not checked'.! ----- Method: PluggableMenuItemSpecTests>>testYesMarkerMakesItemChecked (in category 'as yet unclassified') ----- testYesMarkerMakesItemChecked | itemSpec | itemSpec := PluggableMenuItemSpec new. itemSpec label: '<yes>on'. itemSpec analyzeLabel. self assert: itemSpec isCheckable description: 'item not checkable'. self assert: itemSpec isCheckable description: 'item not checked'.! TestCase subclass: #ToolBuilderTests instanceVariableNames: 'builder widget queries' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Tests'! !ToolBuilderTests commentStamp: 'ar 2/11/2005 15:01' prior: 0! Some tests to make sure ToolBuilder does what it says.! ----- Method: ToolBuilderTests class>>isAbstract (in category 'testing') ----- isAbstract ^self == ToolBuilderTests! ----- Method: ToolBuilderTests>>acceptWidgetText (in category 'support') ----- acceptWidgetText "accept text in widget" ^ self subclassResponsibility! ----- Method: ToolBuilderTests>>assertItemFiresWith: (in category 'tests-menus') ----- assertItemFiresWith: aBlock | spec | spec := builder pluggableMenuSpec new. spec model: self. aBlock value: spec. widget := builder build: spec. queries := IdentitySet new. self fireMenuItemWidget. self assert: (queries includes: #fireMenuAction)! ----- Method: ToolBuilderTests>>buttonWidgetEnabled (in category 'support') ----- buttonWidgetEnabled "Answer whether the current widget (a button) is currently enabled" ^ widget getModelState! ----- Method: ToolBuilderTests>>changeListWidget (in category 'support') ----- changeListWidget "Change the list widget's selection index" self subclassResponsibility! ----- Method: ToolBuilderTests>>expectedButtonSideEffects (in category 'support') ----- expectedButtonSideEffects "side effect queries we expect to see on buttons" ^#()! ----- Method: ToolBuilderTests>>fireButton (in category 'tests-button') ----- fireButton queries add: #fireButton.! ----- Method: ToolBuilderTests>>fireButtonWidget (in category 'support') ----- fireButtonWidget "Fire the widget, e.g., perform what is needed for the guy to trigger its action" self subclassResponsibility! ----- Method: ToolBuilderTests>>fireMenuAction (in category 'tests-menus') ----- fireMenuAction queries add: #fireMenuAction! ----- Method: ToolBuilderTests>>fireMenuItemWidget (in category 'tests-menus') ----- fireMenuItemWidget self subclassResponsibility! ----- Method: ToolBuilderTests>>getChildren (in category 'tests-panel') ----- getChildren queries add: #getChildren. ^#()! ----- Method: ToolBuilderTests>>getChildrenOf: (in category 'tests-trees') ----- getChildrenOf: item queries add: #getChildrenOf. ^(1 to: 9) asArray! ----- Method: ToolBuilderTests>>getColor (in category 'tests-text') ----- getColor queries add: #getColor. ^Color tan! ----- Method: ToolBuilderTests>>getEnabled (in category 'tests-button') ----- getEnabled queries add: #getEnabled. ^true! ----- Method: ToolBuilderTests>>getHelpOf: (in category 'tests-trees') ----- getHelpOf: item ^'help'! ----- Method: ToolBuilderTests>>getIconOf: (in category 'tests-trees') ----- getIconOf: item queries add: #getIconOf. ^nil! ----- Method: ToolBuilderTests>>getLabel (in category 'tests-button') ----- getLabel queries add: #getLabel. ^'TestLabel'! ----- Method: ToolBuilderTests>>getLabelOf: (in category 'tests-trees') ----- getLabelOf: item queries add: #getLabelOf. ^item asString! ----- Method: ToolBuilderTests>>getList (in category 'tests-lists') ----- getList queries add: #getList. ^(1 to: 100) collect:[:i| i printString].! ----- Method: ToolBuilderTests>>getListIndex (in category 'tests-lists') ----- getListIndex queries add: #getListIndex. ^13! ----- Method: ToolBuilderTests>>getListSelection (in category 'tests-lists') ----- getListSelection queries add: #getListSelection. ^'55'! ----- Method: ToolBuilderTests>>getMenu: (in category 'tests-lists') ----- getMenu: aMenu queries add: #getMenu. ^aMenu! ----- Method: ToolBuilderTests>>getRoots (in category 'tests-trees') ----- getRoots queries add: #getRoots. ^(1 to: 9) asArray! ----- Method: ToolBuilderTests>>getState (in category 'tests-button') ----- getState queries add: #getState. ^true! ----- Method: ToolBuilderTests>>getText (in category 'tests-text') ----- getText queries add: #getText. ^Text new! ----- Method: ToolBuilderTests>>getTextSelection (in category 'tests-text') ----- getTextSelection queries add: #getTextSelection. ^(1 to: 0)! ----- Method: ToolBuilderTests>>getTreeSelectionPath (in category 'tests-trees') ----- getTreeSelectionPath queries add: #getTreeSelectionPath. ^{2. 4. 3}! ----- Method: ToolBuilderTests>>hasChildren: (in category 'tests-trees') ----- hasChildren: item queries add: #hasChildren. ^true! ----- Method: ToolBuilderTests>>keyPress: (in category 'tests-lists') ----- keyPress: key queries add: #keyPress.! ----- Method: ToolBuilderTests>>makeButton (in category 'tests-button') ----- makeButton | spec | spec := self makeButtonSpec. widget := builder build: spec. ^widget! ----- Method: ToolBuilderTests>>makeButtonSpec (in category 'tests-button') ----- makeButtonSpec | spec | spec := builder pluggableButtonSpec new. spec name: #button. spec model: self. spec label: #getLabel. spec color: #getColor. spec state: #getState. spec enabled: #getEnabled. ^spec! ----- Method: ToolBuilderTests>>makeInputField (in category 'tests-input') ----- makeInputField | spec | spec := self makeInputFieldSpec. widget := builder build: spec.! ----- Method: ToolBuilderTests>>makeInputFieldSpec (in category 'tests-input') ----- makeInputFieldSpec | spec | spec := builder pluggableInputFieldSpec new. spec name: #input. spec model: self. spec getText: #getText. spec selection: #getTextSelection. spec color: #getColor. "<-- the following cannot be tested very well -->" spec setText: #setText:. spec menu: #getMenu:. ^spec! ----- Method: ToolBuilderTests>>makeItemList (in category 'tests-lists') ----- makeItemList | spec | spec := self makeItemListSpec. widget := builder build: spec.! ----- Method: ToolBuilderTests>>makeItemListSpec (in category 'tests-lists') ----- makeItemListSpec | spec | spec := builder pluggableListSpec new. spec name: #list. spec model: self. spec list: #getList. spec getSelected: #getListSelection. "<-- the following cannot be tested very well -->" spec setSelected: #setListSelection:. spec menu: #getMenu:. spec keyPress: #keyPress:. ^spec! ----- Method: ToolBuilderTests>>makeList (in category 'tests-lists') ----- makeList | spec | spec := self makeListSpec. widget := builder build: spec.! ----- Method: ToolBuilderTests>>makeListSpec (in category 'tests-lists') ----- makeListSpec | spec | spec := builder pluggableListSpec new. spec name: #list. spec model: self. spec list: #getList. spec getIndex: #getListIndex. "<-- the following cannot be tested very well -->" spec setIndex: #setListIndex:. spec menu: #getMenu:. spec keyPress: #keyPress:. ^spec! ----- Method: ToolBuilderTests>>makePanel (in category 'tests-panel') ----- makePanel | spec | spec := self makePanelSpec. widget := builder build: spec.! ----- Method: ToolBuilderTests>>makePanelSpec (in category 'tests-panel') ----- makePanelSpec | spec | spec := builder pluggablePanelSpec new. spec name: #panel. spec model: self. spec children: #getChildren. ^spec! ----- Method: ToolBuilderTests>>makeText (in category 'tests-text') ----- makeText | spec | spec := self makeTextSpec. widget := builder build: spec.! ----- Method: ToolBuilderTests>>makeTextSpec (in category 'tests-text') ----- makeTextSpec | spec | spec := builder pluggableTextSpec new. spec name: #text. spec model: self. spec getText: #getText. spec selection: #getTextSelection. spec color: #getColor. "<-- the following cannot be tested very well -->" spec setText: #setText:. spec menu: #getMenu:. ^spec! ----- Method: ToolBuilderTests>>makeTree (in category 'tests-trees') ----- makeTree | spec | spec := self makeTreeSpec. widget := builder build: spec.! ----- Method: ToolBuilderTests>>makeTreeSpec (in category 'tests-trees') ----- makeTreeSpec | spec | spec := builder pluggableTreeSpec new. spec name: #tree. spec model: self. spec roots: #getRoots. "<-- the following cannot be tested very well -->" spec getSelectedPath: #getTreeSelectionPath. spec getChildren: #getChildrenOf:. spec hasChildren: #hasChildren:. spec label: #getLabelOf:. spec icon: #getIconOf:. spec help: #getHelpOf:. spec setSelected: #setTreeSelection:. spec menu: #getMenu:. spec keyPress: #keyPress:. ^spec! ----- Method: ToolBuilderTests>>makeWindow (in category 'tests-window') ----- makeWindow | spec | spec := self makeWindowSpec. widget := builder build: spec.! ----- Method: ToolBuilderTests>>makeWindowSpec (in category 'tests-window') ----- makeWindowSpec | spec | spec := builder pluggableWindowSpec new. spec name: #window. spec model: self. spec children: #getChildren. spec label: #getLabel. spec closeAction: #noteWindowClosed. ^spec! ----- Method: ToolBuilderTests>>noteWindowClosed (in category 'tests-window') ----- noteWindowClosed queries add: #noteWindowClosed.! ----- Method: ToolBuilderTests>>openWindow (in category 'tests-window') ----- openWindow | spec | spec := self makeWindowSpec. widget := builder open: spec.! ----- Method: ToolBuilderTests>>returnFalse (in category 'support') ----- returnFalse ^false! ----- Method: ToolBuilderTests>>returnTrue (in category 'support') ----- returnTrue ^true! ----- Method: ToolBuilderTests>>setListIndex: (in category 'tests-lists') ----- setListIndex: index queries add: #setListIndex.! ----- Method: ToolBuilderTests>>setListSelection: (in category 'tests-lists') ----- setListSelection: newIndex queries add: #setListSelection.! ----- Method: ToolBuilderTests>>setText: (in category 'tests-text') ----- setText: newText queries add: #setText. ^false! ----- Method: ToolBuilderTests>>setTreeSelection: (in category 'tests-trees') ----- setTreeSelection: node queries add: #setTreeSelection.! ----- Method: ToolBuilderTests>>setUp (in category 'support') ----- setUp queries := IdentitySet new.! ----- Method: ToolBuilderTests>>shutDown (in category 'support') ----- shutDown self myDependents: nil! ----- Method: ToolBuilderTests>>testAddTargetSelectorArgumentList (in category 'tests-menus') ----- testAddTargetSelectorArgumentList self assertItemFiresWith: [:spec | spec add: 'Menu Item' target: self selector: #fireMenuAction argumentList: #()]! ----- Method: ToolBuilderTests>>testButtonFiresBlock (in category 'tests-button') ----- testButtonFiresBlock | spec | spec := builder pluggableButtonSpec new. spec model: self. spec action: [self fireButton]. widget := builder build: spec. queries := IdentitySet new. self fireButtonWidget. self assert: (queries includes: #fireButton).! ----- Method: ToolBuilderTests>>testButtonFiresMessage (in category 'tests-button') ----- testButtonFiresMessage | spec | spec := builder pluggableButtonSpec new. spec model: self. spec action: (MessageSend receiver: self selector: #fireButton arguments: #()). widget := builder build: spec. queries := IdentitySet new. self fireButtonWidget. self assert: (queries includes: #fireButton).! ----- Method: ToolBuilderTests>>testButtonFiresSymbol (in category 'tests-button') ----- testButtonFiresSymbol | spec | spec := builder pluggableButtonSpec new. spec model: self. spec action: #fireButton. widget := builder build: spec. queries := IdentitySet new. self fireButtonWidget. self assert: (queries includes: #fireButton).! ----- Method: ToolBuilderTests>>testButtonInitiallyDisabled (in category 'tests-button') ----- testButtonInitiallyDisabled | spec | spec := builder pluggableButtonSpec new. spec model: self. spec label: #getLabel. spec color: #getColor. spec state: #getState. spec enabled: #returnFalse. widget := builder build: spec. self deny: (self buttonWidgetEnabled)! ----- Method: ToolBuilderTests>>testButtonInitiallyDisabledSelector (in category 'tests-button') ----- testButtonInitiallyDisabledSelector | spec | spec := builder pluggableButtonSpec new. spec model: self. spec label: #getLabel. spec color: #getColor. spec state: #getState. spec enabled: #returnFalse. widget := builder build: spec. self deny: (self buttonWidgetEnabled)! ----- Method: ToolBuilderTests>>testButtonInitiallyEnabled (in category 'tests-button') ----- testButtonInitiallyEnabled | spec | spec := builder pluggableButtonSpec new. spec model: self. spec label: #getLabel. spec color: #getColor. spec state: #getState. spec enabled: #returnTrue. widget := builder build: spec. self assert: (self buttonWidgetEnabled)! ----- Method: ToolBuilderTests>>testButtonInitiallyEnabledSelector (in category 'tests-button') ----- testButtonInitiallyEnabledSelector | spec | spec := builder pluggableButtonSpec new. spec model: self. spec label: #getLabel. spec color: #getColor. spec state: #getState. spec enabled: #returnTrue. widget := builder build: spec. self assert: (self buttonWidgetEnabled)! ----- Method: ToolBuilderTests>>testButtonWidgetID (in category 'tests-button') ----- testButtonWidgetID self makeButton. self assert: (builder widgetAt: #button) == widget.! ----- Method: ToolBuilderTests>>testGetButtonColor (in category 'tests-button') ----- testGetButtonColor self makeButton. queries := IdentitySet new. self changed: #getColor. self assert: (queries includes: #getColor). self assert: self widgetColor = self getColor.! ----- Method: ToolBuilderTests>>testGetButtonEnabled (in category 'tests-button') ----- testGetButtonEnabled self makeButton. queries := IdentitySet new. self changed: #getEnabled. self assert: (queries includes: #getEnabled).! ----- Method: ToolBuilderTests>>testGetButtonLabel (in category 'tests-button') ----- testGetButtonLabel self makeButton. queries := IdentitySet new. self changed: #getLabel. self assert: (queries includes: #getLabel).! ----- Method: ToolBuilderTests>>testGetButtonSideEffects (in category 'tests-button') ----- testGetButtonSideEffects self makeButton. queries := IdentitySet new. self changed: #testSignalWithNoDiscernableEffect. self expectedButtonSideEffects do:[:sym| self assert: (queries includes: sym). queries remove: sym. ]. self assert: queries isEmpty.! ----- Method: ToolBuilderTests>>testGetButtonState (in category 'tests-button') ----- testGetButtonState self makeButton. queries := IdentitySet new. self changed: #getState. self assert: (queries includes: #getState).! ----- Method: ToolBuilderTests>>testGetInputFieldColor (in category 'tests-input') ----- testGetInputFieldColor self makeInputField. queries := IdentitySet new. self changed: #getColor. self assert: (queries includes: #getColor). self assert: self widgetColor = self getColor.! ----- Method: ToolBuilderTests>>testGetInputFieldSelection (in category 'tests-input') ----- testGetInputFieldSelection self makeInputField. queries := IdentitySet new. self changed: #getTextSelection. self assert: (queries includes: #getTextSelection).! ----- Method: ToolBuilderTests>>testGetInputFieldSideEffectFree (in category 'tests-input') ----- testGetInputFieldSideEffectFree self makeInputField. queries := IdentitySet new. self changed: #testSignalWithNoDiscernableEffect. self assert: queries isEmpty.! ----- Method: ToolBuilderTests>>testGetInputFieldText (in category 'tests-input') ----- testGetInputFieldText self makeInputField. queries := IdentitySet new. self changed: #getText. self assert: (queries includes: #getText).! ----- Method: ToolBuilderTests>>testGetItemListSideEffectFree (in category 'tests-lists') ----- testGetItemListSideEffectFree self makeItemList. queries := IdentitySet new. self changed: #testSignalWithNoDiscernableEffect. self assert: queries isEmpty.! ----- Method: ToolBuilderTests>>testGetList (in category 'tests-lists') ----- testGetList self makeList. queries := IdentitySet new. self changed: #getList. self assert: (queries includes: #getList).! ----- Method: ToolBuilderTests>>testGetListIndex (in category 'tests-lists') ----- testGetListIndex self makeList. queries := IdentitySet new. self changed: #getListIndex. self assert: (queries includes: #getListIndex).! ----- Method: ToolBuilderTests>>testGetListSelection (in category 'tests-lists') ----- testGetListSelection self makeItemList. queries := IdentitySet new. self changed: #getListSelection. self assert: (queries includes: #getListSelection).! ----- Method: ToolBuilderTests>>testGetListSideEffectFree (in category 'tests-lists') ----- testGetListSideEffectFree self makeList. queries := IdentitySet new. self changed: #testSignalWithNoDiscernableEffect. self assert: queries isEmpty.! ----- Method: ToolBuilderTests>>testGetPanelChildren (in category 'tests-panel') ----- testGetPanelChildren self makePanel. queries := IdentitySet new. self changed: #getChildren. self assert: (queries includes: #getChildren).! ----- Method: ToolBuilderTests>>testGetPanelSideEffectFree (in category 'tests-panel') ----- testGetPanelSideEffectFree self makePanel. queries := IdentitySet new. self changed: #testSignalWithNoDiscernableEffect. self assert: queries isEmpty.! ----- Method: ToolBuilderTests>>testGetText (in category 'tests-text') ----- testGetText self makeText. queries := IdentitySet new. self changed: #getText. self assert: (queries includes: #getText).! ----- Method: ToolBuilderTests>>testGetTextColor (in category 'tests-text') ----- testGetTextColor self makeText. queries := IdentitySet new. self changed: #getColor. self assert: (queries includes: #getColor). self assert: self widgetColor = self getColor.! ----- Method: ToolBuilderTests>>testGetTextSelection (in category 'tests-text') ----- testGetTextSelection self makeText. queries := IdentitySet new. self changed: #getTextSelection. self assert: (queries includes: #getTextSelection).! ----- Method: ToolBuilderTests>>testGetTextSideEffectFree (in category 'tests-text') ----- testGetTextSideEffectFree self makeText. queries := IdentitySet new. self changed: #testSignalWithNoDiscernableEffect. self assert: queries isEmpty.! ----- Method: ToolBuilderTests>>testGetWindowChildren (in category 'tests-window') ----- testGetWindowChildren self makeWindow. queries := IdentitySet new. self changed: #getChildren. self assert: (queries includes: #getChildren).! ----- Method: ToolBuilderTests>>testGetWindowLabel (in category 'tests-window') ----- testGetWindowLabel self makeWindow. queries := IdentitySet new. self changed: #getLabel. self assert: (queries includes: #getLabel).! ----- Method: ToolBuilderTests>>testGetWindowSideEffectFree (in category 'tests-window') ----- testGetWindowSideEffectFree self makeWindow. queries := IdentitySet new. self changed: #testSignalWithNoDiscernableEffect. self assert: queries isEmpty.! ----- Method: ToolBuilderTests>>testInputWidgetID (in category 'tests-input') ----- testInputWidgetID self makeInputField. self assert: (builder widgetAt: #input) == widget.! ----- Method: ToolBuilderTests>>testItemListWidgetID (in category 'tests-lists') ----- testItemListWidgetID self makeItemList. self assert: (builder widgetAt: #list) == widget.! ----- Method: ToolBuilderTests>>testListWidgetID (in category 'tests-lists') ----- testListWidgetID self makeList. self assert: (builder widgetAt: #list) == widget.! ----- Method: ToolBuilderTests>>testPanelWidgetID (in category 'tests-panel') ----- testPanelWidgetID self makePanel. self assert: (builder widgetAt: #panel) == widget.! ----- Method: ToolBuilderTests>>testSetInputField (in category 'tests-input') ----- testSetInputField self makeInputField. queries := IdentitySet new. self acceptWidgetText. self assert: (queries includes: #setText).! ----- Method: ToolBuilderTests>>testSetListIndex (in category 'tests-lists') ----- testSetListIndex self makeList. queries := IdentitySet new. self changeListWidget. self assert: (queries includes: #setListIndex).! ----- Method: ToolBuilderTests>>testSetListSelection (in category 'tests-lists') ----- testSetListSelection self makeItemList. queries := IdentitySet new. self changeListWidget. self assert: (queries includes: #setListSelection).! ----- Method: ToolBuilderTests>>testSetText (in category 'tests-text') ----- testSetText self makeText. queries := IdentitySet new. self acceptWidgetText. self assert: (queries includes: #setText).! ----- Method: ToolBuilderTests>>testTextWidgetID (in category 'tests-text') ----- testTextWidgetID self makeText. self assert: (builder widgetAt: #text) == widget! ----- Method: ToolBuilderTests>>testTreeExpandPath (in category 'tests-trees') ----- testTreeExpandPath "@@@@: REMOVE THIS - it's a hack (changed: #openPath)" self makeTree. queries := IdentitySet new. self changed: {#openPath. '4'. '2'. '3'}. self waitTick. self assert: (queries includes: #getChildrenOf). self assert: (queries includes: #setTreeSelection). self assert: (queries includes: #getLabelOf). ! ----- Method: ToolBuilderTests>>testTreeExpandPathFirst (in category 'tests-trees') ----- testTreeExpandPathFirst "@@@@: REMOVE THIS - it's a hack (changed: #openPath)" self makeTree. queries := IdentitySet new. self changed: {#openPath. '1'. '2'. '2'}. self waitTick. self assert: (queries includes: #getChildrenOf). self assert: (queries includes: #setTreeSelection). self assert: (queries includes: #getLabelOf). ! ----- Method: ToolBuilderTests>>testTreeGetSelectionPath (in category 'tests-trees') ----- testTreeGetSelectionPath self makeTree. queries := IdentitySet new. self changed: #getTreeSelectionPath. self waitTick. self assert: (queries includes: #getTreeSelectionPath). self assert: (queries includes: #getChildrenOf). self assert: (queries includes: #setTreeSelection). ! ----- Method: ToolBuilderTests>>testTreeRoots (in category 'tests-trees') ----- testTreeRoots self makeTree. queries := IdentitySet new. self changed: #getRoots. self assert: (queries includes: #getRoots).! ----- Method: ToolBuilderTests>>testTreeWidgetID (in category 'tests-trees') ----- testTreeWidgetID self makeTree. self assert: (builder widgetAt: #tree) == widget.! ----- Method: ToolBuilderTests>>testWindowCloseAction (in category 'tests-window') ----- testWindowCloseAction self openWindow. builder close: widget. self assert: (queries includes: #noteWindowClosed).! ----- Method: ToolBuilderTests>>testWindowID (in category 'tests-window') ----- testWindowID self makeWindow. self assert: (builder widgetAt: #window) == widget.! ----- Method: ToolBuilderTests>>waitTick (in category 'support') ----- waitTick ^nil! ----- Method: ToolBuilderTests>>widgetColor (in category 'support') ----- widgetColor "Answer color from widget" self subclassResponsibility "NOTE: You can bail out if you don't know how to get the color from the widget: ^self getColor will work."!

1 0

Squeak 4.6: Help-Squeak-Project-kfr.24.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of Help-Squeak-Project to project Squeak 4.6: http://source.squeak.org/squeak46/Help-Squeak-Project-kfr.24.mcz ==================== Summary ==================== Name: Help-Squeak-Project-kfr.24 Author: kfr Time: 22 April 2015, 3:29:25.774 pm UUID: 62100bc2-19ca-f343-8b70-6725ba56064a Ancestors: Help-Squeak-Project-kfr.23 Changed around introduction in help a little ==================== Snapshot ==================== SystemOrganization addCategory: #'Help-Squeak-Project'! (PackageInfo named: 'Help-Squeak-Project') postscript: '| aForm aSecondForm | aForm := ScriptingSystem formAtKey: #Debugger1. aForm ifNil: [aForm := Form extent: 379@117 depth: 32 fromArray: #( 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4289502107 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4288651167 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294963134 4284684289 4278190089 4278190089 4278716433 4279773498 4283065212 4289054440 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294963134 4284684289 4278192186 4287420152 4294967295 4294965199 4286863939 4282534508 4289060607 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294963134 4284684289 4278190105 4282542972 4286280556 4283576601 4278714369 4278192170 4285249000 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294963134 4284684289 4278192186 4287420152 4294967295 4294963134 4284684289 4278192186 4287420152 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294963134 4284684289 4278192186 4287420152 4294967295 4294967272 4290081586 4278714369 4278729101 4292278271 4294967295 4294967280 4291730548 4283052313 4279240713 4279247162 4284122286 4292802559 4294967295 4294963134 4284684289 4278192186 4287420152 4294963134 4284684289 4278190089 4278190089 4278190089 4278196324 4290637823 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294963134 4284684289 4278192186 4287420152 4294967295 4294967295 4294958749 4282519553 4278194251 4289060607 4294967287 4292254795 4279762945 4278196282 4284115820 4283574545 4278190089 4280904630 4293918719 4294963134 4284684289 4278192186 4287420152 4294965215 4289561691 4281403393 4278190105 4282542972 4286287022 4292802559 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 42...etc...! CustomHelp subclass: #SqueakHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! ----- Method: SqueakHelp class>>bookName (in category 'accessing') ----- bookName ^'Squeak'! ----- Method: SqueakHelp class>>icon (in category 'accessing') ----- icon (self name = #SqueakHelp) ifTrue: [^HelpIcons iconNamed: #squeakIcon]. ^nil! ----- Method: SqueakHelp class>>introduction (in category 'as yet unclassified') ----- introduction "This method was automatically generated. Edit it using:" "a HelpBrowser edit: #introduction" ^HelpTopic title: 'Welcome' contents: 'WELCOME Squeak is a modern, open source, full-featured implementation of the powerful Smalltalk programming language and environment. Squeak is highly-portable - even its virtual machine is written entirely in Smalltalk making it easy to debug, analyze, and change. Squeak is the vehicle for a wide range of projects from multimedia applications, educational platforms to commercial web application development.!! ]style[(7 2 6 72 9 41 6 70 9 49 6 139)bc000000000a0FBitstreamVeraSerif#20.0,c000000000,FBitstreamVeraSerif#16.0ba0c000000000,FBitstreamVeraSerif#16.0a0c000000000,FBitstreamVeraSerif#16.0ba0c000000000,FBitstreamVeraSerif#16.0a0c000000000,FBitstreamVeraSerif#16.0ba0c000000000,FBitstreamVeraSerif#16.0a0c000000000,FBitstreamVeraSerif#16.0ba0c000000000,FBitstreamVeraSerif#16.0a0c000000000,FBitstreamVeraSerif#16.0ba0c000000000,FBitstreamVeraSerif#16.0a0c000000000!!' readStream nextChunkText! ----- Method: SqueakHelp class>>pages (in category 'accessing') ----- pages ^#(introduction SqueakProjectHelp SqueakToolsHelp SqueakTutorials)! SqueakHelp subclass: #SqueakProjectHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! SqueakProjectHelp subclass: #SqueakLicenseHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! ----- Method: SqueakLicenseHelp class>>bookName (in category 'accessing') ----- bookName ^'License'! ----- Method: SqueakLicenseHelp class>>licenseChange (in category 'pages') ----- licenseChange ^HelpTopic title: 'License has changed with 4.0' contents: 'On 23 September 1996, Apple Computer Inc. released Squeak V1.1 under the "Squeak License" (SqL). On May 8, 2006 Apple agreed to relicense original Squeak V1.1 under the Apple Public Source License. On October 12, 2006 Apple granted permission to relicense under Apache license 2.0. In 2006, VPRI began to collect "Distribution Agreements" for all contributors to Squeak since V1.1 up to V3.8, asking them to relicense their contributions, which were originally licensed under SqL, to the MIT license. This was a great effort on behalf of many and VPRI has 100s of signed documents agreeing to this. Do you want to contribute source to Squeak?All new contributions since 4.0 must be under the MIT license. When you make your code available, please state explicitly in some form such as the description on a web site or email announcement that your contribution is under the MIT license. (It doesn''t have to be exclusive; you can release it under difference licenses at the same time.) Have you contributed source to Squeak? If you believe you have, but have not sent in an agreement to allow your submission(s) to be licensed under the MIT license then please see http://netjam.org/squeak/contributors. There you can find a list of known contributors and a PDF of the agreement with instructions. The snail mail address is found in the agreement PDF file. Also there are a few people for which we are lacking full contact information. If you think you can help please also visit the link above and see if you can identify any of the unknown developer initials or any of the developers for whom we do not have a current email address.' ! ----- Method: SqueakLicenseHelp class>>officialLicense (in category 'pages') ----- officialLicense ^HelpTopic title: 'Official License - 4.0' contents: 'Copyright (c) The individual, corporate, and institutional contributors who have collectively contributed elements to this software ("The Squeak Community"), 1996-2011 All rights reserved. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Portions of Squeak are covered by the following license Copyright (c) Xerox Corp. 1981, 1982 All rights reserved. Copyright (c) Apple Computer, Inc. 1985-1996 All rights reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.'! ----- Method: SqueakLicenseHelp class>>pages (in category 'accessing') ----- pages ^#(licenseChange officialLicense)! ----- Method: SqueakProjectHelp class>>bookName (in category 'accessing') ----- bookName ^'The Project'! ----- Method: SqueakProjectHelp class>>extendingTheSystem (in category 'pages') ----- extendingTheSystem ^HelpTopic title: 'Extending The System' icon: (HelpIcons iconNamed: #squeakIcon) contents: 'SqueakMap is an integrated catalog of external applications for Squeak. It is accessible from the "Apps" menu. This catalog does not host the projects, it merely documents the load scripts required to correctly bring them into the image. Many SqueakMap packages use Installer, which defines several packages in its package-definitions protocol. Any of these can be loaded with an expression like the following: Installer new merge: #openGL Change #openGL to the selector name of the package you want to load. The latest version of that package and all of its prerequisites will be merged into the image. Merging a package is no different from loading it unless the package is already loaded, in which case it is upgraded to the latest version in a way that preserves any local changes you may already have made. --------------- This remainder of this workspace documents load-scripts for packages that are not documented in either SqueakMap or Installer. OCompletion "Provides source code completion as you type" (Installer ss project: ''OCompletion'') install: ''Ocompletion''. (Smalltalk at: #ECToolSet) register. (Smalltalk at: #ToolSet) default: (Smalltalk at: #ECToolSet). Omnibrowser "Including Refactoring engine" (Installer ss project: ''MetacelloRepository'') install: ''ConfigurationOfOmniBrowser''. ((Smalltalk at: #ConfigurationOfOmniBrowser) project perform: #lastVersion) load: #( Dev ). Pier CMS "Pier CMS: http://www.piercms.com" (Installer ss project: ''MetacelloRepository'') install: ''ConfigurationOfPier2''. (Smalltalk at: #ConfigurationOfPier2) load. (Installer lukas project: ''pier2'') install: ''Pier-Blog''. (Installer lukas project: ''pier2'') install: ''Pier-Book''. (Installer lukas project: ''pier2addons'') install: ''Pier-Setup''. (Smalltalk at: #PRDistribution) new register. Open Cobalt "http://opencobalt.org (Best to run this from an image in an open cobalt directory)" Installer ss project: ''TweakCore''; install: ''update''. [Installer ss project: ''TweakExtras''; install: ''update''] on: (Smalltalk at: #CUnsynchronizedModification) do: [:ex | ex resume]. Installer cobalt project: ''Tweak''; answer: ''Would you like to conserve memory at all costs?'' with: true; answer: ''Password for interactive VNC connections?'' with: ''cobalt''; answer: ''Would you like to add the RFBServer to the World open menu?'' with: true; install: ''update'' !! ]style[(9 309 19 252 6 126 8 237 11 209 11 210 8 386 11 547)dSMLoaderPlus open;;,,d| newBrowser | newBrowser := Browser new selectSystemCategory: ''Installer-Core''; selectClass: Installer; metaClassIndicated: false; selectMessageCategoryNamed: ''package-definitions''; selectMessageNamed: #openGL. Browser openBrowserView: (newBrowser openMessageCatEditString: nil) label: ''External Package Definitions'';;,,i,,u,,bu,,bu,,bu,,bu,!!' readStream nextChunkText! ----- Method: SqueakProjectHelp class>>pages (in category 'accessing') ----- pages ^#(releaseNotes4point5 extendingTheSystem squeakResourcesOnline squeakUserInterface workingWithSqueak)! ----- Method: SqueakProjectHelp class>>releaseNotes4point5 (in category 'pages') ----- releaseNotes4point5 ^HelpTopic title: 'Squeak 4.5 Theodor' icon: (HelpIcons iconNamed: #squeakIcon) contents: 'Squeak 4.5 ---- Theodor =================== ______________________________________________ Language enhancements: Environments Environments allows multiple classes with the same name to exist in the same image, with code referencing through its class'' "environment". Collections New and improved sorting utilities for Arrays and OrderedCollections. New FloatCollection inherits the convenient add:/remove: API of OrderedCollection, but using an internal FloatArray for better efficiency. An all-new LRUCache implementation. Promise is now a fully chainable object with decent error handling. Compiler Numerics Faster and better Random. log/ln fixed for integers. Dates and Times New methods provide access to primitive 240 and 241, which can provide microsecond resolution timestamps on Cog VMs. New convenience methods allow creating DateAndTimes relative to now (e.g., "5 minutes ago"). Parsing improvements. Text, Graphics, Sound Form>pixelValueAt: now makes use of the new primitivePixelValueAt:, avoiding the overhead of a full BitBlt. Elimination of the dual hierarchy of NewParagraph & MultiNewParagraph etc and TextStopConditions and lots of Scanner improvements. PaintBoxMorph re-engineering. ADPCMCodec performance improvement. ______________________________________________ IDE, Monticello and Trunk process improvements: Several MVC fixes allow debugging in MVC once again. Smart-Splitters causes the bars between browser panes to automatically optimize their position. Fixed color-selection from anywhere on the screen working again. Improved command-line interface via Smalltalk run: [ :arg1 :arg2 | ... ]. squeakDebug.log report length is now settable. MCReorganizationPreloader now resolves moves between arbitrary packages, independent of their order in the configuration. mcz/snapshot/source.st now encoded in UTF8 instead of latin-1. New pre-selection highlight feature for lists. System space analysis now available in Help | About. Message-traces can be pared more easily. ______________________________________________ Configuration Lots of improvements in the CI build/test slave. Installer now documents externally-loadable packages as simple literal structures that can be merged via Installer>>#merge:. MC ancestry history strings can now be stubbed for a smaller image and sustainable MC history. ______________________________________________ History and Accounting Tools A great new historical website by Bob Arning. MC history and origin is now available for methods and class-definitions from browser menus. A new amazing ObjectHistory makes it possible to efficiently track the born-on date of any object to a resolution of one minute. Added "search history" to Package history browser. ______________________________________________ Fixes and cleanups Packages organized toward eliminating circular dependencies, and with proper concern for existing and future UI frameworks. Updated uses of SmalltalkImage current to, simply, "Smalltalk." Moving away from use of Utilities. More preferences made pragma-based. Compiler factorings and cleanups. Diminished excessive usage of ReadWriteStream. ProtoObject API balanced and minimal. Moved classifying and logging behavior out of Compiler (a responsibility of Behavior). ______________________________________________ Application Upgrade Notes Default Float printing is now true to its internal representation. Apps must now use appropriate methods to format Floats rather than roundTo:. ($a to: $b) now returns ''ab'' rather than #($a $b). Remove OneCharacterSymbols optimization. LRUCache instance migrations, if any. See post-scripts in Collections-ul.546, 547 Rectangles with 0 area (e.g., lines) can now intersect. This release is dedicated to the memory of our friend Andreas Raab (1968 -- 2013) !! ]style[(10 1 4 1 7 1 19 1 1 47 22 2 13 142 11 329 8 57 15 237 21 358 48 720 13 321 28 372 18 522 25 382 1 5 7 4 9 56 1)ba2FBitstreamVeraSerif#32.0,a2FBitstreamVeraSerif#32.0,a2--FBitstreamVeraSerif#32.0,a2FBitstreamVeraSerif#32.0,ia2FBitstreamVeraSerif#32.0,FBitstreamVeraSerif#24.0a2,FBitstreamVeraSerif#24.0----a2,FBitstreamVeraSerif#24.0a2,,FBitstreamVeraSerif#16.0,FBitstreamVeraSerif#24.0,,bFBitstreamVeraSerif#16.0,FBitstreamVeraSerif#16.0,bFBitstreamVeraSerif#16.0,FBitstreamVeraSerif#16.0,bFBitstreamVeraSerif#16.0,FBitstreamVeraSerif#16.0,bFBitstreamVeraSerif#16.0,FBitstreamVeraSerif#16.0,bFBitstreamVeraSerif#16.0,FBitstreamVeraSerif#16.0,FBitstreamVeraSerif#24.0,FBitstreamVeraSerif#16.0,FBitstreamVeraSerif#24.0,FBitstreamVeraSerif#16.0,FBitstreamVeraSerif#24.0,FBitstreamVeraSerif#16.0,FBitstreamVeraSerif#24.0,FBitstreamVeraSerif#16.0,FBitstreamVeraSerif#24.0,FBitstreamVeraSerif#16.0,,FBitstreamVeraSerif#16.0ia2,FBitstreamVeraSerif#16.0iba2,FBitstreamVeraSerif#16.0ia2,FBitstreamVeraSerif#16.0iba2,FBitstreamVeraSerif#16.0ia2,!!' readStream nextChunkText! ----- Method: SqueakProjectHelp class>>squeakResourcesOnline (in category 'pages') ----- squeakResourcesOnline ^HelpTopic title: 'Squeak Resources Online' icon: (HelpIcons iconNamed: #squeakIcon) contents: 'Squeak web sites Main Squeak site http://www.squeak.org Weekly Squeak http://news.squeak.org Oversight Board http://board.squeak.org Downloads for many versions http://ftp.squeak.org Development of the virtual machine http://squeakvm.org Google+ Page https://plus.google.com/u/0/b/115950529692424242526/ Squeak-dev - The main Squeak mailing list http://lists.squeakfoundation.org/mailman/listinfo/squeak-dev http://dir.gmane.org/gmane.comp.lang.smalltalk.squeak.general http://n4.nabble.com/Squeak-Dev-f45488.html Squeak-Beginners - The place to ask even the most basic questions http://lists.squeakfoundation.org/mailman/listinfo/beginners http://dir.gmane.org/gmane.comp.lang.smalltalk.squeak.beginners http://n4.nabble.com/Squeak-Beginners-f107673.html Squeak By Example http://www.squeakbyexample.org/ Squeak, Open Personal Computing and Multimedia http://coweb.cc.gatech.edu/squeakbook/ http://stephane.ducasse.free.fr/FreeBooks/CollectiveNBlueBook/ Squeak, Open Personal Computing for Multimedia http://www.cc.gatech.edu/~mark.guzdial/drafts/ http://stephane.ducasse.free.fr/FreeBooks/GuzdialBookDrafts/ More Books about Squeak and Smalltalk http://stephane.ducasse.free.fr/FreeBooks.html !! ]style[(16 316 41 173 65 181 17 35 46 106 46 112 37 49)bu,,bu,,bu,,bu,,bu,,bu,,bu,!!' readStream nextChunkText ! ----- Method: SqueakProjectHelp class>>squeakUserInterface (in category 'pages') ----- squeakUserInterface ^HelpTopic title: 'Squeak User Interface' icon: (HelpIcons iconNamed: #squeakIcon) contents: 'The Squeak UI has some unusual elements that you may not have seen before. Here is a brief introduction to those elements: Projects A project is an entire Squeak desktop full of windows. Projects are can be used to change quickly from one task to another. An inactive project is represented by a project window that shows a thumbnail of that project''s windows. Project windows are actually more like doors than windows, since you can enter the project just by clicking on its project window. You can create a new project by choosing ''open...project'' from the screen menu. To exit a project (and return to its parent project), choose ''previous project'' from the screen menu. Each project maintains its set of windows, plus its own set of Smalltalk changes and its own screen color depth. Morphic Halos In a morphic project, cmd-click (alt-click) on a window or other graphical object will bring up a constellation of colored circles called "halo handles" around that object. Additional clicks will cycle through the halos for other graphical objects in the nesting structure. If you hold down the Shift key while cmd-clicking, the nested morphs will be traversed from innermost outward. Clicking without the cmd (alt) key will dismiss the halo. While the halo is up, letting the cursor linger over one of the halo handles for a few seconds will cause a balloon to pop up with the name of that handle. Three useful handles are the top-left "X" handle (delete), the bottom-right yellow handle (resize), and the brown handle (slide the object within its containing object). Halos allow complex graphical objects to be explored--or even disassembled (using the black halo handle). Usually no harm results from taking apart an object; you can just discard the pieces and create a new one. Flaps To enable Flaps, click on the desktop to show the world menu, choose the "Flaps..." menu and "show shared tags". Tabs labeled "Squeak", "Tools", "Supplies", etc., will appear along the edges of the Squeak desktop. Click on any tab to open the corresponding flap. Drag a tab to resize the flap and to relocate the tab. Bring up the halo on any tab and click on its menu handle to be presented with many options relating to the flap. Use the "Flaps..." menu, reached via the desktop menu, to control which flaps are visible and for other flap-related options and assistance. Parts Bins You can obtain new objects in many ways. The "Objects Catalog" (choose "objects'' from the world menu or open the objects flap) and several of the standard flaps (e.g. "Tools" and "Supplies") serve as "Parts Bins" the for new objects. Drag any icon you see in a Parts Bin and a fresh copy of the kind of object it represents will appear "in your hand"; click to deposit the new object anywhere you wish. You can also add your own objects to any of the flaps -- just drag your object over the tab, wait for the flap to pop open, then drop the object at the desired position in the flap. !! ]style[(123 9 663 13 991 5 579 10 589),bu,,bu,,bu,,bu,!!' readStream nextChunkText! ----- Method: SqueakProjectHelp class>>workingWithSqueak (in category 'pages') ----- workingWithSqueak ^HelpTopic title: 'Working with Squeak' icon: (HelpIcons iconNamed: #squeakIcon) contents: 'Starting and Quitting Like most Smalltalk''s, the machine-executable portion is a relatively small program known as the "virtual machine" (VM). The VM''s job is to provide services from the physical machine to real Smalltalk objects. Services like input and output. The Smalltalk system, including all data and code, is a system of objects, built from the ground up, and interpreted by this virtual computer. This affords Smalltalk system platform portability. Smalltalk cannot run without the VM. The VM can''t do anything useful except process Smalltalk systems. To start the system, drag the ".image" data file to the VM executable "squeak". There are myriad command-line options for starting the system via the command-line (see squeak --help). By default, the system will open on the screen in a single OS window. To quit a Squeak session, choose ''quit'' from the menu bar. If you save, the image file will be overwritten and resume from that place the next time it''s launched. The Image File Squeak is an environment built in its own objects from the ground up, including one or more end-user applications. All of the objects in the system -- Classes, Dictionaries, Windows, Customers and other objects that make up the Squeak environment are stored in a binary ".image" file. This is the "object-data file" loaded by the VM when Squeak is launched. When an image is started, every object resumes exactly from where it was last saved. The Sources File Smalltalk is traditionally includes the source code in the running system. However, keeping multiple copies of the same source code in all images files is wasteful. Therefore, the source code itself is kept in a read-only .sources file and accessed by all images. The image files merely have pointers into this file, which is read on-the-fly to present original source code. The code of the base system is stored in the file "SqueakV41.sources". This file does not change except between releases of Squeak. Normally this file should be placed in the folder containing the VM executable. The Changes File The purpose of Squeak is to develop new programs and systems. Code changes to the running system are effective immediately. But since multiple images can be running, they cannot all update the .sources file safely. Therefore, each image file is accompanied by a ".changes" file which contains source code changes for that and only that Smalltalk system.. The changes file is important for project work. It keeps a sequential log of development activity for the purpose of recovering work performed since the last image-save. Any of several events could lead to the need to recover work, including a power-outage or making an erroneous change to code required to keep the system running. The changes file does not consume memory space, so Squeak is able to keep a complete history of all program changes. This makes it easy to examine or even reinstate older versions of methods (see ''versions'' option in browser selector pane). This encourages experimentation, since you can easily revert to the original versions of any set of methods. In extreme cases where sources and/or changes files are not available, the system can still run, and will automatically decompile the bytecode methods in image memory, if necessary, into readable and editable versions of the original source code (only comments and temporary variable names are lost). Transferring Code-Snippets Between Images In addition to the ''save'' command that saves the entire state of the system, the code of individual methods, categories or classes may be ''filed out'' and then filed-in to another image. Packages The code of an entire project is encapsulated by a Package. This allows users to share their code with other users. Code of packages are delineated by the categories of their classes, and methods. The Monticello browser is then used to wrap that code into a Package object which can be saved to a Monticello repository at http://ss3.gemtalksystems.com/ss. Some projects end up using the resources provided by several packages, resulting in a hierarchy of packages that make up a system. Installer can be used to install such systems.!! ]style[(21 970 14 448 16 396 11 188 16 321 4 1025 41 188 8 52 10 55 2 420)bu,,bu,,bu,,u,,bu,,u,,bu,,bu,,i,,i,!!' readStream nextChunkText! SqueakHelp subclass: #SqueakToolsHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! SqueakToolsHelp subclass: #SqueakToolsDebuggerHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! ----- Method: SqueakToolsDebuggerHelp class>>bookName (in category 'accessing') ----- bookName ^'Debugger'! ----- Method: SqueakToolsDebuggerHelp class>>openingTheDebugger (in category 'pages') ----- openingTheDebugger ^HelpTopic title: 'Open a Debugger.' contents: 'A debugger window is opened in response to an unhandled exception condition. Evaluating the expression ''self halt'' in a workspace or as an expression in a method will cause a debugger window to be opened. The debugger provides direct interactive access to the interrupted process. The debugger permits its interrupted process to be inspected and modified. Source code and variables may be modified interactively, and the process can be stepped through its execution in various ways.'! ----- Method: SqueakToolsDebuggerHelp class>>pages (in category 'accessing') ----- pages ^# (whatIsADebugger openingTheDebugger usingTheDebugger)! ----- Method: SqueakToolsDebuggerHelp class>>showForm: (in category 'pages') ----- showForm: aSymbol | form contents | form := ScriptingSystem formAtKey: aSymbol. contents := (String with: Character cr) asText, (Text string: ' ' attribute: (TextFontReference toFont: (FormSetFont new fromFormArray: (Array with: form) asciiStart: Character space asInteger ascent: form height))), (String with: Character cr) asText. ^contents! ----- Method: SqueakToolsDebuggerHelp class>>usingTheDebugger (in category 'pages') ----- usingTheDebugger ^HelpTopic title: 'Debugging Loops.' contents: 'There are a few ways to get out of a loop. The best way is to just let the loop run. To do that select the space on your code (while in the Debugger) you want to jump to, right click and select: ''run to here.'' ' asText, (self showForm: #Debugger1), ' That will take you to the place you clicked on in your code. There is another trick, loops usually have an index. This is Smalltalk after all. In the case above we just selected this code and selected ''Debug it'' 1 to: 100 do: [:i | Transcript show: i asString]. Transcript show: ''done'' While in the outer content evaluating the loop, select i change the value to 100 hit accept and ''bobs your uncle'' the loop is done. Ok so a bit of a hack but this can be used it to skip over some processing, and since you are debugging and know what you are doing it should be fine. ' asText, (self showForm: #Debugger2), ' Proceed is just continue and stop debugging. Restart will stop debugging at the selected method and restart that method from the beginning. Into goes into the execution of the next method and shows you what it does. Over executes the next message and moves over it to the next message. Through steps you through a block of code, so if you are about to execute a block, this steps you through that block Full Stack increases the number of levels you see in the upper panel. That normally shows you a subset of the execution stack. Full stack will show you the rest of the stack that called this method. Where is useful if you click around a method during debugging. It will highlight the code at its execution point. You can also just select the stack method again to do the same thing. Tally is supposed to tally selected code, but may not be reliable within the debugger. If you want to tally something do it outside a debugger.' asText! ----- Method: SqueakToolsDebuggerHelp class>>whatIsADebugger (in category 'pages') ----- whatIsADebugger ^HelpTopic title: 'What is a Debugger.' contents: 'A debugger represents the machine state at the time of an interrupted process. It also represent a query path into the state of the process. The debugger is typically viewed through a window that views the stack of suspended contexts, the code for, and execution point in, the currently selected message, and inspectors on both the receiver of the currently selected message, and the variables in the current context.'! ----- Method: SqueakToolsHelp class>>basicDevelopmentTools (in category 'pages') ----- basicDevelopmentTools ^HelpTopic title: 'Basic Development Tools' contents: 'Smalltalk environments have some of the best user interfaces for programmers ever devised. Those who have programmed in Lisp under Emacs have some idea, but Smalltalk is even better. You should learn these basic tools thoroughly: - Workspace - Transcript - Browser - Inspector - File List - Change Sorter - Debugger - Method Finder '! ----- Method: SqueakToolsHelp class>>bookName (in category 'accessing') ----- bookName ^'Tools'! ----- Method: SqueakToolsHelp class>>pages (in category 'accessing') ----- pages ^#(basicDevelopmentTools)! SqueakToolsHelp subclass: #SqueakToolsTranscriptHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! ----- Method: SqueakToolsTranscriptHelp class>>bookName (in category 'accessing') ----- bookName ^'Transcript'! ----- Method: SqueakToolsTranscriptHelp class>>pages (in category 'accessing') ----- pages ^# (transcript)! ----- Method: SqueakToolsTranscriptHelp class>>transcript (in category 'pages') ----- transcript ^HelpTopic title: 'The Transcript window' contents: 'The Transcript window is often used for logging or printing results from text only code. To open the Transcript use TheWorldMenu and choose ''open...''. Then choose ''Transcript''. You can also type Transcript open in a Workspace and doIt. '! SqueakToolsHelp subclass: #SqueakToolsWorkspaceHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! ----- Method: SqueakToolsWorkspaceHelp class>>bookName (in category 'accessing') ----- bookName ^'Workspace'! ----- Method: SqueakToolsWorkspaceHelp class>>openWorkspace (in category 'pages') ----- openWorkspace ^HelpTopic title: 'Open a Workspace' contents: 'You can open a Workspace window in any of the following ways: - Keyboard Shortcut: while pointing at an empty part of the Squeak window, press alt-k (in Windows) or cmd-k (on a Mac) - World Menu: select "Workspace" - Tools Flap: click on the Tools Flap. When it comes out, drag the Workspace icon out. - Doit: select inside the following quote and doit: "Workspace open"'! ----- Method: SqueakToolsWorkspaceHelp class>>pages (in category 'accessing') ----- pages ^#(workspace openWorkspace saveWorkspace)! ----- Method: SqueakToolsWorkspaceHelp class>>saveWorkspace (in category 'pages') ----- saveWorkspace ^HelpTopic title: 'Saving Workspace to a File' contents: 'You can save the text content of a Workspace to a file by choosing the workspace menu (from within the workspace), then ''more...'', then ''save contents to file...''.'! ----- Method: SqueakToolsWorkspaceHelp class>>workspace (in category 'pages') ----- workspace ^HelpTopic title: 'What is a Workspace' contents: 'A Workspace is a window used as a scratchpad area where fragments of Smalltalk code can be entered, stored, edited, and evaluated.'! SqueakHelp subclass: #SqueakTutorials instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! ----- Method: SqueakTutorials class>>bookName (in category 'accessing') ----- bookName ^'Tutorials'! ----- Method: SqueakTutorials class>>introduction (in category 'pages') ----- introduction "This method was automatically generated. Edit it using:" "SqueakTutorials edit: #introduction" ^HelpTopic title: 'Introduction' contents: 'Here you will some short tutorials on how to use Squeak for daily tasks. Feel free to add your own.!!' readStream nextChunkText! ----- Method: SqueakTutorials class>>pages (in category 'accessing') ----- pages ^#(introduction)! SqueakTutorials subclass: #SqueakTutorialsCommandKey instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! ----- Method: SqueakTutorialsCommandKey class>>bookName (in category 'as yet unclassified') ----- bookName ^'Command Key Mappings'! ----- Method: SqueakTutorialsCommandKey class>>commandKeyMappings (in category 'as yet unclassified') ----- commandKeyMappings "This method was automatically generated. Edit it using:" "SqueakTutorialsCommandKey edit: #commandKeyMappings" ^HelpTopic title: 'Command Key Mappings' contents: 'Lower-case command keys (use with Cmd key on Mac and Alt key on other platforms) a Select all b Browse it (selection is a class name or cursor is over a class-list or message-list) c Copy selection d Do it (selection is a valid expression) e Exchange selection with prior selection f Find g Find again h Set selection as search string for find again i Inspect it (selection is a valid expression, or selection is over an inspect-ilst) j Again once (do the last text-related operation again) k Set font l Cancel m Implementors of it (selection is a message selector or cursor is over a class-list or message-list) n Senders of it (selection is a message selector or cursor is over a class-list or message-list) o Spawn current method p Print it (selection is a valid expression) q Query symbol (toggle all possible completion for a given prefix) r Recognizer s Save (i.e. accept) t Finds a Transcript (when cursor is over the desktop) u Toggle alignment v Paste w Delete preceding word (over text); Close-window (over morphic desktop) x Cut selection y Swap characters z Undo Note: for Do it, Senders of it, etc., a null selection will be expanded to a word or to the current line in an attempt to do what you want. Also note that Senders/Implementors of it will find the outermost keyword selector in a large selection, as when you have selected a bracketed expression or an entire line. Finally note that the same cmd-m and cmd-n (and cmd-v for versions) work in the message pane of most browsers. Upper-case command keys (use with Shift-Cmd, or Ctrl on Mac or Shift-Alt on other platforms; sometimes Ctrl works too) A Advance argument B Browse it in this same browser (in System browsers only) C Compare the selected text to the clipboard contents D Duplicate E Method strings containing it F Insert ''ifFalse:'' G fileIn from it (a file name) H cursor TopHome: I Inspect via Object Explorer J Again many (apply the previous text command repeatedly until the end of the text) K Set style L Outdent (move selection one tab-stop left) M Select current type-in N References to it (selection is a class name, or cursor is over a class-list or message-list) O Open single-message browser (in message lists) P Make project link R Indent (move selection one tab-stap right) S Search T Insert ''ifTrue:'' U Convert linefeeds to carriage returns in selection V Paste author''s initials W Selectors containing it (in text); show-world-menu (when issued with cursor over desktop) X Force selection to lowercase Y Force selection to uppercase Z Capitalize all words in selection Other special keys Backspace Backward delete character Del Forward delete character Shift-Bksp Backward delete word Shift-Del Forward delete word Esc Pop up the Desktop Menu \ Send top window to back Cursor keys left, right, up, down Move cursor left, right, up or down Ctrl-left Move cursor left one word Ctrl-right Move cursor right one word Home Move cursor to begin of line or begin of text End Move cursor to end of line or end of text PgUp, Ctrl-up Move cursor up one page PgDown, Ctrl-Dn Move cursor down one page Note all these keys can be used together with Shift to define or enlarge the selection. You cannot however shrink that selection again, as in some other systems. Other Cmd-key combinations (not available on all platforms) Return Insert return followed by as many tabs as the previous line (with a further adjustment for additional brackets in that line) Space Select the current word as with double clicking Enclose the selection in a kind of bracket. Each is a toggle. (not available on all platforms) Ctrl-( Enclose within ( and ), or remove enclosing ( and ) Ctrl-[ Enclose within [ and ], or remove enclosing [ and ] Crtl-{ Enclose within { and }, or remove enclosing { and } Ctrl-< Enclose within < and >, or remove enclosing < and > Ctrl-'' Enclose within '' and '', or remove enclosing '' and '' Ctrl-" Enclose within " and ", or remove enclosing " and " Note also that you can double-click just inside any of the above delimiters, or at the beginning or end of a line, to select the text enclosed. Text Emphasis (not available on all platforms) Cmd-1 type the first method argument Cmd-2 type the second method argument Cmd-3 type the third method argument Cmd-4 type the fourth method argument Cmd-5 for future use Cmd-6 color, action-on-click, link to class comment, link to method, url Brings up a menu. To remove these properties, select more than the active part and then use command-0. Cmd-7 bold Cmd-8 italic Cmd-9 narrow (same as negative kern) Cmd-0 plain text (resets all emphasis) Cmd-- underlined (toggles it) Cmd-= struck out (toggles it) Shift-Cmd-- (aka :=) negative kern (letters 1 pixel closer) Shift-Cmd-+ positive kern (letters 1 pixel larger spread) Docking Bar Ctrl-<n> opens the n-th (where n is between 0 and 7) menu if such exists, otherwise it moves the keyboard focus to the Search Bar. Currently this means: Ctrl-0 Activates Search Bar Ctrl-1 Squeak menu Ctrl-2 Projects menu Ctrl-3 Tools menu Ctrl-4 Apps menu Ctrl-5 Extras menu Ctrl-6 Windows menu Ctrl-7 Help menu !!' readStream nextChunkText! ----- Method: SqueakTutorialsCommandKey class>>pages (in category 'as yet unclassified') ----- pages ^# (commandKeyMappings)! SqueakTutorials subclass: #SqueakTutorialsOnImage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! ----- Method: SqueakTutorialsOnImage class>>bookName (in category 'as yet unclassified') ----- bookName ^'The Squeak Image'! ----- Method: SqueakTutorialsOnImage class>>pages (in category 'as yet unclassified') ----- pages ^# (theImage)! ----- Method: SqueakTutorialsOnImage class>>theImage (in category 'as yet unclassified') ----- theImage ^HelpTopic title: 'Working with the Squeak Image' contents: 'Working with the ecosystem of objects in a Smalltalk image. The basic tool for this is called an Inspector. Whenever you have an expression, like "3 + 4", you press cmd-i to "inspect it", which opens an inspector on the result. This works in any text area. Try for example inspecting "self" in a class browser, and you will inspect the underlying class object (which the browser shows a high-level view of). In the Inspector you see the objects referenced by this object (via instance variables or indexed fields) in the left panel. Select any of them and choose "inspect" from the context menu (or press cmd-i again). This way you can inspect all the objects in the system. A more modern tool than the Inspector (which was around 40 years ago already) is the Object Explorer. It presents you a tree view of an object and its "children", which again are the instance variables and indexed fields of the object. Open it with cmd-shift-i (or "explore" in the context menu). You can also do the reverse. If you choose "objects pointing to this value" you get an inspector showing all the objects that directly point to this object. Similarly there is a "reverse explorer", which you can open by selecting "explore pointers". There are two roots to all the objects in the system: Smalltalk specialObjectsArray which basically holds everything the Virtual Machine needs to know about, and in turn almost every object in the whole image, and thisContext which is the current execution context, holding onto temporary objects. When a garbage collection is performed, any object not reachable form either of these two roots is removed from memory. An "interesting" global object to explore is Project current which holds your current workspace, in particular Project current world , the root of all morphs in the world. And of course Smalltalk itself is the dictionary that holds all global objects, including all classes (unless they are defined in a non-global environment). There is also a low-level way to enumerate all objects in memory. "self someObject" will return the very first object in memory (which happens to be the nil object), and "anObject nextObject" will return the next one: | object count | count := 0. object := self someObject. [0 == object] whileFalse: [count := count + 1. object := object nextObject]. count Interestingly, this also finds objects that are due to be garbage-collected. For example, if you accidentally closed a text window, there is a good chance its contents will still be in memory, and can be retrieved using an expression like ByteString allInstances last: 10 This makes use of the someInstance/nextInstance methods, which are similar to someObject/nextObject, but restricted to instances of one class only. '! SqueakTutorials subclass: #SqueakTutorialsOnXML instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-Project'! ----- Method: SqueakTutorialsOnXML class>>bookName (in category 'accessing') ----- bookName ^'XML'! ----- Method: SqueakTutorialsOnXML class>>dataRetrieval (in category 'pages') ----- dataRetrieval ^HelpTopic title: 'Retrieving XML data' contents: 'Retrieving data from XML documents is simple and easy in Squeak Smalltalk. This tutorial demonstrates the fundamentals with a straightforward approach where code can be tested right away either here or in a Workspace window. The beauty of Squeak Smalltalk resides in the possibility to evaluate, inspect, print and debug code anywhere and this window is no different. This tutorial demonstrates how to... * retrieve an XML document from the World Wide Web * instantiate an XML document class * inspect and understand the content of an XML document * retrieve and display values from specific XML tags Retrieve an XML document from the World Wide Web There are many manners to retrieve data from the World Wide Web in Squeak Smalltalk. HTTPClient is among them and allows to download files in all simplicity. Select the following code snippet and inspect it (press alt-i). An Inspect window will open with the document loaded in memory. The result is a MIMEDocument object. HTTPClient httpGetDocument: ''http://source.squeak.org/trunk/feed.rss''. TIP: Select HTTPClient and browse it (press alt-b) to open a System Browser window on its class. HTTPClient does not have instance methods but it has class methods. Click on class to see class methods. Instantiate an XML Document An instance of MIMEDocument will not allow to retrieve XML data in a comprehensive manner because it does not understand the nature of XML. For this reason, it is necessary to parse the content of MIMEDocument using XMLDOMParser. XMLDOMParser>>parseDocumentFrom: requires a stream as a parameter and ReadStream will be used for this purpose. The following code snippet instantiates an XMLDocument using the content of the downloaded file. | doc | doc := HTTPClient httpGetDocument: ''http://source.squeak.org/trunk/feed.rss''. XMLDOMParser parseDocumentFrom: (ReadStream on: (doc content)). Inspect and understand the content of an XML document XML is a flexible document format and it is necessary to understand how each given XML file is structured in order to properly search, retrieve and manipulate data. Inspecting values is critical in a dynamic programming language and environment, such as Squeak Smalltalk. Select the previous code snippet and inspect it (press alt-i). Unfortunately, the Inspect window does not reveal a lot about the XML structure of the downloaded file. Select the previous code snippet once again and explore it (press alt and the capital letter i). An Explorer window will open with a tree outline on the instance of XMLDocument. The Inspect and Explorer windows tell a lot about an XMLDocument. The sections are instance variables and their values are displayed aside. In the Explorer window, unfold elementsAndContents. Unfold other sections as deemed necessary to understand the XML format and the data available. The gibberish coding is about to become clear. Open a Browser window from the world menu and right click in the first pane, select find class (press alt-f) and type XMLDocument to search for its class, or select the class name and browse it (press alt-b). However, it is suggested to read more about XMLParser and XMLParserTest first. Retrieve and display values from specific XML tags The downloaded XML file contains a list of items which are denoted by the tag name "item". The Explorer window revealed the content of interest is located at the array index 1 of the elementsAndContents, which can be accessed through XMLDocument>>root. TIP: Some XML documents have additional components contained within its file, such as XMLPI (XML Processing Instructions). For this reason, the root may lead to this rather than the data which will be indexed at 2 or more. It is necessary to use XMLNodeWithElements>>elements, e.g. (xml elements at: 2), in order to access subsequent data. The following code snippet will display items in a Transcript window. Open a Transcript window using the world menu before selecting and executing the code. Select the code snippet and execute it (press alt-d). | doc xml | doc := HTTPClient httpGetDocument: ''http://source.squeak.org/trunk/feed.rss''. xml := XMLDOMParser parseDocumentFrom: (ReadStream on: (doc content)). xml root tagsNamed: #item do: [:e | Transcript show: (e asString); cr. ]. An XML item looks like this: <item> <title>HelpSystem-Core-tbn.46.mcz</title> <link>http://source.squeak.org/trunk.html</link> <description>throw out pharo specific stuff since we are now integrated in squeak (and pharo too where squeak specific stuff was removed)</description> <pubDate>Sun, 02 May 2010 20:23:49 +0000</pubDate> <author>Torsten Bergmann <Torsten.Bergmann(a)astares.de></author> <category>The Trunk</category> <enclosure length="27288" type="application/x-monticello" url="http://source.squeak.org/trunk/HelpSystem-Core-tbn.46.mcz"/> <guid isPermaLink="false"/> </item> The following code snippet uses information learned, retrieves each comment and displays them in a Transcript window. Notice an author can have a nil value and is handled accordingly. | doc xml | doc := HTTPClient httpGetDocument: ''http://source.squeak.org/trunk/feed.rss''. xml := XMLDOMParser parseDocumentFrom: (ReadStream on: (doc content)). xml root tagsNamed: #item do: [:e | Transcript show: ''Date: '', ((e firstTagNamed: #pubDate) contentString); cr; show: ''Title: '', ((e firstTagNamed: #title) contentString); cr; show: ''Author: '', (((e firstTagNamed: #author) notNil) ifTrue: [(e firstTagNamed: #author) contentString] ifFalse: ['''']); cr; show: ''Description: '', ((e firstTagNamed: #description) contentString); cr; cr. ]. An item will now look like: Date: Sun, 02 May 2010 20:23:49 +0000 Title: HelpSystem-Core-tbn.46.mcz Author: Torsten Bergmann <Torsten.Bergmann(a)astares.de> Description: throw out pharo specific stuff since we are now integrated in squeak (and pharo too where squeak specific stuff was removed) '! ----- Method: SqueakTutorialsOnXML class>>pages (in category 'accessing') ----- pages ^# (dataRetrieval)! ----- Method: HelpIcons class>>squeakIcon (in category '*help-squeak-project') ----- squeakIcon ^(Form extent: 12@12 depth: 32 fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 75398782 26843545 0 0 1159996452 1378823983 338044454 0 0 0 0 455682345 1295266868 1126376227 0 0 1040582150 0 1328097577 0 0 0 23488102 1277502757 0 1076834095 0 0 1075781407 0 287647013 472854319 0 0 471472666 204089898 0 1092756002 0 0 1041963803 36909875 0 1880232466 454761243 287515427 1342572038 0 104939841 974460181 0 0 270080281 354690084 86846765 3674539269 1394219546 1611599631 3557427722 86123042 388244516 204287277 0 26843545 605558808 1025055001 1008014613 1159141143 522264865 739710743 1159141143 571083274 570820102 188891714 0 942550574 1411391520 1143021857 1312241463 1428563494 3205040393 3708159494 1663576104 1511067921 1579887403 1629758500 958472481 656679972 439563059 1294608938 839913488 739644950 172246084 221459251 840900383 1075978786 1209933342 724512559 707077413 0 0 0 0 0 0 0 0 0 0 38488907 0 0 0 0 0 0 0 0 0 0 0 0 0) offset: 0@0)! ----- Method: Utilities class>>openCommandKeyHelp (in category '*Help-Squeak-Project-support windows') ----- openCommandKeyHelp "Open a window giving command key help." "Utilities openCommandKeyHelp" HelpBrowser openOn: SqueakTutorialsCommandKey!

1 0

Squeak 4.6: ShoutTests-ul.26.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of ShoutTests to project Squeak 4.6: http://source.squeak.org/squeak46/ShoutTests-ul.26.mcz ==================== Summary ==================== Name: ShoutTests-ul.26 Author: ul Time: 7 May 2015, 3:18:05.834 am UUID: 8830be7b-4069-46ab-810a-7fb3bd086564 Ancestors: ShoutTests-topa.25 Pass a String to SHParserST80, not a Text. ==================== Snapshot ==================== SystemOrganization addCategory: #ShoutTests! TestCase subclass: #SHParserST80Test instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ShoutTests'! !SHParserST80Test commentStamp: 'TorstenBergmann 2/12/2014 23:22' prior: 0! SUnit tests for shouts ST80 parser! ----- Method: SHParserST80Test>>d (in category 'tests-manual') ----- d "ensure that d is defined so that we don't get an #undefinedUnary token type "! ----- Method: SHParserST80Test>>e (in category 'tests-manual') ----- e "ensure that e is defined so that we don't get an #undefinedUnary token type "! ----- Method: SHParserST80Test>>q (in category 'tests-manual') ----- q "ensure that q is defined so that we don't get an #undefinedUnary token type "! ----- Method: SHParserST80Test>>r (in category 'tests-manual') ----- r "ensure that r is defined so that we don't get an #undefinedUnary token type "! ----- Method: SHParserST80Test>>s (in category 'tests-manual') ----- s "ensure that s is defined so that we don't get an #undefinedUnary token type "! ----- Method: SHParserST80Test>>testBooleanHierarchy (in category 'tests-smoke') ----- testBooleanHierarchy self verifyHierarchy: Boolean! ----- Method: SHParserST80Test>>testNumberHierarchy (in category 'tests-smoke') ----- testNumberHierarchy self verifyHierarchy: Number! ----- Method: SHParserST80Test>>testNumbers (in category 'tests') ----- testNumbers | types tokens s | s := 'x 1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '1'). s := 'x -1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary #- number). self assert: tokens = #('x' '-' '1'). s := 'x -1.1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary #- number). self assert: tokens = #('x' '-' '1.1'). s := 'x -1.1.'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary #- number statementSeparator). self assert: tokens = #('x' '-' '1.1' '.'). s := 'x 1.true'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number statementSeparator #true). self assert: tokens = #('x' '1' '.' 'true'). s := 'x 2r1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '2r1'). s := 'x 2d1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '2d1'). s := 'x 2e1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '2e1'). s := 'x 2q1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '2q1'). s := 'x 16r-A'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r-A'). s := 'x -16r-A'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary #- number). self assert: tokens = #('x' '-' '16r-A'). s := 'x 16r'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r'). s := 'x 16r-'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r-'). s := 'x 16r-d'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r-d'). s := 'x 2r2'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number excessCode). self assert: tokens = #('x' '2r' '2'). s := 'x 1.'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number statementSeparator). self assert: tokens = #('x' '1' '.'). s := 'x 1yourself'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number unary). self assert: tokens = #('x' '1' 'yourself'). s := 'x 1size'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number unary). self assert: tokens = #('x' '1' 'size'). s := 'x 1.1size'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number unary). self assert: tokens = #('x' '1.1' 'size'). s := 'x 1s'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '1s'). s := 'x 1.1s'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '1.1s'). s := 'x 2r1e26'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '2r1e26'). s := 'x 16r1e-26'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary number). self assert: tokens = #('x' '16r1e' '-' '26'). s := 'x 16r1e'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r1e'). s := 'x 16r1e-1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary number). self assert: tokens = #('x' '16r1e' '-' '1'). s := 'x 16r1e-'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary excessCode). self assert: tokens = #('x' '16r1e' '-' ''). s := 'x 16r1.ABe20'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r1.ABe20'). s := 'x 16r1.ABe-20'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary number). self assert: tokens = #('x' '16r1.ABe' '-' '20'). s := 'x 1.0e14'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '1.0e14'). s := 'x 1.0e-14'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '1.0e-14'). s := 'x 1.0e14e'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number unary). self assert: tokens = #('x' '1.0e14' 'e'). "" s := 'x 2r1q26'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '2r1q26'). s := 'x 16r1q-26'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r1q-26'). s := 'x 16r1q'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number unary). self assert: tokens = #('x' '16r1' 'q'). s := 'x 16r1q-1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r1q-1'). s := 'x 16r1q-'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number unary binary excessCode). self assert: tokens = #('x' '16r1' 'q' '-' ''). s := 'x 16r1.ABq20'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r1.ABq20'). s := 'x 16r1.ABq-20'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r1.ABq-20'). s := 'x 1.0q14'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '1.0q14'). s := 'x 1.0q-14'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '1.0q-14'). s := 'x 1.0q14q'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number unary). self assert: tokens = #('x' '1.0q14' 'q'). "" s := 'x 2r1d26'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '2r1d26'). s := 'x 16r1d-26'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary number). self assert: tokens = #('x' '16r1d' '-' '26'). s := 'x 16r1d'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r1d'). s := 'x 16r1d-1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary number). self assert: tokens = #('x' '16r1d' '-' '1'). s := 'x 16r1d-'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary excessCode). self assert: tokens = #('x' '16r1d' '-' ''). s := 'x 16r1.ABd20'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '16r1.ABd20'). s := 'x 16r1.ABd-20'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary number). self assert: tokens = #('x' '16r1.ABd' '-' '20'). s := 'x 1.0d14'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '1.0d14'). s := 'x 1.0d-14'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number). self assert: tokens = #('x' '1.0d-14'). s := 'x 1.0d14d'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number unary). self assert: tokens = #('x' '1.0d14' 'd'). "" s := 'x -1.1e-2'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary #- number ). self assert: tokens = #('x' '-' '1.1e-2'). "only first - is separate token !!" s := 'x -16r-1.0e-2'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary #- number binary number). self assert: tokens = #('x' '-' '16r-1.0e' '-' '2'). "only first - is separate token !!" s := 'x 1-1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary number ). self assert: tokens = #('x' '1' '-' '1'). s := 'x 1--1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number incompleteBinary number ). self assert: tokens = #('x' '1' '--' '1'). s := 'x 1--"comment"1'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number incompleteBinary comment number ). self assert: tokens = #('x' '1' '--' '"comment"' '1'). s := 'x 1-self'. types := self tokenTypesIn: s. tokens := self tokensIn: s. self assert: types = #(patternUnary number binary self ). self assert: tokens = #('x' '1' '-' 'self'). ! ----- Method: SHParserST80Test>>testObjectClass (in category 'tests-smoke') ----- testObjectClass CurrentReadOnlySourceFiles cacheDuring: [self verifyClass: Object].! ----- Method: SHParserST80Test>>tokenTypesIn: (in category 'utilities') ----- tokenTypesIn: aString | parser ranges | parser := SHParserST80 new. ranges := parser rangesIn: aString classOrMetaClass: Object workspace: nil environment: nil. ^ranges asArray collect: [:each | each type]! ----- Method: SHParserST80Test>>tokensIn: (in category 'utilities') ----- tokensIn: aString | parser ranges | parser := SHParserST80 new. ranges := parser rangesIn: aString classOrMetaClass: Object workspace: nil environment: nil. ^ranges asArray collect: [:each | aString copyFrom: each start to: each end]! ----- Method: SHParserST80Test>>verifyClass: (in category 'utilities') ----- verifyClass: aBehavior aBehavior selectors do: [ :selector | self verifyClass: aBehavior selector: selector ] ! ----- Method: SHParserST80Test>>verifyClass:selector: (in category 'utilities') ----- verifyClass: aBehavior selector: aSymbol | ranges position types errors | ranges := SHParserST80 new rangesIn: (aBehavior sourceCodeAt: aSymbol) asString classOrMetaClass: aBehavior workspace: nil environment: nil. types := #(#default #invalid #excessCode #comment #unfinishedComment #'$' #character #integer #number #- #symbol #stringSymbol #literalArray #string #unfinishedString #assignment #ansiAssignment #literal #keyword #binary #unary #incompleteKeyword #incompleteBinary #incompleteUnary #undefinedKeyword #undefinedBinary #undefinedUnary #patternKeyword #patternBinary #patternUnary #self #super #true #false #nil #thisContext #return #patternArg #methodArg #blockPatternArg #blockArg #argument #blockArgColon #leftParenthesis #rightParenthesis #leftParenthesis1 #rightParenthesis1 #leftParenthesis2 #rightParenthesis2 #leftParenthesis3 #rightParenthesis3 #leftParenthesis4 #rightParenthesis4 #leftParenthesis5 #rightParenthesis5 #leftParenthesis6 #rightParenthesis6 #leftParenthesis7 #rightParenthesis7 #blockStart #blockEnd #blockStart1 #blockEnd1 #blockStart2 #blockEnd2 #blockStart3 #blockEnd3 #blockStart4 #blockEnd4 #blockStart5 #blockEnd5 #blockStart6 #blockEnd6 #blockStart7 #blockEnd7 #arrayStart #arrayEnd #arrayStart1 #arrayEnd1 #byteArrayStart #byteArrayEnd #byteArrayStart1 #byteArrayEnd1 #leftBrace #rightBrace #cascadeSeparator #statementSeparator #externalCallType #externalCallTypePointerIndicator #primitiveOrExternalCallStart #primitiveOrExternalCallEnd #methodTempBar #blockTempBar #blockArgsBar #primitive #externalFunctionCallingConvention #module #blockTempVar #blockPatternTempVar #instVar #workspaceVar #undefinedIdentifier #incompleteIdentifier #tempVar #patternTempVar #poolConstant #classVar #globalVar #pragmaKeyword #pragmaUnary #pragmaBinary) asIdentitySet. errors := #(#excessCode #unfinishedComment #unfinishedString) asIdentitySet. position := 0. ranges do: [ :each | self assert: 1 <= each length description: 'empty range'. self assert: position <= each start description: 'overlapping range'. self assert: each start <= each end description: 'empty range'. self assert: (types includes: each type) description: 'unknown type ' , each type. self deny: (errors includes: each type) description: 'error type ' , each type. position := each end ]! ----- Method: SHParserST80Test>>verifyHierarchy: (in category 'utilities') ----- verifyHierarchy: aBehavior CurrentReadOnlySourceFiles cacheDuring: [ aBehavior withAllSubclassesDo: [:class | self verifyClass: class; verifyClass: class class]].!

1 0

Squeak 4.6: Environments-cmm.57.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of Environments to project Squeak 4.6: http://source.squeak.org/squeak46/Environments-cmm.57.mcz ==================== Summary ==================== Name: Environments-cmm.57 Author: cmm Time: 24 March 2015, 2:15:46.253 pm UUID: 9352873e-a424-44ef-b624-9bf6fbbf4b74 Ancestors: Environments-topa.56 Fix access to globals which were defined by: Smalltalk at: #MyGlobal ifAbsentPut: [myValue]. ==================== Snapshot ==================== (PackageInfo named: 'Environments') preamble: '"Fix ''Instances'' entry for Smalltalk Environment." | dict | dict := (Environment classPool at: ''Instances''). dict keys do: [ : eachName | (eachName isSymbol not ) ifTrue: [ dict at: eachName asSymbol put: (dict removeKey: eachName) ] ]. "Let Environment names be, consistently, Symbols." Environment allInstances do: [ : each | each info instVarNamed: ''name'' put: (each name asSymbol) ]'! SystemOrganization addCategory: #'Environments-Core'! SystemOrganization addCategory: #'Environments-Policies'! SystemOrganization addCategory: #'Environments-Loading'! (PackageInfo named: 'Environments') postscript: '"Recompile all methods to fix errant bindings" Compiler recompileAll. '! LookupKey subclass: #Binding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Environments-Core'! Binding subclass: #Alias instanceVariableNames: 'source' classVariableNames: '' poolDictionaries: '' category: 'Environments-Core'! ----- Method: Alias class>>key:source: (in category 'as yet unclassified') ----- key: aSymbol source: anAssociation ^ self basicNew initializeWithKey: aSymbol source: anAssociation! ----- Method: Alias>>asBinding: (in category 'converting') ----- asBinding: aSymbol ^ aSymbol = source key ifTrue: [source] ifFalse: [Alias key: aSymbol source: source]! ----- Method: Alias>>initializeWithKey:source: (in category 'initialization') ----- initializeWithKey: aSymbol source: anAssociation self initialize. key := aSymbol. source := anAssociation! ----- Method: Alias>>isSpecialReadBinding (in category 'testing') ----- isSpecialReadBinding ^ true! ----- Method: Alias>>isSpecialWriteBinding (in category 'testing') ----- isSpecialWriteBinding ^ true! ----- Method: Alias>>literalEqual: (in category 'error handling') ----- literalEqual: other "Two aliases are equal if they have the same source" ^ self species = other species and: [self source == other source]! ----- Method: Alias>>source (in category 'accessing') ----- source ^ source! ----- Method: Alias>>value (in category 'evaluating') ----- value ^ source value! ----- Method: Alias>>value: (in category 'accessing') ----- value: anObject source value: anObject! ----- Method: Binding class>>convertInstances (in category 'as yet unclassified') ----- convertInstances | new old | old := Binding allInstances. new := old collect: [:ea | ClassBinding key: ea key value: ea value]. old elementsForwardIdentityTo: new. old := ReadOnlyVariableBinding allInstances. new := old collect: [:ea | ClassBinding key: ea key value: ea value]. old elementsForwardIdentityTo: new. Environment allInstancesDo: [:env | #('contents' 'bindings' 'public' 'undeclared') do: [:var || dict | old := Array new writeStream. new := Array new writeStream. dict := env instVarNamed: var. dict associations do: [:binding | binding class == Association ifTrue: [old nextPut: binding. new nextPut: binding key => binding value]]. old contents elementsForwardIdentityTo: new contents]]! ----- Method: Binding>>analogousCodeTo: (in category 'as yet unclassified') ----- analogousCodeTo: anObject "For MethodProperties comparison." ^anObject isVariableBinding and: [self key = anObject key and: [self value = anObject value]]! ----- Method: Binding>>canAssign (in category 'as yet unclassified') ----- canAssign ^ true! ----- Method: Binding>>isSpecialReadBinding (in category 'as yet unclassified') ----- isSpecialReadBinding ^ false! ----- Method: Binding>>isSpecialWriteBinding (in category 'as yet unclassified') ----- isSpecialWriteBinding ^ false! ----- Method: Binding>>objectForDataStream: (in category 'as yet unclassified') ----- objectForDataStream: refStream "It's not yet clear how serialization should work in the presence of environments" self shouldBeImplemented.! ----- Method: Binding>>printOn: (in category 'as yet unclassified') ----- printOn: aStream key printOn: aStream. aStream nextPutAll: '=>'. self value printOn: aStream! ----- Method: Binding>>source (in category 'as yet unclassified') ----- source ^ self! Binding subclass: #ClassBinding instanceVariableNames: 'value' classVariableNames: '' poolDictionaries: '' category: 'Environments-Core'! ----- Method: ClassBinding class>>key:value: (in category 'as yet unclassified') ----- key: key value: value ^ self basicNew initializeWithKey: key value: value! ----- Method: ClassBinding>>asBinding: (in category 'as yet unclassified') ----- asBinding: aSymbol ^ aSymbol == key ifTrue: [self] ifFalse: [Alias key: aSymbol source: self]! ----- Method: ClassBinding>>canAssign (in category 'as yet unclassified') ----- canAssign ^ false! ----- Method: ClassBinding>>initializeWithKey:value: (in category 'as yet unclassified') ----- initializeWithKey: kObject value: vObject self initialize. key := kObject. value := vObject.! ----- Method: ClassBinding>>isSpecialWriteBinding (in category 'as yet unclassified') ----- isSpecialWriteBinding ^ true! ----- Method: ClassBinding>>literalEqual: (in category 'as yet unclassified') ----- literalEqual: other "Class bindings are equal when the bind the same class" ^ self species = other species and: [self value = other value]! ----- Method: ClassBinding>>value (in category 'as yet unclassified') ----- value ^ value! ----- Method: ClassBinding>>value: (in category 'as yet unclassified') ----- value: anObject (AttemptToWriteReadOnlyGlobal signal: 'Cannot store into read-only bindings') ifTrue: [value := anObject]! Binding subclass: #Global instanceVariableNames: 'value' classVariableNames: '' poolDictionaries: '' category: 'Environments-Core'! ----- Method: Global class>>key:value: (in category 'as yet unclassified') ----- key: aSymbol value: anObject ^ self basicNew initializeWithKey: aSymbol value: anObject! ----- Method: Global>>asBinding: (in category 'as yet unclassified') ----- asBinding: aSymbol ^ aSymbol == key ifTrue: [self] ifFalse: [Alias key: aSymbol source: self]! ----- Method: Global>>initializeWithKey:value: (in category 'as yet unclassified') ----- initializeWithKey: aSymbol value: anObject self initialize. key := aSymbol. value := anObject! ----- Method: Global>>literalEqual: (in category 'as yet unclassified') ----- literalEqual: other "Globals are only equal to themselves, since another global with the same name could have a different value in the future." ^ self == other! ----- Method: Global>>value (in category 'as yet unclassified') ----- value ^ value! ----- Method: Global>>value: (in category 'as yet unclassified') ----- value: anObject value := anObject! Notification subclass: #CurrentEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Environments-Loading'! ----- Method: Symbol>>=> (in category '*environments') ----- => anObject ^ anObject isBehavior ifTrue: [ClassBinding key: self value: anObject] ifFalse: [Global key: self value: anObject]! Object subclass: #BindingPolicy instanceVariableNames: 'policy environment addSelector removeSelector' classVariableNames: '' poolDictionaries: '' category: 'Environments-Policies'! ----- Method: BindingPolicy class>>environment:policy:addSelector:removeSelector: (in category 'as yet unclassified') ----- environment: anEnvironment policy: aNamePolicy addSelector: addSelector removeSelector: removeSelector ^ self basicNew initializeWithEnvironment: anEnvironment policy: aNamePolicy addSelector: addSelector removeSelector: removeSelector! ----- Method: BindingPolicy>>binding:addedTo:notify: (in category 'events') ----- binding: aBinding addedTo: anEnvironment notify: anObject environment == anEnvironment ifTrue: [policy name: aBinding key do: [:name || binding | binding := aBinding asBinding: name. anObject perform: addSelector with: binding]]. ! ----- Method: BindingPolicy>>binding:removedFrom:notify: (in category 'events') ----- binding: aBinding removedFrom: anEnvironment notify: anObject environment == anEnvironment ifTrue: [policy name: aBinding key do: [:name || binding | binding := aBinding asBinding: name. anObject perform: removeSelector with: binding]]. ! ----- Method: BindingPolicy>>environment (in category 'accessing') ----- environment ^ environment! ----- Method: BindingPolicy>>initializeWithEnvironment:policy:addSelector:removeSelector: (in category 'initialize-release') ----- initializeWithEnvironment: anEnvironment policy: aNamePolicy addSelector: aSelector removeSelector: rSelector self initialize. environment := anEnvironment. policy := aNamePolicy. addSelector := aSelector. removeSelector := rSelector! ----- Method: BindingPolicy>>name:do: (in category 'private') ----- name: aSymbol do: aBlock ^ policy name: aSymbol do: aBlock! ----- Method: BindingPolicy>>removeObserver: (in category 'initialize-release') ----- removeObserver: anEnvironment environment removeObserver: anEnvironment ! Object subclass: #Environment instanceVariableNames: 'info declarations bindings undeclared policies observers' classVariableNames: 'Default Instances' poolDictionaries: '' category: 'Environments-Core'! !Environment commentStamp: 'cmm 12/20/2013 14:10' prior: 0! I am a context for compiling methods. I maintain the namespace of classes and global variables that are visible to the methods compiled within me. I have the following instance variables: info <EnvironmentInfo> Metadata about me and the code I contain. imports <Import> Rules for importing globals from other environments. exports <Export> Rules for exposing globals to other environments. declarations <IdentityDictionary> Bindings for globals that have been declared inside me. references <IdentityDictionary> Bindings for globals that are used by methods compiled inside me. public <IdentityDictionary> Bindings for classes that have been declared inside me, and which satisfy the export rules contain in 'exports'. undeclared <Dictionary> Bindings for globals that are used by methods compiled inside me, but which aren't present in 'references' and couldn't be found via the rules in 'imports'.! ----- Method: Environment class>>cleanUp (in category 'class initialization') ----- cleanUp self allInstancesDo: [:env | env purgeUndeclared]! ----- Method: Environment class>>current (in category 'accessing') ----- current ^ CurrentEnvironment signal ifNil: [self default]! ----- Method: Environment class>>default (in category 'accessing') ----- default ^ Default! ----- Method: Environment class>>default: (in category 'accessing') ----- default: anEnvironment Default := anEnvironment! ----- Method: Environment class>>initialize (in category 'class initialization') ----- initialize self install! ----- Method: Environment class>>install (in category 'class initialization') ----- install | smalltalk env | self environment class == self ifTrue: [Transcript cr; show: 'Can''t install environments; they''re already installed'. ^ self]. smalltalk := Smalltalk globals. env := self basicNew initializeWithSystemDictionary: smalltalk. Default := env. Instances ifNil: [Instances := IdentityDictionary new]. Instances at: env info name put: env. (smalltalk at: #Undeclared) becomeForward: (env at: #Undeclared). smalltalk becomeForward: env. Smalltalk garbageCollect.! ----- Method: Environment class>>named: (in category 'instance creation') ----- named: aSymbol | symbol | symbol := aSymbol asSymbol. ^ Instances at: symbol ifAbsentPut: [ self withName: symbol ]! ----- Method: Environment class>>uninstall (in category 'class initialization') ----- uninstall | globals sysdict | self environment class == self ifFalse: [Transcript cr; show: 'Can''t uninstall environments; they''re not currently installed'. ^ self]. globals := Smalltalk globals instVarNamed: 'contents'. sysdict := SystemDictionary new: globals size. globals associationsDo: [:ea | sysdict add: ea]. Smalltalk globals becomeForward: sysdict.! ----- Method: Environment class>>withName: (in category 'instance creation') ----- withName: aString ^ self basicNew initializeWithName: aString! ----- Method: Environment>>addAllBindings (in category 'updating') ----- addAllBindings declarations associationsDo: [:ea | self binding: ea addedTo: self]! ----- Method: Environment>>addObserver: (in category 'observing') ----- addObserver: anObject observers add: anObject! ----- Method: Environment>>allClasses (in category 'classes and traits') ----- allClasses ^ Array streamContents: [:out | self allClassesDo: [:class | out nextPut: class]]! ----- Method: Environment>>allClassesAndTraits (in category 'classes and traits') ----- allClassesAndTraits ^ Array streamContents: [:out | self allClassesAndTraitsDo: [:value | out nextPut: value]]! ----- Method: Environment>>allClassesAndTraitsDo: (in category 'classes and traits') ----- allClassesAndTraitsDo: aBlock declarations keysAndValuesDo: [:key :value | ((value isBehavior) and: [key == value name]) ifTrue: [aBlock value: value]]! ----- Method: Environment>>allClassesDo: (in category 'classes and traits') ----- allClassesDo: aBlock self allClassesAndTraitsDo: [:value | (value isKindOf: Class) ifTrue: [aBlock value: value]]! ----- Method: Environment>>allTraits (in category 'classes and traits') ----- allTraits ^ Array streamContents: [:out | self allTraitsDo: [:value | out nextPut: value]] ! ----- Method: Environment>>allTraitsDo: (in category 'classes and traits') ----- allTraitsDo: aBlock self allClassesAndTraitsDo: [:value | value isTrait ifTrue: [aBlock value: value]]! ----- Method: Environment>>associationAt: (in category 'emulating') ----- associationAt: aSymbol "Senders of this should probably be using #bindingOf:" self flag: #review. ^ declarations associationAt: aSymbol! ----- Method: Environment>>associationAt:ifAbsent: (in category 'emulating') ----- associationAt: aSymbol ifAbsent: aBlock "Senders of this should probably be using #bindingOf:" self flag: #review. ^ declarations associationAt: aSymbol ifAbsent: aBlock! ----- Method: Environment>>associationOrUndeclaredAt: (in category 'emulating') ----- associationOrUndeclaredAt: key ^ bindings associationAt: key ifAbsent: [undeclared at: key put: nil. undeclared associationAt: key] ! ----- Method: Environment>>associationsDo: (in category 'emulating') ----- associationsDo: aBlock "Evaluate aBlock for each of the receiver's elements (key/value associations)." declarations associationsDo: aBlock! ----- Method: Environment>>at: (in category 'emulating') ----- at: aSymbol ^ declarations at: aSymbol! ----- Method: Environment>>at:ifAbsent: (in category 'emulating') ----- at: aSymbol ifAbsent: aBlock ^ declarations at: aSymbol ifAbsent: aBlock! ----- Method: Environment>>at:ifAbsentPut: (in category 'emulating') ----- at: aSymbol ifAbsentPut: aBlock ^self at: aSymbol ifAbsent: [ self at: aSymbol put: aBlock value ]! ----- Method: Environment>>at:ifPresent: (in category 'emulating') ----- at: aSymbol ifPresent: aBlock ^ declarations at: aSymbol ifPresent: aBlock! ----- Method: Environment>>at:ifPresent:ifAbsent: (in category 'emulating') ----- at: aSymbol ifPresent: presentBlock ifAbsent: absentBlock ^ declarations at: aSymbol ifPresent: presentBlock ifAbsent: absentBlock.! ----- Method: Environment>>at:ifPresentAndInMemory: (in category 'emulating') ----- at: key ifPresentAndInMemory: aBlock ^ declarations at: key ifPresent: [:v | v isInMemory ifTrue: [aBlock value: v]]! ----- Method: Environment>>at:put: (in category 'emulating') ----- at: aSymbol put: anObject ^ self bind: aSymbol to: anObject! ----- Method: Environment>>bind:to: (in category 'binding') ----- bind: aSymbol to: anObject | binding newBinding | newBinding := aSymbol => anObject. binding := declarations associationAt: aSymbol ifAbsent: [nil]. binding ifNotNil: [binding class == newBinding class ifTrue: [binding value: anObject] ifFalse: [binding becomeForward: newBinding]. ^anObject]. binding := undeclared associationAt: aSymbol ifAbsent: [nil]. binding ifNil: [binding := newBinding] ifNotNil: [undeclared removeKey: aSymbol. binding class == newBinding class ifTrue: [binding value: anObject] ifFalse: [binding becomeForward: newBinding]]. declarations add: binding. self binding: binding addedTo: self. ^anObject ! ----- Method: Environment>>binding:addedTo: (in category 'updating') ----- binding: aBinding addedTo: anEnvironment policies do: [:ea | ea binding: aBinding addedTo: anEnvironment notify: self]! ----- Method: Environment>>binding:removedFrom: (in category 'updating') ----- binding: aBinding removedFrom: anEnvironment policies do: [:ea | ea binding: aBinding removedFrom: anEnvironment notify: self]! ----- Method: Environment>>bindingOf: (in category 'binding') ----- bindingOf: aSymbol ^ self bindingOf: aSymbol ifAbsent: nil! ----- Method: Environment>>bindingOf:ifAbsent: (in category 'binding') ----- bindingOf: aSymbol ifAbsent: aBlock ^ bindings bindingOf: aSymbol ifAbsent: aBlock! ----- Method: Environment>>classAndTraitNames (in category 'classes and traits') ----- classAndTraitNames | names | names := Array streamContents: [:out | self allClassesAndTraitsDo: [:value | out nextPut: value name]]. names sort. ^ names! ----- Method: Environment>>classNamed: (in category 'classes and traits') ----- classNamed: aString ^ self classOrTraitNamed: aString! ----- Method: Environment>>classNames (in category 'classes and traits') ----- classNames ^ (self allClasses collect: [:ea | ea name]) sort! ----- Method: Environment>>classOrTraitNamed: (in category 'classes and traits') ----- classOrTraitNamed: aString "aString is either a class or trait name or a class or trait name followed by ' class' or 'classTrait' respectively. Answer the class or metaclass it names." | meta baseName | (aString endsWith: ' class') ifTrue: [meta := true. baseName := aString copyFrom: 1 to: aString size - 6] ifFalse: [ (aString endsWith: ' classTrait') ifTrue: [ meta := true. baseName := aString copyFrom: 1 to: aString size - 11] ifFalse: [ meta := false. baseName := aString]]. ^declarations at: baseName asSymbol ifPresent: [ :global | global isBehavior ifTrue: [ meta ifFalse: [ global ] ifTrue: [ global classSide ]]]! ----- Method: Environment>>declarationOf: (in category 'binding') ----- declarationOf: aSymbol ^ declarations bindingOf: aSymbol! ----- Method: Environment>>declarations (in category 'declaring') ----- declarations ^ Array streamContents: [:out | declarations associationsDo: [:ea | out nextPut: ea]]! ----- Method: Environment>>destroy (in category 'initialize-release') ----- destroy self allClasses do: [:ea | ea removeFromSystem]. declarations keys do: [:ea | self unbind: ea]. policies do: [:ea | ea removeObserver: self]. observers do: [:ea | ea stopObserving: self].! ----- Method: Environment>>do: (in category 'emulating') ----- do: aBlock "Evaluate aBlock for each of the receiver's values." self valuesDo: aBlock! ----- Method: Environment>>environment (in category 'emulating') ----- environment ^ self! ----- Method: Environment>>errorKeyNotFound: (in category 'private') ----- errorKeyNotFound: key "Signal KeyNotFound error" ^(KeyNotFound key: key) signal! ----- Method: Environment>>export: (in category 'configuring') ----- export: spec | policy | policy := BindingPolicy environment: self policy: (ExplicitNamePolicy spec: spec) addSelector: #notifyObserversOfBindingAdded: removeSelector: #notifyObserversOfBindingRemoved:. policies := policies copyWith: policy! ----- Method: Environment>>exportAddingPrefix: (in category 'configuring') ----- exportAddingPrefix: aString | policy | policy := BindingPolicy environment: self policy: (AddPrefixNamePolicy prefix: aString) addSelector: #notifyObserversOfBindingAdded: removeSelector: #notifyObserversOfBindingAdded:. policies := policies copyWith: policy! ----- Method: Environment>>exportRemovingPrefix: (in category 'configuring') ----- exportRemovingPrefix: aString | policy | policy := BindingPolicy environment: self policy: (RemovePrefixNamePolicy prefix: aString) addSelector: #notifyObserversOfBindingAdded: removeSelector: #notifyObserversOfBindingAdded:. policies := policies copyWith: policy! ----- Method: Environment>>exportSelf (in category 'configuring') ----- exportSelf | policy | policy := BindingPolicy environment: self policy: (AllNamePolicy new) addSelector: #notifyObserversOfBindingAdded: removeSelector: #notifyObserversOfBindingRemoved:. policies := policies copyWith: policy! ----- Method: Environment>>fileIn:announcing: (in category 'operations') ----- fileIn: aStream announcing: aString (EnvironmentLoader for: self) fileIn: aStream announcing: aString ! ----- Method: Environment>>flushClassNameCache (in category 'classes and traits') ----- flushClassNameCache "We don't have one"! ----- Method: Environment>>forgetClass:logged: (in category 'classes and traits') ----- forgetClass: aClass logged: aBool (self hasBindingOf: aClass name) ifFalse: [ ^ self ]. aBool ifTrue: [SystemChangeNotifier uniqueInstance classRemoved: aClass fromCategory: aClass category]. self organization removeElement: aClass name. Smalltalk removeFromStartUpList: aClass. Smalltalk removeFromShutDownList: aClass. self unbind: aClass name! ----- Method: Environment>>from:import: (in category 'configuring') ----- from: anEnvironment import: spec | policy | policy := BindingPolicy environment: anEnvironment policy: (ExplicitNamePolicy spec: spec) addSelector: #showBinding: removeSelector: #hideBinding:. policies := policies copyWith: policy. anEnvironment addObserver: self. anEnvironment addAllBindings.! ----- Method: Environment>>hasBindingOf: (in category 'binding') ----- hasBindingOf: aSymbol ^ declarations includesKey: aSymbol! ----- Method: Environment>>hasClassNamed: (in category 'classes and traits') ----- hasClassNamed: aString Symbol hasInterned: aString ifTrue: [:symbol | ^ (declarations at: symbol ifAbsent: [nil]) isKindOf: Class]. ^ false.! ----- Method: Environment>>hideBinding: (in category 'binding') ----- hideBinding: aBinding self undeclare: aBinding key from: bindings! ----- Method: Environment>>import: (in category 'configuring') ----- import: anEnvironment | policy | policy := BindingPolicy environment: anEnvironment policy: AllNamePolicy new addSelector: #showBinding: removeSelector: #hideBinding:. policies := policies copyWith: policy. anEnvironment addObserver: self. anEnvironment addAllBindings.! ----- Method: Environment>>import:addingPrefix: (in category 'configuring') ----- import: anEnvironment addingPrefix: aString | import | import := BindingPolicy environment: anEnvironment policy: (AddPrefixNamePolicy prefix: aString) addSelector: #showBinding: removeSelector: #hideBinding:. policies := policies copyWith: import. anEnvironment addObserver: self. anEnvironment addAllBindings.! ----- Method: Environment>>import:removingPrefix: (in category 'configuring') ----- import: anEnvironment removingPrefix: aString | import | import := BindingPolicy environment: anEnvironment policy: (RemovePrefixNamePolicy prefix: aString) addSelector: #showBinding: removeSelector: #hideBinding:. policies := policies copyWith: import. anEnvironment addObserver: self. anEnvironment addAllBindings.! ----- Method: Environment>>importSelf (in category 'configuring') ----- importSelf | policy | policy := BindingPolicy environment: self policy: AllNamePolicy new addSelector: #showBinding: removeSelector: #hideBinding:. policies := policies copyWith: policy. declarations associationsDo: [:ea | (bindings includesKey: ea key) ifFalse: [bindings add: ea]]! ----- Method: Environment>>includes: (in category 'emulating') ----- includes: value ^ declarations includes: value! ----- Method: Environment>>includesKey: (in category 'emulating') ----- includesKey: key ^ declarations includesKey: key! ----- Method: Environment>>info (in category 'accessing') ----- info ^ info! ----- Method: Environment>>initialize (in category 'initialize-release') ----- initialize declarations := IdentityDictionary new. bindings := IdentityDictionary new. undeclared := IdentityDictionary new. policies := Array new. observers := IdentitySet new.! ----- Method: Environment>>initializeWithName: (in category 'initialize-release') ----- initializeWithName: aString | smalltalk | self initialize. info := EnvironmentInfo name: aString. . smalltalk := SmalltalkImage basicNew. smalltalk globals: self. declarations at: #Smalltalk put: smalltalk. declarations at: #Undeclared put: undeclared.! ----- Method: Environment>>initializeWithSystemDictionary: (in category 'initialize-release') ----- initializeWithSystemDictionary: old self initialize. info := EnvironmentInfo name: 'Smalltalk' organization: old organization packages: PackageOrganizer default. old associationsDo: [:assc | declarations add: assc]. (old at: #Undeclared) associationsDo: [:assc | undeclared add: assc]. (declarations at: #Smalltalk) instVarNamed: 'globals' put: self. declarations at: #Undeclared put: undeclared.! ----- Method: Environment>>isUndeclared: (in category 'declaring') ----- isUndeclared: aSymbol ^ undeclared includesKey: aSymbol! ----- Method: Environment>>keyAtIdentityValue: (in category 'emulating') ----- keyAtIdentityValue: anObject ^ declarations keyAtIdentityValue: anObject.! ----- Method: Environment>>keyAtIdentityValue:ifAbsent: (in category 'emulating') ----- keyAtIdentityValue: anObject ifAbsent: aBlock ^ declarations keyAtIdentityValue: anObject ifAbsent: aBlock! ----- Method: Environment>>keyAtValue: (in category 'emulating') ----- keyAtValue: anObject ^ self keyAtIdentityValue: anObject! ----- Method: Environment>>keys (in category 'emulating') ----- keys ^ declarations keys! ----- Method: Environment>>keysAndValuesDo: (in category 'emulating') ----- keysAndValuesDo: aBlock ^self associationsDo: [:assoc | aBlock value: assoc key value: assoc value].! ----- Method: Environment>>keysDo: (in category 'emulating') ----- keysDo: aBlock "Evaluate aBlock for each of the receiver's keys." declarations keysDo: aBlock! ----- Method: Environment>>notifyObserversOfBindingAdded: (in category 'updating') ----- notifyObserversOfBindingAdded: aBinding observers do: [:ea | ea binding: aBinding addedTo: self]! ----- Method: Environment>>notifyObserversOfBindingRemoved: (in category 'updating') ----- notifyObserversOfBindingRemoved: aBinding observers do: [:ea | ea binding: aBinding removedFrom: self]! ----- Method: Environment>>objectForDataStream: (in category 'emulating') ----- objectForDataStream: refStrm | dp | "I am about to be written on an object file. Write a reference to Smalltalk instead." dp := DiskProxy global: #Smalltalk selector: #globals args: #(). refStrm replace: self with: dp. ^ dp! ----- Method: Environment>>organization (in category 'accessing') ----- organization ^ info organization! ----- Method: Environment>>poolUsers (in category 'emulating') ----- poolUsers "Answer a dictionary of pool name -> classes that refer to it. Also includes any globally know dictionaries (such as Smalltalk, Undeclared etc) which although not strictly accurate is potentially useful information" "Smalltalk poolUsers" | poolUsers | poolUsers := Dictionary new. self keys do: [:k | "yes, using isKindOf: is tacky but for reflective code like this it is very useful. If you really object you can:- a) go boil your head. b) provide a better answer. your choice." | pool refs | (((pool := self at: k) isKindOf: Dictionary) or: [pool isKindOf: SharedPool class]) ifTrue: [refs := (self systemNavigation allClasses select: [:c | c sharedPools identityIncludes: pool] thenCollect: [:c | c name]) asOrderedCollection. refs add: (self systemNavigation allCallsOn: (self associationAt: k)). poolUsers at: k put: refs]]. ^ poolUsers! ----- Method: Environment>>printOn: (in category 'printing') ----- printOn: aStream aStream nextPutAll: info name! ----- Method: Environment>>purgeUndeclared (in category 'declaring') ----- purgeUndeclared undeclared removeUnreferencedKeys! ----- Method: Environment>>recompileAll (in category 'operations') ----- recompileAll self allClassesAndTraits do: [:classOrTrait | classOrTrait compileAll] displayingProgress:[:classOrTrait| 'Recompiling ', classOrTrait] ! ----- Method: Environment>>remove:from:readdAfter: (in category 'private') ----- remove: binding from: aDictionary readdAfter: aBlock aDictionary removeKey: binding key ifAbsent: [ ^aBlock value ]. ^aBlock ensure: [ aDictionary add: binding ]! ----- Method: Environment>>removeClassNamed: (in category 'classes and traits') ----- removeClassNamed: aString declarations at: aString asSymbol ifPresent: [:class | class removeFromSystem] ifAbsent: [Transcript cr; show: 'Removal of class named ', aString, ' ignored because ', aString, ' does not exist.']! ----- Method: Environment>>removeKey: (in category 'emulating') ----- removeKey: key "Remove key from the receiver. If key is not in the receiver, notify an error." self flag: #review. ^ self removeKey: key ifAbsent: [self errorKeyNotFound: key].! ----- Method: Environment>>removeKey:ifAbsent: (in category 'emulating') ----- removeKey: aSymbol ifAbsent: aBlock | binding | self flag: #review. (declarations includesKey: aSymbol) ifFalse: [^aBlock value]. binding := (declarations associationAt: aSymbol). declarations removeKey: aSymbol. self binding: binding removedFrom: self. ^ binding value! ----- Method: Environment>>removeObserver: (in category 'observing') ----- removeObserver: anObject observers remove: anObject ifAbsent: []! ----- Method: Environment>>renameClass:as: (in category 'classes and traits') ----- renameClass: aClass as: newName ^self renameClass: aClass from: aClass name to: newName! ----- Method: Environment>>renameClass:from: (in category 'classes and traits') ----- renameClass: aClass from: oldName ^self renameClass: aClass from: oldName to: aClass name! ----- Method: Environment>>renameClass:from:to: (in category 'classes and traits') ----- renameClass: aClass from: oldName to: newName "Rename the class, aClass, to have the title newName." | oldBinding newBinding category | category := self organization categoryOfElement: oldName. self organization classify: newName under: category suppressIfDefault: true. self organization removeElement: oldName. oldBinding := self declarationOf: oldName. declarations removeKey: oldName. self binding: oldBinding removedFrom: self. " re-route now undeclared oldBinding " oldBinding value: aClass. newBinding := newName => aClass. aClass updateMethodBindingsTo: newBinding. declarations add: newBinding. self binding: newBinding addedTo: self. Smalltalk renamedClass: aClass from: oldName to: newName. SystemChangeNotifier uniqueInstance classRenamed: aClass from: oldName to: newName inCategory: category! ----- Method: Environment>>renameClassNamed:as: (in category 'classes and traits') ----- renameClassNamed: oldName as: newName declarations at: oldName ifPresent: [:class | class rename: newName] ifAbsent: [Transcript cr; show: 'Class-rename for ', oldName, ' ignored because ', oldName, ' does not exist.']! ----- Method: Environment>>scopeFor:from:envtAndPathIfFound: (in category 'emulating') ----- scopeFor: aSymbol from: lower envtAndPathIfFound: aBlock ^ (declarations includesKey: aSymbol) ifTrue: [aBlock value: self value: String new] ! ----- Method: Environment>>select: (in category 'emulating') ----- select: aBlock ^ declarations select: aBlock! ----- Method: Environment>>showBinding: (in category 'binding') ----- showBinding: aBinding | binding | binding := undeclared associationAt: aBinding key ifAbsent: [nil]. binding ifNotNil: [undeclared removeKey: binding key. binding becomeForward: aBinding]. binding := bindings associationAt: aBinding key ifAbsent: [nil]. binding ifNotNil: [bindings removeKey: binding key]. bindings add: aBinding.! ----- Method: Environment>>stopObserving: (in category 'observing') ----- stopObserving: anEnvironment policies := policies reject: [:ea | ea environment == anEnvironment].! ----- Method: Environment>>storeDataOn: (in category 'emulating') ----- storeDataOn: aDataStream "I don't get stored. Use a DiskProxy" self error: 'use a DiskProxy to store me'! ----- Method: Environment>>traitNames (in category 'classes and traits') ----- traitNames ^ self allTraits collect: [:ea | ea name]! ----- Method: Environment>>unbind: (in category 'binding') ----- unbind: aSymbol | binding | binding := declarations bindingOf: aSymbol ifAbsent: [^ self]. undeclared declare: aSymbol from: declarations. declarations removeKey: aSymbol ifAbsent: [ ]. [ undeclared at: aSymbol put: nil ] on: AttemptToWriteReadOnlyGlobal do: [ :n | n resume: true ]. self binding: binding removedFrom: self! ----- Method: Environment>>undeclare: (in category 'declaring') ----- undeclare: aSymbol ^ (undeclared bindingOf: aSymbol) ifNil: [undeclared add: aSymbol => nil]! ----- Method: Environment>>undeclare:from: (in category 'declaring') ----- undeclare: aSymbol from: aNamespace | binding | binding := self undeclare: aSymbol. (aNamespace bindingOf: aSymbol) ifNotNil: [:old | aNamespace removeKey: aSymbol. old becomeForward: binding]. ^ binding! ----- Method: Environment>>undeclared (in category 'accessing') ----- undeclared ^ undeclared! ----- Method: Environment>>valueOf: (in category 'binding') ----- valueOf: aSymbol ^ self valueOf: aSymbol ifAbsent: nil! ----- Method: Environment>>valueOf:ifAbsent: (in category 'binding') ----- valueOf: aSymbol ifAbsent: aBlock ^ (self bindingOf: aSymbol ifAbsent: [^ aBlock value]) value! ----- Method: Environment>>valuesDo: (in category 'emulating') ----- valuesDo: aBlock "Evaluate aBlock for each of the receiver's values." declarations valuesDo: aBlock! ----- Method: Environment>>veryDeepCopyWith: (in category 'emulating') ----- veryDeepCopyWith: aCopier ^ self! Object subclass: #EnvironmentInfo instanceVariableNames: 'name organization packages' classVariableNames: '' poolDictionaries: '' category: 'Environments-Core'! ----- Method: EnvironmentInfo class>>name: (in category 'create') ----- name: aString ^ self name: aString organization: (SystemOrganizer defaultList: Array new) packages: PackageOrganizer new. ! ----- Method: EnvironmentInfo class>>name:organization:packages: (in category 'create') ----- name: aString organization: aSystemOrganizer packages: aPackageOrganizer ^ self basicNew initializeWithName: aString organization: aSystemOrganizer packages: aPackageOrganizer! ----- Method: EnvironmentInfo>>initializeWithName:organization:packages: (in category 'initializing') ----- initializeWithName: aString organization: aSystemOrganizer packages: aPackageOrganizer self initialize. name := aString asSymbol. organization := aSystemOrganizer. packages := aPackageOrganizer.! ----- Method: EnvironmentInfo>>name (in category 'access') ----- name ^ name! ----- Method: EnvironmentInfo>>organization (in category 'access') ----- organization ^ organization! ----- Method: EnvironmentInfo>>packages (in category 'access') ----- packages ^ packages! ----- Method: EnvironmentInfo>>printOn: (in category 'printing') ----- printOn: aStream aStream nextPutAll: name. aStream nextPutAll: 'Info'! Object subclass: #EnvironmentLoader instanceVariableNames: 'environment' classVariableNames: '' poolDictionaries: '' category: 'Environments-Loading'! ----- Method: EnvironmentLoader class>>for: (in category 'as yet unclassified') ----- for: anEnvironment ^ self basicNew initializeWithEnvironment: anEnvironment! ----- Method: EnvironmentLoader>>evaluate: (in category 'as yet unclassified') ----- evaluate: chunk ^ [Compiler evaluate: chunk environment: environment] on: CurrentEnvironment do: [:req | req resume: environment]! ----- Method: EnvironmentLoader>>evaluate:logged: (in category 'as yet unclassified') ----- evaluate: chunk logged: aBoolean ^ [Compiler evaluate: chunk environment: environment logged: aBoolean] on: CurrentEnvironment do: [:req | req resume: environment]! ----- Method: EnvironmentLoader>>fileIn:announcing: (in category 'as yet unclassified') ----- fileIn: aStream announcing: aString | val | self logStart: aStream name. aString displayProgressFrom: 0 to: aStream size during: [:bar | [aStream atEnd] whileFalse: [bar value: aStream position. aStream skipSeparators. [val := self fileInChunkFrom: aStream] on: InMidstOfFileinNotification do: [:ex | ex resume: true]. aStream skipStyleChunk]. aStream close]. self logEnd: aStream name. ^ val! ----- Method: EnvironmentLoader>>fileInChunkFrom: (in category 'as yet unclassified') ----- fileInChunkFrom: aStream | chunk | ^ (aStream peekFor: $!!) ifTrue: [ | reader | chunk := aStream nextChunk. reader := self evaluate: chunk logged: false. reader scanFrom: aStream environment: environment] ifFalse: [ chunk := aStream nextChunk. aStream checkForPreamble: chunk. self evaluate: chunk logged: true ]! ----- Method: EnvironmentLoader>>initializeWithEnvironment: (in category 'as yet unclassified') ----- initializeWithEnvironment: anEnvironment self initialize. environment := anEnvironment! ----- Method: EnvironmentLoader>>logEnd: (in category 'as yet unclassified') ----- logEnd: filename "Note: The main purpose of this banner is to flush the changes file." Smalltalk logChange: '----End fileIn of ' , filename , ' into ', environment name, '----' ! ----- Method: EnvironmentLoader>>logStart: (in category 'as yet unclassified') ----- logStart: filename Smalltalk logChange: '----Start fileIn of ' , filename , ' into ' , environment name , '----'! Object subclass: #NamePolicy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Environments-Policies'! NamePolicy subclass: #AddPrefixNamePolicy instanceVariableNames: 'prefix' classVariableNames: '' poolDictionaries: '' category: 'Environments-Policies'! ----- Method: AddPrefixNamePolicy class>>prefix: (in category 'as yet unclassified') ----- prefix: aString ^ self basicNew initializeWithPrefix: aString! ----- Method: AddPrefixNamePolicy>>initializeWithPrefix: (in category 'as yet unclassified') ----- initializeWithPrefix: aString self initialize. prefix := aString! ----- Method: AddPrefixNamePolicy>>name:do: (in category 'overriding') ----- name: aSymbol do: aBlock ^ (aSymbol beginsWith: prefix) ifFalse: [aBlock value: (prefix, aSymbol) asSymbol]. ! NamePolicy subclass: #AllNamePolicy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Environments-Policies'! ----- Method: AllNamePolicy>>name:do: (in category 'as yet unclassified') ----- name: aSymbol do: aBlock ^ aBlock value: aSymbol! NamePolicy subclass: #ExplicitNamePolicy instanceVariableNames: 'aliases' classVariableNames: '' poolDictionaries: '' category: 'Environments-Policies'! ----- Method: ExplicitNamePolicy class>>aliases: (in category 'as yet unclassified') ----- aliases: aCollection ^ self basicNew initializeWithAliases: aCollection! ----- Method: ExplicitNamePolicy class>>flattenSpec:into: (in category 'create') ----- flattenSpec: anObject into: names anObject isSymbol ifTrue: [^ names at: anObject put: anObject]. anObject isVariableBinding ifTrue: [^ names add: anObject]. anObject isDictionary ifTrue: [^ names addAll: anObject]. anObject do: [:ea | self flattenSpec: ea into: names]! ----- Method: ExplicitNamePolicy class>>spec: (in category 'create') ----- spec: anObject | aliases | (anObject isKindOf: NamePolicy) ifTrue: [^ anObject]. aliases := IdentityDictionary new. self flattenSpec: anObject into: aliases. ^ self aliases: aliases! ----- Method: ExplicitNamePolicy>>initializeWithAliases: (in category 'as yet unclassified') ----- initializeWithAliases: aCollection self initialize. aliases := IdentityDictionary withAll: aCollection! ----- Method: ExplicitNamePolicy>>name:do: (in category 'overriding') ----- name: aSymbol do: aBlock ^ aBlock value: (aliases at: aSymbol ifAbsent: [^ nil])! ----- Method: NamePolicy>>name:do: (in category 'as yet unclassified') ----- name: aSymbol do: aBlock self subclassResponsibility! NamePolicy subclass: #RemovePrefixNamePolicy instanceVariableNames: 'prefix' classVariableNames: '' poolDictionaries: '' category: 'Environments-Policies'! ----- Method: RemovePrefixNamePolicy class>>prefix: (in category 'as yet unclassified') ----- prefix: aString ^ self basicNew initializeWithPrefix: aString! ----- Method: RemovePrefixNamePolicy>>initializeWithPrefix: (in category 'as yet unclassified') ----- initializeWithPrefix: aString self initialize. prefix := aString! ----- Method: RemovePrefixNamePolicy>>name:do: (in category 'overriding') ----- name: aSymbol do: aBlock ^ (aSymbol beginsWith: prefix) ifTrue: [aBlock value: (aSymbol allButFirst: prefix size) asSymbol]! ----- Method: ReadOnlyVariableBinding>>asBinding: (in category '*environments') ----- asBinding: aSymbol ^ ClassBinding key: aSymbol value: value! ----- Method: Association>>asBinding: (in category '*environments') ----- asBinding: aSymbol ^ aSymbol == key ifTrue: [self] ifFalse: [Alias key: aSymbol source: self]!

1 0

Squeak 4.6: WebClient-Tests-topa.48.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of WebClient-Tests to project Squeak 4.6: http://source.squeak.org/squeak46/WebClient-Tests-topa.48.mcz ==================== Summary ==================== Name: WebClient-Tests-topa.48 Author: topa Time: 20 April 2015, 2:50:36.764 pm UUID: 031c09ee-026e-48c3-ba4d-f9d9fd4e2048 Ancestors: WebClient-Tests-fbs.47 Minor test refactoring ==================== Snapshot ==================== SystemOrganization addCategory: #'WebClient-Tests'! TestCase subclass: #WebClientServerTest instanceVariableNames: 'server user password oldAuthHandler oldProxyHandler port' classVariableNames: '' poolDictionaries: '' category: 'WebClient-Tests'! !WebClientServerTest commentStamp: 'ar 2/24/2010 00:13' prior: 0! Tests for both WebClient and WebServer.! ----- Method: WebClientServerTest>>decode: (in category 'tests - json') ----- decode: aString "Decodes the given string" ^WebUtils jsonDecode: aString readStream! ----- Method: WebClientServerTest>>encode: (in category 'tests - json') ----- encode: anObject "Encodes the given object" ^WebUtils jsonEncode: anObject! ----- Method: WebClientServerTest>>expectedFailures (in category 'setup') ----- expectedFailures "Some old versions of HTTPSocket are broken" ((HTTPSocket respondsTo: #httpRequestHandler:) or:[SystemVersion current version beginsWith: 'Pharo']) ifFalse:[^#(testMultipartFiles2)]. ^#()! ----- Method: WebClientServerTest>>localHostUrl (in category 'setup') ----- localHostUrl ^'http://localhost:', self port asString! ----- Method: WebClientServerTest>>oAuthParams (in category 'tests - oauth') ----- oAuthParams "The base parameter set for oauth related tests. Example values taken from http://oauth.googlecode.com/svn/code/javascript/example/signature.html " ^Dictionary newFromPairs: { "Consumer key and secret" 'oauth_consumer_key'. 'abcd'. 'oauth_consumer_secret'. 'efgh'. "Token key and secret" 'oauth_token'. 'ijkl'. 'oauth_token_secret'. 'mnop'. 'oauth_timestamp'. '1281668113'. 'oauth_nonce'. 'FWNkVaRJVzE'. "Twitter uses oauth 1.0 with HMAC-SHA1" 'oauth_version'. '1.0'. 'oauth_signature_method'. 'HMAC-SHA1'. }.! ----- Method: WebClientServerTest>>port (in category 'setup') ----- port "Use a random port to minimise chances of concurrently running test suites clashing." ^ port ifNil: [port := (10000 to: 50000) atRandom]! ----- Method: WebClientServerTest>>setUp (in category 'setup') ----- setUp server := WebServer new listenOn: self port. server passwordAt: 'user' realm: 'test' put: 'pass'. ! ----- Method: WebClientServerTest>>tearDown (in category 'setup') ----- tearDown server ifNotNil:[server destroy]. ! ----- Method: WebClientServerTest>>testArrays (in category 'tests - json') ----- testArrays "Test array encodings" self assert: (self decode: '[]') = #(). self assert: (self decode: '[[]]') = #(#()). self assert: (self decode: '[[], []]') = #(#() #()). self assert: (self decode: '["hello", "world", 123]') = #('hello' 'world' 123). self assert: (self decode: '[["true", false, null]]') = #(('true' false nil)). self assert: (self encode: #()) = '[]'. self assert: (self encode: #(#())) = '[[]]'. self assert: (self encode: #(#() #()) ) = '[[], []]'. self assert: (self encode: #('hello' 'world' 123)) = '["hello", "world", 123]'. self assert: (self encode: #(('true' false nil))) = '[["true", false, null]]'. self should: [self decode: '['] raise: Error. self should: [self decode: '[}'] raise: Error. self should: [self decode: '{[}'] raise: Error. self should: [self decode: '[[[]]'] raise: Error. ! ----- Method: WebClientServerTest>>testAuthException (in category 'tests - auth') ----- testAuthException "Test client and server handling of digest auth" | resp client | server addService: '/test/auth' action:[:req | server authenticate: req realm: 'test' methods: #(digest) do:[ req send200Response: 'ok' ]. ]. client := WebClient new. self should:[client httpGet: self localHostUrl, '/test/auth'] raise: WebAuthRequired. client allowAuth: false. self shouldnt:[resp := client httpGet: self localHostUrl, '/test/auth'] raise: WebAuthRequired. self assert: resp code = 401. ! ----- Method: WebClientServerTest>>testAuthRedirectSession (in category 'tests - redirect') ----- testAuthRedirectSession "Run a test for a full auth-redirect-cookie loop" | loginOK finalUrl finalFields firstRedirect client resp | server addService: '/login' action:[:req | server authenticate: req realm: 'test' methods: #(digest) do:[ | id | loginOK := true. server sessionAt: (id := UUID new hex) put: ''. req send302Response: (req fields at: 'url' ifAbsent:['/']) do:[:reply| reply setCookie: 'session' value: id path: '/']]]. server addService: '/action' action:[:req | (server sessionAt: (req cookieAt: 'session')) ifNil:[ firstRedirect := true. req send302Response: '/login?url=', req rawUrl encodeForHTTP. ] ifNotNil:[ finalUrl := req url. finalFields := req fields. req send200Response: 'ok'. ]. ]. firstRedirect := loginOK := false. server passwordAt: 'squeak' realm: 'test' put: 'foo'. client := WebClient new. client username: 'squeak'; password: 'foo'. resp := client httpGet: self localHostUrl, '/action/foo/bar?string=hello&number=42'. self assert: resp code = 200. self assert: firstRedirect. self assert: loginOK. self assert: finalUrl = '/action/foo/bar'. self assert: finalFields size = 2. self assert: (finalFields at: 'string') = 'hello'. self assert: (finalFields at: 'number') = '42'. ! ----- Method: WebClientServerTest>>testBasicAuth (in category 'tests - auth') ----- testBasicAuth "Test client and server basic auth" | resp reqHeader | server addService: '/test/auth' action:[:req | server authenticate: req realm: 'test' methods: #(basic) do:[ reqHeader := req headerAt: 'Authorization'. req send200Response: 'ok' ]. ]. resp := WebClient new httpGet: self localHostUrl, '/test/auth'. self assert: resp code = 401. [resp := WebClient httpGet: self localHostUrl, '/test/auth'] on: WebAuthRequired do:[:ex| ex username: 'squeak' password: 'squeak']. self assert: resp code = 401. [resp := WebClient httpGet: self localHostUrl, '/test/auth'] on: WebAuthRequired do:[:ex| ex username: 'user' password: 'pass']. self assert: resp code = 200. self assert: resp content = 'ok'. self assert: (reqHeader beginsWith: 'Basic '). ! ----- Method: WebClientServerTest>>testChunkedLoopback (in category 'tests - chunked') ----- testChunkedLoopback "Test HTTP loopback streaming using chunked transfer-encoding" | queue response | queue := SharedQueue new. server addService: '/recv' action:[:req | "The /recv service establishes the write-end for the server. In a real environment we would access protect the request and also pass a token to be used to link the incoming /send request from the client." req sendResponse: 200 chunked:[:writeEnd| | chunk | "There is no reason to wait for the client to send a request, the protocol is entirely freestyle. Send something just because we can" writeEnd nextChunkPut: 'Initial response'. "And from here on echo any incoming data" [chunk := queue next. chunk == nil] whileFalse:[writeEnd nextChunkPut: chunk]. "And some final data" writeEnd nextChunkPut: 'Final response'. ]. ] methods: #('GET'). "only allow GET requests" server addService: '/send' action:[:req | "The /send service establishes the read-end for the server. Simply read the chunks as they come in and stick them in our loopback queue to send them back to the client." | chunk | [chunk := req nextChunk. chunk == nil] whileFalse:[queue nextPut: chunk]. queue nextPut: nil. "end conversation" req send200Response: 'ok'. ] methods: #('POST'). "only allow POST requests" "Establish the server response stream" response := WebClient new httpGet: self localHostUrl, '/recv'. self assert: response code = 200. self assert: (response headerAt: 'Transfer-Encoding') = 'chunked'. self assert: response nextChunk equals: 'Initial response'. "Establish the client request stream" WebClient httpPostChunked: self localHostUrl, '/send' content:[:request| "We've set up both ends, try our loopback server" request nextChunkPut: 'Hello World'. self assert: response nextChunk equals: 'Hello World'. request nextChunkPut: 'The answer is 42'. self assert: response nextChunk equals: 'The answer is 42'. ] type: nil. self assert: response nextChunk equals: 'Final response'. self assert: response nextChunk equals: nil. ! ----- Method: WebClientServerTest>>testChunkedRequest (in category 'tests - chunked') ----- testChunkedRequest "Test HTTP post using chunked transfer-encoding" | resp request | server addService: '/test' action:[:req | request := req. req send200Response: req content]. resp := WebClient httpPostChunked: self localHostUrl, '/test' content:[:req| req nextChunkPut: 'Hello'. req nextChunkPut: 'World'. req nextChunkPut: 'Dude'. ] type: nil. self assert: resp code = 200. self assert: resp content = 'HelloWorldDude'. self assert: (request headerAt: 'Transfer-Encoding') = 'chunked'! ----- Method: WebClientServerTest>>testChunkedResponse (in category 'tests - chunked') ----- testChunkedResponse "Test HTTP response using chunked transfer-encoding" | resp | server addService: '/test' action:[:req | req sendResponse: 200 chunked:[:response| response nextChunkPut: 'Hello'. response nextChunkPut: 'World'. response nextChunkPut: 'Dude'. ]. ]. resp := WebClient httpGet: self localHostUrl, '/test'. self assert: resp code = 200. self assert: resp content = 'HelloWorldDude'. self assert: (resp headerAt: 'Transfer-Encoding') = 'chunked'.! ----- Method: WebClientServerTest>>testCookieDomainRules (in category 'tests - cookies') ----- testCookieDomainRules "Test cookie domain rules" "Request host matches domain" self assert: (WebClient new acceptCookie: (WebCookie new domain: 'www.domain.com') host: 'www.domain.com' path: '/'). "Request host matches subdomain" self assert: (WebClient new acceptCookie: (WebCookie new domain: '.domain.com') host: 'www.domain.com' path: '/'). "Request host does not match domain" self deny: (WebClient new acceptCookie: (WebCookie new domain: 'www.domain.com') host: 'ftp.domain.com' path: '/'). "Request host does not match subdomain" self deny: (WebClient new acceptCookie: (WebCookie new domain: '.domain.com') host: 'www.someother.org' path: '/'). "Request host has an extra subdomain" self deny: (WebClient new acceptCookie: (WebCookie new domain: '.domain.com') host: 'foo.bar.domain.com' path: '/'). ! ----- Method: WebClientServerTest>>testCookieExpiryParsing (in category 'tests - cookies') ----- testCookieExpiryParsing "Test parsing of cookie expiry dates" | exp a b | exp := DateAndTime date: Date today time: Time now. a := WebCookie new. a name: 'test'. a expiry: exp. b := WebCookie new readFrom: a asString readStream. self assert: b expiry = exp asUTC. b := WebCookie new readFrom: (a asString copyReplaceAll: '-' with: ' ') readStream. self assert: b expiry = exp asUTC. ! ----- Method: WebClientServerTest>>testCookieParsing (in category 'tests - cookies') ----- testCookieParsing "Test client and server handling of cookies" | resp client | "Sends the testcookie back if it's set" server addService: '/' action:[:req | req send200Response:(String streamContents:[:s| req cookiesDo:[:key :val| s nextPutAll: key, '=', val; cr]. ]). ]. client := WebClient new. resp := client httpGet: self localHostUrl,'/cookieA' do:[:req| req headerAt: 'Cookie' put: 'foo=bar; key=value, x=32, y=55'. ]. resp content; close. self assert: resp code = 200. self assert: resp content equals: 'foo=bar', String cr, 'key=value', String cr, 'x=32', String cr, 'y=55', String cr. client := WebClient new. resp := client httpGet: self localHostUrl,'/cookieA' do:[:req| req addHeader: 'Cookie' value: 'foo=bar'. req addHeader: 'Cookie' value: 'key=value'. req addHeader: 'Cookie' value: 'x=32'. req addHeader: 'Cookie' value: 'y=55'. ]. resp content; close. self assert: resp code = 200. self assert: resp content equals: 'foo=bar', String cr, 'key=value', String cr, 'x=32', String cr, 'y=55', String cr. ! ----- Method: WebClientServerTest>>testCookies (in category 'tests - cookies') ----- testCookies "Test client and server handling of cookies" | resp client | "Sends the testcookie back if it's set" server addService: '/' action:[:req | req send200Response: (req cookieAt: 'testcookie'). ]. "Sets the cookie" server addService: '/cookie/set' action:[:req | req send200Response: 'ok' contentType: 'text/plain' do:[:reply| reply setCookie: 'testcookie' value: '123' path: '/cookie']]. client := WebClient new. resp := client httpGet: self localHostUrl, '/cookie/set'. self assert: resp code = 200. self assert: resp content = 'ok'. self assert: (resp setCookieAt: 'testcookie') value = '123'. resp := client httpGet: self localHostUrl, '/cookie/test'. self assert: resp code = 200. self assert: resp content = '123'. resp := client httpGet: self localHostUrl, '/nocookie/test'. self assert: resp code = 200. self assert: resp content = ''. ! ----- Method: WebClientServerTest>>testDecodeWebSocketKey (in category 'tests - websockets') ----- testDecodeWebSocketKey "Ensure that decoding the Sec-WebSocket-Key fields works properly." | key1 key2 data | key1 := 155712099. key2 := 173347027. data := 'Tm[K T2u'. self assert: (WebUtils extractWebSocketKey: '18x 6]8vM;54 *(5: { U1]8 z [ 8') = key1. self assert: (WebUtils extractWebSocketKey: '1_ tx7X d < nw 334J702) 7]o}` 0') = key2. self assert: (WebUtils webSocketHandshake: key1 with: key2 with: data) asString = 'fQJ,fN/4F4!!~K~MH'.! ----- Method: WebClientServerTest>>testDefault404 (in category 'tests - misc') ----- testDefault404 "Test that a new server responds with 404 to anything" | resp | resp := WebClient httpGet: self localHostUrl. self assert: resp code = 404. ! ----- Method: WebClientServerTest>>testDictionaries (in category 'tests - json') ----- testDictionaries "Test dictionary encodings" self assert: (self decode: '{}') = (Dictionary new). self assert: (self decode: '{"foo" : "bar"}') equals: (Dictionary newFromPairs: { 'foo'. 'bar' }). self assert: (self decode: '{"stuff" : [[], 42, "hello"]}') equals: (Dictionary newFromPairs: { 'stuff'. #(() 42 'hello') }). self assert: (self decode: '{"x" : 42, "y": "77", "z": 0.1}') equals: (Dictionary newFromPairs: { 'x'. 42. 'y'. '77'. 'z'. 0.1 }). self assert: (self encode: Dictionary new) = '{}'. self assert: (self encode: (Dictionary newFromPairs: { 'foo'. 'bar' })) equals: '{"foo": "bar"}'. self assert: (self encode: (Dictionary newFromPairs: { 'stuff'. #(() 42 'hello') })) equals: '{"stuff": [[], 42, "hello"]}'. self assert: (self encode: (Dictionary newFromPairs: { 'x'. 42. 'y'. '77'. 'z'. 0.1 })) equals: '{"x": 42, "y": "77", "z": 0.1}'. self should: [self decode: '{'] raise: Error. self should: [self decode: '{]'] raise: Error. self should: [self decode: '[{]'] raise: Error. self should: [self decode: '{"a"}'] raise: Error. self should: [self decode: '{42: "hello"}'] raise: Error. self should: [self decode: '{"a" : 42,}'] raise: Error. self should: [self decode: '{"a" : 42 "b": 33}'] raise: Error. self should: [self encode: (Dictionary newFromPairs: {1. 1})] raise: Error.! ----- Method: WebClientServerTest>>testDigestAuth (in category 'tests - auth') ----- testDigestAuth "Test client and server handling of digest auth" | resp reqHeader | server addService: '/test/auth' action:[:req | server authenticate: req realm: 'test' methods: #(digest) do:[ reqHeader := req headerAt: 'Authorization'. req send200Response: 'ok' ]. ]. resp := WebClient new httpGet: self localHostUrl, '/test/auth'. self assert: resp code = 401. [resp := WebClient httpGet: self localHostUrl, '/test/auth'] on: WebAuthRequired do:[:ex| ex username: 'squeak' password: 'squeak']. self assert: resp code = 401. [resp := WebClient httpGet: self localHostUrl, '/test/auth'] on: WebAuthRequired do:[:ex| ex username: 'user' password: 'pass']. self assert: resp code = 200. self assert: resp content = 'ok'. self assert: (reqHeader beginsWith: 'Digest '). ! ----- Method: WebClientServerTest>>testDuplicateCookies (in category 'tests - cookies') ----- testDuplicateCookies "Tests deleting cookies in WebClient" | resp client | "Sends the testcookie back if it's set" server addService: '/' action:[:req | req send200Response: (req headersAt: 'cookie') size asString. ]. "Sets the cookie" server addService: '/cookie/set' action:[:req | req send200Response: 'ok' contentType: 'text/plain' do:[:reply| reply setCookie: 'testcookie' value: '123' path: '/cookie']]. client := WebClient new. resp := client httpGet: self localHostUrl, '/cookie/set'. self assert: resp code = 200. self assert: resp content = 'ok'. self assert: (resp setCookieAt: 'testcookie') value = '123'. resp := client httpGet: self localHostUrl, '/cookie/set'. resp := client httpGet: self localHostUrl, '/cookie/set'. resp := client httpGet: self localHostUrl, '/cookie/test'. self assert: resp code = 200. self assert: resp content = '1'. ! ----- Method: WebClientServerTest>>testGetFields (in category 'tests - fields') ----- testGetFields "Test client and server handling simple fields" | resp | server addService: '/fields' action:[:req | req send200Response: (String streamContents:[:s| req fields keys asArray sort do:[:key | s cr; nextPutAll: key,'=', (req fields at: key)]. ]). ]. resp := WebClient httpGet: self localHostUrl, '/fields?foo=123&bar=yoho'. self assert: resp code = 200. self assert: resp content = ' bar=yoho foo=123'. ! ----- Method: WebClientServerTest>>testHmacSha1 (in category 'tests - oauth') ----- testHmacSha1 "Test the SHA1 HMAC algorithm" | key message | key := 'MCD8BKwGdgPHvAuvgvz4EQpqDAtx89grbuNMRd7Eh98&'. message := 'POST&https%3A%2F%2Fapi.twitter.com%2Foauth%2Frequest_token&oauth_callback%3Dhttp%253A%252F%252Flocalhost%253A3005%252Fthe_dance%252Fprocess_callback%253Fservice_provider_id%253D11%26oauth_consumer_key%3DGDdmIQH6jhtmLUypg82g%26oauth_nonce%3DQP70eNmVz8jvdPevU3oJD2AfF7R7odC2XJcn4XlZJqk%26oauth_signature_method%3DHMAC-SHA1%26oauth_timestamp%3D1272323042%26oauth_version%3D1.0'. self assert: (WebUtils hmacSha1: message key: key) base64Encoded = '8wUi7m5HFQy76nowoCThusfgB+Q='! ----- Method: WebClientServerTest>>testHtmlSubmit (in category 'tests - misc') ----- testHtmlSubmit "Ensure that we have round-trip conversion for html submit" | fieldDict fieldList | fieldDict := Dictionary newFromPairs: {'foo'. 123. 'bar'. 'yoho'}. fieldList := {'foo' -> 123. 'bar' -> 'yoho'}. self testHtmlSubmitUsing: fieldDict. self testHtmlSubmitUsing: fieldList.! ----- Method: WebClientServerTest>>testHtmlSubmitUsing: (in category 'tests - misc') ----- testHtmlSubmitUsing: fields "Ensure that we have round-trip conversion for html submit" | resp | server addService: '/fields' action:[:req | req send200Response: (String streamContents:[:s| req fields keys asArray sort do:[:key | s cr; nextPutAll: key,'=', (req fields at: key)]. ]). ]. resp := WebClient htmlSubmit: (self localHostUrl, '/fields') fields: fields. self assert: resp code = 200. self assert: resp content = ' bar=yoho foo=123'. resp := WebClient htmlSubmit: (self localHostUrl, '/fields') fields: fields method: 'POST'. self assert: resp code = 200. self assert: resp content = ' bar=yoho foo=123'. ! ----- Method: WebClientServerTest>>testHttpDelete (in category 'tests - methods') ----- testHttpDelete "Test for handling a DELETE request" | resp | server addService: '/nodelete' action:[:req | req send200Response: 'ok'. ]. server addService: '/delete' action:[:req | req send200Response: req method. ] methods: {'GET'. 'PUT'. 'DELETE'}. resp := WebClient httpGet: self localHostUrl, '/nodelete'. self assert: resp code = 200. resp := WebClient httpDelete: self localHostUrl, '/nodelete'. self assert: resp code = 405. resp := WebClient httpGet: self localHostUrl, '/delete'. self assert: resp code = 200. resp := WebClient httpDelete: self localHostUrl, '/delete'. self assert: resp code = 200. resp := WebClient httpPost: self localHostUrl, '/delete' content:'' type: nil. self assert: resp code = 405. ! ----- Method: WebClientServerTest>>testHttpHead (in category 'tests - methods') ----- testHttpHead "Test for handling a HEAD request" | resp | server addService: '/foo' action:[:req | req send302Response: '/bar' ]. server addService: '/bar' action:[:req | req send200Response: 'ok' ]. resp := WebClient httpHead: self localHostUrl, '/bar'. self assert: resp code = 200. self assert: resp content = ''. self deny: resp contentStream isDataAvailable.. resp := WebClient httpHead: self localHostUrl, '/foo'. self assert: resp code = 200. self assert: resp content = ''. ! ----- Method: WebClientServerTest>>testHttpOptions (in category 'tests - methods') ----- testHttpOptions "Test for handling the OPTIONS request" | resp | server addService: '/delete' action:[:req | req send200Response: req method. ] methods: {'GET'. 'PUT'. 'DELETE'}. resp := WebClient httpOptions: self localHostUrl, '/*'. self assert: resp code = 200. self assert: resp content = ''. self assert: (resp headerAt: 'allow') = 'HEAD,TRACE,OPTIONS,GET,POST'. resp := WebClient httpOptions: self localHostUrl, '/delete'. self assert: resp code = 200. self assert: resp content = ''. self assert: (resp headerAt: 'allow') = 'HEAD,TRACE,OPTIONS,GET,PUT,DELETE'.! ----- Method: WebClientServerTest>>testHttpTrace (in category 'tests - methods') ----- testHttpTrace "Test for handling the TRACE request" | resp | resp := WebClient httpTrace: self localHostUrl, '/bar'. self assert: resp code = 200. self assert: resp contentType = 'message/http'. self assert: resp content = ( 'TRACE /bar HTTP/1.1', String crlf, 'user-agent: ', WebClient new userAgent, String crlf, 'host: localhost:', self port printString, String crlf, String crlf). ! ----- Method: WebClientServerTest>>testInvalidCookies (in category 'tests - cookies') ----- testInvalidCookies "Test client and server handling of cookies" | resp client | "Sends the testcookie back if it's set" server addService: '/' action:[:req | req send200Response: (req cookieAt: 'testcookie'). ]. "Sets the cookie" server addService: '/setcookie' action:[:req | | domain path expires secure | domain := req fields at: 'domain' ifAbsent:[nil]. path := req fields at: 'path' ifAbsent:[nil]. expires := req fields at: 'expires' ifAbsent:[nil]. secure := req fields at: 'secure' ifAbsent:['false']. req send200Response: 'ok' contentType: 'text/plain' do:[:reply| reply setCookie: 'testcookie' value: '123' path: path expires: expires domain: domain secure: secure = 'true'. ] ]. server addService: '/clearcookie' action:[:req | req send200Response: 'ok' contentType: 'text/plain' do:[:reply| reply setCookie: 'testcookie' value: '123' path: '/' expires: DateAndTime new domain: nil secure: false. ] ]. client := WebClient new. resp := client httpGet: self localHostUrl, '/setcookie?path=/'. self assert: resp code = 200. self assert: resp content = 'ok'. self assert: (resp setCookieAt: 'testcookie') value = '123'. resp := client httpGet: self localHostUrl, '/'. self assert: resp code = 200. self assert: resp content = '123'. resp := client httpGet: self localHostUrl, '/clearcookie'. self assert: resp code = 200. resp := client httpGet: self localHostUrl, '/'. self assert: resp code = 200. self deny: resp content = '123'. client := WebClient new. resp := client httpGet: self localHostUrl, '/setcookie?domain=.foo.com'. self assert: resp code = 200. self assert: resp content = 'ok'. self assert: (resp setCookieAt: 'testcookie') value = '123'. resp := client httpGet: self localHostUrl, '/'. self assert: resp code = 200. self deny: resp content = '123'. client := WebClient new. resp := client httpGet: self localHostUrl, '/setcookie?domain=.com'. self assert: resp code = 200. self assert: resp content = 'ok'. self assert: (resp setCookieAt: 'testcookie') value = '123'. resp := client httpGet: self localHostUrl, '/'. self assert: resp code = 200. self deny: resp content = '123'. client := WebClient new. resp := client httpGet: self localHostUrl, '/setcookie?secure=true'. self assert: resp code = 200. self assert: resp content = 'ok'. self assert: (resp setCookieAt: 'testcookie') value = '123'. resp := client httpGet: self localHostUrl, '/'. self assert: resp code = 200. self deny: resp content = '123'. ! ----- Method: WebClientServerTest>>testListenOnInterface (in category 'tests - misc') ----- testListenOnInterface "Test that listening on a particular interface listens only on that interface" | localHostAddr resp localHostName client | server destroy. "kill old server" localHostAddr := NetNameResolver localHostAddress. localHostAddr asByteArray = #(127 0 0 1) asByteArray ifTrue:[^self]. "skip test" localHostName := NetNameResolver stringFromAddress: localHostAddr. server := WebServer new listenOn: self port interface: localHostAddr. server addService: '/' action:[:req| req send200Response: 'ok']. client := WebClient new. client timeout: 1. self should:[resp := client httpGet: self localHostUrl, '/test'] raise: Error. resp := client httpGet: 'http://', localHostName, ':', self port asString, '/test'. self assert: resp code = 200. self assert: resp content = 'ok'. ! ----- Method: WebClientServerTest>>testLogging200 (in category 'tests - misc') ----- testLogging200 "Test logging a regular 200 a-ok response" | resp client log | server addService: '/test' action:[:req | req send200Response: 'ok']. server accessLog: String new writeStream. client := WebClient new. client accessLog: String new writeStream. [resp := client httpGet: self localHostUrl, '/test'] ensure:[client close]. self assert: resp code = 200. log := server accessLog contents. self assert: ('127.0.0.1 - - [*] "GET /test HTTP/1.1" 200 2', String cr match: log). log := client accessLog contents. self assert: ('localhost - - [*] "GET /test HTTP/1.1" 200 2', String cr match: log). ! ----- Method: WebClientServerTest>>testLogging404 (in category 'tests - misc') ----- testLogging404 "Test logging a 404 response" | resp client log | server accessLog: String new writeStream. client := WebClient new. client accessLog: String new writeStream. [resp := client httpGet: self localHostUrl] ensure:[client close]. self assert: resp code = 404. log := server accessLog contents. self assert: ('127.0.0.1 - - [*] "GET / HTTP/1.1" 404 145', String cr match: log). log := client accessLog contents. self assert: ('localhost - - [*] "GET / HTTP/1.1" 404 145', String cr match: log). ! ----- Method: WebClientServerTest>>testMultipartFields (in category 'tests - fields') ----- testMultipartFields "Test client and server handling multipart/form-data fields" | resp | server addService: '/fields' action:[:req | req send200Response: (String streamContents:[:s| req fields keys asArray sort do:[:key | s cr; nextPutAll: key,'=', (req fields at: key)]. ]). ]. resp := WebClient httpPost: self localHostUrl,'/fields' multipartFields: { 'foo' -> 123. 'bar' -> 'yoho'. }. self assert: resp code = 200. self assert: resp content = ' bar=yoho foo=123'. ! ----- Method: WebClientServerTest>>testMultipartFiles (in category 'tests - fields') ----- testMultipartFiles "Test client and server handling multipart/form-data fields for file uploads" | resp request document firstPart | server addService: '/fields' action:[:req | request := req. req send200Response: (String streamContents:[:s| req fields keys asArray sort do:[:key | s cr; nextPutAll: key,'=', (req fields at: key)]. ]). ]. document := MIMEDocument contentType: 'text/webclient-test' content: 'Hello World, this is a sample file' url: FileDirectory default url,'test.txt'. resp := WebClient httpPost: self localHostUrl,'/fields' multipartFields: { 'upload' -> document. }. "First test just verifies that uploaded documents look just like other fields" self assert: resp code = 200. self assert: resp content = ' upload=Hello World, this is a sample file'. "Second test verifies that we have the additional data from a file upload" firstPart := true. request multipartFieldsDo:[:headers :params :content| self assert: firstPart. "should only have one part" self assert: (params at: 'name') = 'upload'. self assert: (params at: 'filename') = (FileDirectory default fullNameFor: 'test.txt'). self assert: (headers at: 'content-type') = 'text/webclient-test'. firstPart := false. ]. ! ----- Method: WebClientServerTest>>testMultipartFiles2 (in category 'tests - fields') ----- testMultipartFiles2 "Same as testMultpartFiles but this time using HTTPSocket API" | resp request document firstPart fields | server addService: '/fields' action:[:req | request := req. req send200Response: (String streamContents:[:s| req fields keys asArray sort do:[:key | s cr; nextPutAll: key,'=', (req fields at: key)]. ]). ]. document := MIMEDocument contentType: 'text/webclient-test' content: 'Hello World, this is a sample file' url: FileDirectory default url,'test.txt'. fields := Dictionary new. fields at: 'upload' put: {document}. "Make sure we're *actually* using HTTPSocket and not WebClient (if it's registered as HTTP handler in HTTPSocket)" (HTTPSocket respondsTo: #httpRequestHandler:) ifTrue:[ | oldHandler | oldHandler := HTTPSocket httpRequestHandler. [HTTPSocket httpRequestHandler: nil. resp := (self localHostUrl,'/fields') asUrl postMultipartFormArgs: fields. ] ensure:[HTTPSocket httpRequestHandler: oldHandler]. ] ifFalse:[ resp := (self localHostUrl,'/fields') asUrl postMultipartFormArgs: fields. ]. "First test just verifies that uploaded documents look just like other fields" self assert: resp content = ' upload=Hello World, this is a sample file'. "Verifies that we have the additional data from a file upload" firstPart := true. request multipartFieldsDo:[:headers :params :content| self assert: firstPart. "should only have one part" self assert: (params at: 'name') = 'upload'. self assert: (params at: 'filename') = (FileDirectory default fullNameFor: 'test.txt'). self assert: (headers at: 'content-type') = 'text/webclient-test'. firstPart := false. ]. ! ----- Method: WebClientServerTest>>testNestedAction (in category 'tests - misc') ----- testNestedAction "Test handling of nested actions" | resp | server addService: '/test' action:[:req | req send200Response: 'ok']. server addService: '/test/42' action:[:req | req send200Response: '42']. resp := WebClient httpGet: self localHostUrl, '/test'. self assert: resp code = 200. self assert: resp content = 'ok'. resp := WebClient httpGet: self localHostUrl, '/test/42'. self assert: resp code = 200. self assert: resp content = '42'. resp := WebClient httpGet: self localHostUrl, '/test/43'. self assert: resp code = 200. self assert: resp content = 'ok'. ! ----- Method: WebClientServerTest>>testNilTrueFalse (in category 'tests - json') ----- testNilTrueFalse "Test encodings of nil, true, false" self assert: (self decode: 'true') = true. self assert: (self decode: 'false') = false. self assert: (self decode: 'null') = nil. self assert: (self encode: true) = 'true'. self assert: (self encode: false) = 'false'. self assert: (self encode: nil) = 'null'. self should: [self decode: 'nul'] raise: Error. self should: [self decode: 'nullll'] raise: Error. self should: [self decode: 'tru'] raise: Error. self should: [self decode: 'falsef'] raise: Error. self should: [self decode: 'truefalse'] raise: Error. ! ----- Method: WebClientServerTest>>testNo302Redirect (in category 'tests - redirect') ----- testNo302Redirect "Ensure compliance with RFC 2616 rules prohibiting auto redirect for 302/307 responses." | resp | server addService: '/302' action:[:req | req send3xxResponse: '/bar' code: 302 ] methods: #('GET' 'PUT' 'POST' 'DELETE'). server addService: '/307' action:[:req | req send3xxResponse: '/bar' code: 307 ] methods: #('GET' 'PUT' 'POST' 'DELETE'). server addService: '/bar' action:[:req | req send200Response: 'redirect ok' ] methods: #('GET' 'PUT' 'POST' 'DELETE'). resp := WebClient httpGet: self localHostUrl, '/302'. self assert: resp code = 200. self assert: resp content = 'redirect ok'. resp := WebClient httpGet: self localHostUrl, '/307'. self assert: resp code = 200. self assert: resp content = 'redirect ok'. resp := WebClient httpPost: self localHostUrl, '/302' content: '' type: 'text/plain'. self assert: resp code = 302. resp := WebClient httpPost: self localHostUrl, '/307' content: '' type: 'text/plain'. self assert: resp code = 307. resp := WebClient httpPost: self localHostUrl, '/302' content: '' type: 'text/plain'. self assert: resp code = 302. resp := WebClient httpPost: self localHostUrl, '/307' content: '' type: 'text/plain'. self assert: resp code = 307. resp := WebClient httpPut: self localHostUrl, '/302' content: '' type: 'text/plain'. self assert: resp code = 302. resp := WebClient httpPut: self localHostUrl, '/307' content: '' type: 'text/plain'. self assert: resp code = 307. resp := WebClient httpDelete: self localHostUrl, '/302'. self assert: resp code = 302. resp := WebClient httpDelete: self localHostUrl, '/307'. self assert: resp code = 307. ! ----- Method: WebClientServerTest>>testNumbers (in category 'tests - json') ----- testNumbers "Test the encodings of numbers" self assert: 42 equals: (self decode: '42'). self assert: -123 equals: (self decode: '-0123'). self assert: 42.3 equals: (self decode: '42.3'). self assert: -42.3e44 equals: (self decode: '-42.3e44'). self assert: -0.0 equals: (self decode: '-0.0e0'). self assert: '42' equals: (self encode: 42). self assert: '-123' equals: (self encode: -123). self assert: '42.3' equals: (self encode: 42.3). self assert: '-4.23e45' equals: (self encode: -42.3e44). self assert: '-0.0' equals: (self encode: -0.0e0). self should: [self decode: '0x123'] raise: Error. self should: [self decode: '-.e'] raise: Error. ! ----- Method: WebClientServerTest>>testPersistentAuthRedirectSession (in category 'tests - redirect') ----- testPersistentAuthRedirectSession "Run a test for a full auth-redirect-cookie loop. Ensure that the connection is persistent for the entire loop." | loginOK finalUrl finalFields firstRedirect client resp url | server addService: '/login' action:[:req | server authenticate: req realm: 'test' methods: #(digest) do:[ | id | loginOK := true. server sessionAt: (id := UUID new hex) put: ''. req send302Response: (req fields at: 'url' ifAbsent:['/']) unescapePercents do:[:reply| reply setCookie: 'session' value: id path: '/']]]. server addService: '/action' action:[:req | (server sessionAt: (req cookieAt: 'session')) ifNil:[ firstRedirect := true. req send302Response: '/login?url=', req rawUrl encodeForHTTP. ] ifNotNil:[ finalUrl := req url. finalFields := req fields. req send200Response: 'ok'. ]. ]. firstRedirect := loginOK := false. server passwordAt: 'squeak' realm: 'test' put: 'foo'. client := WebClient new. client allowRedirect: false. url := self localHostUrl, '/action/foo/bar?string=hello&number=42'. [[resp := client httpGet: url] on: WebAuthRequired do:[:ex| self assert: client == ex client. self assert: client isConnected. ex username: 'squeak' password: 'foo'.]. resp code = 302] whileTrue:[ self assert: client isConnected. url := resp headerAt: 'Location'. ]. self assert: client isConnected. self assert: resp code = 200. self assert: firstRedirect. self assert: loginOK. self assert: finalUrl = '/action/foo/bar'. self assert: finalFields size = 2. self assert: (finalFields at: 'string') = 'hello'. self assert: (finalFields at: 'number') = '42'. ! ----- Method: WebClientServerTest>>testPostFields (in category 'tests - fields') ----- testPostFields "Test client and server handling fields in url-encoded encoded post requests" | resp | server addService: '/fields' action:[:req | req send200Response: (String streamContents:[:s| req fields keys asArray sort do:[:key | s cr; nextPutAll: key,'=', (req fields at: key)]. ]). ]. resp := WebClient httpPost: self localHostUrl, '/fields' content: 'foo=123&bar=yoho' type: 'application/x-www-form-urlencoded'. self assert: resp code = 200. self assert: resp content = ' bar=yoho foo=123'. ! ----- Method: WebClientServerTest>>testRedirect (in category 'tests - redirect') ----- testRedirect "Test client and server handling of redirects" | resp client | server addService: '/foo' action:[:req | req send302Response: '/bar' ]. server addService: '/bar' action:[:req | req send200Response: 'redirect ok' ]. client := WebClient new. resp := client httpGet: self localHostUrl, '/foo'. self assert: resp code = 200. self assert: resp content = 'redirect ok'. client allowRedirect: false. resp := client httpGet: self localHostUrl, '/foo'. self assert: resp code = 302. client allowRedirect: true. resp := client httpGet: self localHostUrl, '/foo'. self assert: resp code = 200. self assert: resp content = 'redirect ok'. ! ----- Method: WebClientServerTest>>testRedirectLoop (in category 'tests - redirect') ----- testRedirectLoop "Test client handling of redirect loops" | resp | server addService: '/foo' action:[:req | req send302Response: '/bar' ]. server addService: '/bar' action:[:req | req send302Response: '/foo' ]. resp := WebClient httpGet: self localHostUrl, '/foo'. self assert: resp code = 302. ! ----- Method: WebClientServerTest>>testRedirectTrailingSlash (in category 'tests - redirect') ----- testRedirectTrailingSlash "Special test to ensure that a redirect from /foo to /foo/ works" | resp client | server addService: '/foo' action:[:req | req send302Response: '/foo/' ]. server addService: '/foo/' action:[:req | req send200Response: 'redirect ok' ]. client := WebClient new. resp := client httpGet: self localHostUrl, '/foo'. self assert: resp code = 200. self assert: resp content = 'redirect ok'. ! ----- Method: WebClientServerTest>>testResponseUrl (in category 'tests - misc') ----- testResponseUrl "Tests that the response url is pointing to the final location" | resp client | server addService: '/foo' action:[:req | req send302Response: '/bar' ]. server addService: '/bar' action:[:req | req send200Response: 'redirect ok' ]. client := WebClient new. resp := client httpGet: self localHostUrl, '/foo'. self assert: resp code = 200. self assert: resp url = (self localHostUrl, '/bar'). client := WebClient new. client allowRedirect: false. resp := client httpGet: self localHostUrl, '/foo'. self assert: resp code = 302. self assert: resp url = (self localHostUrl, '/foo'). ! ----- Method: WebClientServerTest>>testSchemeHandling (in category 'tests - https') ----- testSchemeHandling "Ensure that we handle only http and https schemes" self shouldnt:[WebClient httpGet: 'http://localhost:', self port asString] raise: Error. self should:[WebClient httpGet: 'ftp://localhost:', self port asString] raise: Error. ! ----- Method: WebClientServerTest>>testServerDestroy (in category 'tests - misc') ----- testServerDestroy "Tests that connections get nuked when server gets killed" | client resp | server addService: '/test' action:[:req | req send200Response: 'ok']. client := WebClient new. resp := client httpGet: self localHostUrl, '/test'. self assert: resp code = 200. self assert: resp content = 'ok'. self assert: client isConnected. self assert: server connections size = 1. server destroy. "Depending on OS the signal may not be delivered synchronously and raise ConnectionClosed in the (signaling) peek. Give it a bit of time to deal with the close." (Delay forMilliseconds: 100) wait. "Make stream non-blocking otherwise peek can blow up in our face" resp contentStream shouldSignal: false. self assert: resp contentStream peek == nil. self deny: client isConnected ! ----- Method: WebClientServerTest>>testServerError (in category 'tests - misc') ----- testServerError "Test server handling of errors" | resp | server addService: '/test' action:[:req | self error: 'boom']. resp := WebClient httpGet: self localHostUrl, '/test'. self assert: resp code = 500. ! ----- Method: WebClientServerTest>>testServerRegistry (in category 'tests - misc') ----- testServerRegistry "Ensure that the WebServer registry functions as intended" | serverA serverB | ["Create a new server" serverA := WebServer forUrl: 'http://foo.bar.com'. serverA listenOn: self port+1. self assert: serverA notNil. self assert: serverA isRunning. "Look it up again" serverB := WebServer forUrl: 'http://foo.bar.com'. self assert: serverA == serverB. "Override with a new one (should shutdown serverA)" serverB := WebServer newForUrl: 'http://foo.bar.com'. self deny: serverA == serverB. self deny: serverA isRunning. "Destroy (should de-register serverB)" serverB destroy. self assert: (WebServer forUrl: 'http://foo.bar.com' ifAbsent:[nil]) == nil ] ensure:[ serverA ifNotNil:[serverA destroy]. serverB ifNotNil:[serverB destroy]. ].! ----- Method: WebClientServerTest>>testSignOAuthGet (in category 'tests - oauth') ----- testSignOAuthGet "Ensure that we can sign a request correctly using OAuth. Example values taken from http://oauth.googlecode.com/svn/code/javascript/example/signature.html " | request | request := WebRequest new. request method: 'GET'. WebUtils oAuthSign: request url: 'http://host.net/resource' using: self oAuthParams. self assert: (request headerAt: 'Authorization') equals: 'OAuth oauth_consumer_key="abcd",oauth_nonce="FWNkVaRJVzE",oauth_signature_method="HMAC-SHA1",oauth_timestamp="1281668113",oauth_token="ijkl",oauth_version="1.0",oauth_signature="dSI3zjYnriSnaB787UH2NDcS8Ss%3D"'. ! ----- Method: WebClientServerTest>>testSignOAuthGetDupFields (in category 'tests - oauth') ----- testSignOAuthGetDupFields "Ensure that we can sign a request with duplicate fields correctly using OAuth. Example values taken from http://oauth.googlecode.com/svn/code/javascript/example/signature.html " | request | request := WebRequest new. request method: 'GET'. WebUtils oAuthSign: request url: 'http://host.net/resource?name=value&name=value' using: self oAuthParams. self assert: (request headerAt: 'Authorization') equals: 'OAuth oauth_consumer_key="abcd",oauth_nonce="FWNkVaRJVzE",oauth_signature_method="HMAC-SHA1",oauth_timestamp="1281668113",oauth_token="ijkl",oauth_version="1.0",oauth_signature="30p67coAX8YbxCKAGfaimydYK6g%3D"'. ! ----- Method: WebClientServerTest>>testSignOAuthGetFields (in category 'tests - oauth') ----- testSignOAuthGetFields "Ensure that we can sign a GET request with fields correctly using OAuth. Example values taken from http://oauth.googlecode.com/svn/code/javascript/example/signature.html " | request | request := WebRequest new. request method: 'GET'. WebUtils oAuthSign: request url: 'http://host.net/resource?name=value' using: self oAuthParams. self assert: (request headerAt: 'Authorization') equals: 'OAuth oauth_consumer_key="abcd",oauth_nonce="FWNkVaRJVzE",oauth_signature_method="HMAC-SHA1",oauth_timestamp="1281668113",oauth_token="ijkl",oauth_version="1.0",oauth_signature="N6TOtNK6h3u9zqjqaF2kgpIVb%2F8%3D"'. ! ----- Method: WebClientServerTest>>testSignOAuthPostFields (in category 'tests - oauth') ----- testSignOAuthPostFields "Ensure that we can sign a POST request with fields correctly using OAuth. Example values taken from http://oauth.googlecode.com/svn/code/javascript/example/signature.html " | request | request := WebRequest new. request method: 'POST'. WebUtils oAuthSign: request url: 'http://host.net/resource' extra:{'name' -> 'value'} using: self oAuthParams. self assert: (request headerAt: 'Authorization') equals: 'OAuth oauth_consumer_key="abcd",oauth_nonce="FWNkVaRJVzE",oauth_signature_method="HMAC-SHA1",oauth_timestamp="1281668113",oauth_token="ijkl",oauth_version="1.0",oauth_signature="E7yVjmf%2F8UTF9ij15CtbBBhulMw%3D"'. ! ----- Method: WebClientServerTest>>testSignOAuthUrlEncoding (in category 'tests - oauth') ----- testSignOAuthUrlEncoding "Ensure that we can sign a request requiring url-encoded oauth params. Example values taken from http://oauth.googlecode.com/svn/code/javascript/example/signature.html " | params request | "Consumer Key with url-encoded characters" params := self oAuthParams. params at: 'oauth_consumer_key' put: 'key with spaces'. request := WebRequest new. request method: 'GET'. WebUtils oAuthSign: request url: 'http://host.net/resource' using: params. self assert: (request headerAt: 'Authorization') equals: 'OAuth oauth_consumer_key="key%20with%20spaces",oauth_nonce="FWNkVaRJVzE",oauth_signature_method="HMAC-SHA1",oauth_timestamp="1281668113",oauth_token="ijkl",oauth_version="1.0",oauth_signature="%2FxrAsx0Utt3V6ZbX00jWWpkqrvg%3D"'.! ----- Method: WebClientServerTest>>testSimpleServerAction (in category 'tests - misc') ----- testSimpleServerAction "Test client and server handling simple defaults" | resp srvr | server addService: '/test' action:[:req | srvr := req server. req send200Response: 'ok']. resp := WebClient httpGet: self localHostUrl, '/test'. self assert: srvr notNil. self assert: resp code = 200. self assert: resp content = 'ok'. ! ----- Method: WebClientServerTest>>testStreaming (in category 'tests - misc') ----- testStreaming "Run a test for a full auth-redirect-cookie loop" | resp amount stream | amount := 128*1024. server addService: '/streaming' action:[:req| req stream200Response: (String new: amount) readStream size: amount. ]. resp := WebClient httpGet: self localHostUrl, '/streaming'. self assert: resp isSuccess. stream := WriteStream on: String new. resp streamTo: stream size: resp contentLength progress: nil. self assert: stream position = amount. ! ----- Method: WebClientServerTest>>testStrings (in category 'tests - json') ----- testStrings "Test string encodings" self assert: (self decode: '"Hello World"') = 'Hello World'. self assert: (self decode: '"\"Hello World\""') = '"Hello World"'. self assert: (self decode: '"foo\\bar\/baz"') = 'foo\bar/baz'. self assert: (self decode: '""') = ''. self assert: (self decode: '"foo \u0026 bar"') = 'foo & bar'. self assert: (self decode: '"\r\n"') = String crlf. self assert: (self decode: '"\u041F\u0440\u0430\u0432\u0434\u0430"') equals: #[208 159 209 128 208 176 208 178 208 180 208 176] asString utf8ToSqueak. self assert: (self encode: 'Hello World') = '"Hello World"'. self assert: (self encode: '"Hello World"') = '"\"Hello World\""'. self assert: (self encode: 'foo\bar/baz') = '"foo\\bar\/baz"'. self assert: (self encode: '') = '""'. self assert: (self encode: 'foo ', (Character value: 257),' bar') = '"foo \u0101 bar"'. self assert: (self encode: String crlf) = '"\r\n"'. self assert: (self encode: #[208 159 209 128 208 176 208 178 208 180 208 176] asString utf8ToSqueak) equals: '"\u041F\u0440\u0430\u0432\u0434\u0430"'. self should: [self decode: '"hello'] raise: Error. self should: [self decode: '"\'] raise: Error. self should: [self decode: '"\"'] raise: Error.! ----- Method: WebClientServerTest>>testTransientPostContent (in category 'tests - misc') ----- testTransientPostContent "Ensure that WebRequest>>content doesn't close the socket when used in a transient post request" | resp client | server addService: '/test' action:[:req | req send200Response: req content]. client := WebClient new. resp := client httpPost: self localHostUrl, '/test' content:'hello' type: nil do:[:req| req protocol: 'HTTP/1.0' ]. self assert: resp code = 200. self assert: resp content = 'hello'. ! ----- Method: WebClientServerTest>>testUrlEncoding (in category 'tests - misc') ----- testUrlEncoding "Test the default URL encoding behavior" | resp | server addService: '/hello world' action:[:req| req send200Response: 'ok'. ]. resp := WebClient httpGet: self localHostUrl, '/hello%20world'. self assert: resp code = 200. self assert: resp content = 'ok'. resp := WebClient httpGet: (WebUtils urlEncode: self localHostUrl, '/hello world'). self assert: resp code = 200. self assert: resp content = 'ok'. ! ----- Method: WebClientServerTest>>testWebSocketHash07 (in category 'tests - websockets') ----- testWebSocketHash07 "self run: #testWebSocketHash07" "From http://tools.ietf.org/html/draft-ietf-hybi-thewebsocketprotocol-07" | hash key | key := 'dGhlIHNhbXBsZSBub25jZQ=='. hash := WebUtils webSocketHash07: key. self assert: hash = 's3pPLMBiTxaQ9kYGzzhZRbK+xOo='.! ----- Method: WebClientServerTest>>testWebSockets (in category 'tests - websockets') ----- testWebSockets "Test the WebSocket interface" self testWebSockets:[ WebClient webSocketTo: self localHostUrl,'/websockets'. ]. ! ----- Method: WebClientServerTest>>testWebSockets00 (in category 'tests - websockets') ----- testWebSockets00 "Test the WebSocket interface" self testWebSockets:[ WebClient webSocket00: self localHostUrl,'/websockets' protocol: 'sample' ]. ! ----- Method: WebClientServerTest>>testWebSockets07 (in category 'tests - websockets') ----- testWebSockets07 "Test the WebSocket interface" self testWebSockets:[ WebClient webSocket07: self localHostUrl,'/websockets' protocol: 'sample' ]. ! ----- Method: WebClientServerTest>>testWebSockets07ControlDecode (in category 'tests - websockets') ----- testWebSockets07ControlDecode "Tests from section 4.7 of the WebSockets spec" | ws ping pong | ws := WebSocket07 new. ws onPing:[:msg| ping := msg asString]. ws onPong:[:msg| pong := msg asString]. ping := pong := nil. ws readFrameFrom: #[16r89 16r05 16r48 16r65 16r6C 16r6C 16r6F] readStream. "contains a body of 'Hello', but the contents of the body are arbitrary)" self assert: ping = 'Hello'. self assert: pong = nil. ping := pong := nil. ws readFrameFrom: #[16r8A 16r05 16r48 16r65 16r6C 16r6C 16r6F] readStream. "contains a body of 'Hello', matching the body of the ping)" self assert: ping = nil. self assert: pong = 'Hello'. ! ----- Method: WebClientServerTest>>testWebSockets07ControlInterleave (in category 'tests - websockets') ----- testWebSockets07ControlInterleave "Test the WebSocket 07 control interleave" | sema cws resp ping pong | ping := 'Hello Ping'. server addService: '/websockets' action:[:req | | sws | sws := req asWebSocket. sws onMessage:[:sdata| sws send: sdata]. sws onPing:[:sdata| sws pong: sdata]. sws onError:[:ex| Transcript cr; show: ex description. Transcript cr; show: ex signalerContext longStack. ]. sws run. ]. sema := Semaphore new. cws := WebClient webSocket07: self localHostUrl,'/websockets' protocol: nil. cws onMessage:[:cdata| resp := cdata. sema signal]. cws onPong:[:cdata| pong := cdata asString. sema signal.]. cws fork. cws send: 'Über-cool'. sema wait. self assert: (resp = 'Über-cool'). cws firstFragment: 'First,'. cws nextFragment: 'Next,'. cws lastFragment: 'Last.'. sema wait. self assert: (resp = 'First,Next,Last.'). self deny: sema isSignaled. resp := nil. cws firstFragment: 'First,'. cws ping: ping. sema wait. self assert: ping = pong. "i.e., roundtrip finished" self assert: resp == nil. "i.e., fragment not delivered yet" self deny: sema isSignaled. cws nextFragment: 'Next,'. cws lastFragment: 'Last.'. sema wait. self assert: (resp = 'First,Next,Last.'). cws close.! ----- Method: WebClientServerTest>>testWebSockets07DataDecode (in category 'tests - websockets') ----- testWebSockets07DataDecode "Tests from section 4.7 of the WebSockets spec" | data ws | ws := WebSocket07 new. ws onMessage:[:msg| data := msg]. "A single-frame unmasked text message" data := nil. ws readFrameFrom: #[16r81 16r05 16r48 16r65 16r6C 16r6C 16r6F] readStream. self assert: data = 'Hello'. "A single-frame masked text message" data := nil. ws readFrameFrom: #[16r81 16r85 16r37 16rFA 16r21 16r3D 16r7F 16r9F 16r4D 16r51 16r58] readStream. self assert: data = 'Hello'. "A fragmented unmasked text message" data := nil. ws readFrameFrom: #[16r01 16r03 16r48 16r65 16r6C] readStream. "contains 'Hel'" self assert: data = nil. ws readFrameFrom: #[16r80 16r02 16r6C 16r6F] readStream. "contains 'lo'" self assert: data = 'Hello'. ! ----- Method: WebClientServerTest>>testWebSockets07NoMask (in category 'tests - websockets') ----- testWebSockets07NoMask "Test the WebSocket interface" self testWebSockets:[ (WebClient webSocket07: self localHostUrl,'/websockets' protocol: 'sample') masking: false; yourself]. ! ----- Method: WebClientServerTest>>testWebSockets68 (in category 'tests - websockets') ----- testWebSockets68 "Test the WebSocket interface" self testWebSockets:[ WebClient webSocket68: self localHostUrl,'/websockets' protocol: 'sample'. ]. ! ----- Method: WebClientServerTest>>testWebSockets: (in category 'tests - websockets') ----- testWebSockets: aBlock "Test the WebSocket interface" | sema cws resp sws | server addService: '/websockets' action:[:req | sws := req asWebSocket. sws onError:[:ex| Transcript cr; show: ex description. Transcript cr; show: ex signalerContext longStack. ]. sws onMessage:[:sdata| sws send: 'Response: ', sdata]. sws run. ]. sema := Semaphore new. cws := aBlock value. cws onMessage:[:cdata| resp := cdata. sema signal]. cws onClose:[resp := nil. sema signal]. cws fork. cws send: 'Testing, one, two'. sema wait. self assert: (resp = 'Response: Testing, one, two'). cws close. sema wait. self assert: (resp = nil). ! ----- Method: WebClientServerTest>>testWebSocketsFraming (in category 'tests - websockets') ----- testWebSocketsFraming "Test the WebSocket 00 framing" | sema cws resp frameType | server addService: '/websockets' action:[:req | | sws | sws := req asWebSocket. sws onMessage:[:sdata :type| sws send: sdata type: type]. sws onError:[:ex| Transcript cr; show: ex description. Transcript cr; show: ex signalerContext longStack. ]. sws run. ]. sema := Semaphore new. cws := WebClient webSocket00: self localHostUrl,'/websockets' protocol: nil. cws onMessage:[:cdata :type| resp := cdata. frameType := type. sema signal]. cws onClose:[resp := nil. frameType := 255. sema signal]. cws fork. cws send: 'Über-cool'. sema wait. self assert: (resp = 'Über-cool'). self assert: (frameType = 0). cws send: 'Über-funny' type: 15. sema wait. self assert: (resp = 'Über-funny'). self assert: (frameType = 15). cws send: (String new: 100) type: 0. sema wait. self assert: (resp = (String new: 100)). self assert: (frameType = 0). cws send: (ByteArray new: 100) type: 130. sema wait. self assert: (resp = (ByteArray new: 100)). self assert: (frameType = 130). cws close. sema wait. self assert: (resp = nil). self assert: (frameType = 255).!

1 0

Squeak 4.6: Help-Squeak-SWiki-mt.2.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of Help-Squeak-SWiki to project Squeak 4.6: http://source.squeak.org/squeak46/Help-Squeak-SWiki-mt.2.mcz ==================== Summary ==================== Name: Help-Squeak-SWiki-mt.2 Author: mt Time: 10 May 2015, 1:55:51.449 pm UUID: 76848f48-14f6-c540-860a-a42fd4259c1b Ancestors: Help-Squeak-SWiki-mt.1 Only support opening SWiki in HelpBrowser directly. Ignore it if embedded in other help structures. SWiki help integration is still experimental and should not confuse other users. ==================== Snapshot ==================== SystemOrganization addCategory: #'Help-Squeak-SWiki'! CustomHelp subclass: #SWikiHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Help-Squeak-SWiki'! !SWikiHelp commentStamp: 'mt 5/10/2015 13:52' prior: 0! HelpBrowser openOn: SWikiHelp.! ----- Method: SWikiHelp class>>asHelpTopic (in category 'converting') ----- asHelpTopic ^ HtmlHelpTopic new url: 'http://wiki.squeak.org/squeak'; selectBlock: [:url | ((url beginsWith: '/squeak/') and: [(url includes: $.) not ".edit, .history, ..."]) and: [url last isDigit]]; convertBlock: [:url | 'http://wiki.squeak.org', url]; yourself! ----- Method: SWikiHelp class>>ignore (in category 'accessing') ----- ignore "Experimental." ^ true!

1 0

Squeak 4.6: Squeak-Version-ar.4662.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of Squeak-Version to project Squeak 4.6: http://source.squeak.org/squeak46/Squeak-Version-ar.4662.mcz ==================== Summary ==================== Name: Squeak-Version-ar.4662 Author: ar Time: 12 December 2009, 6:35:21.375 pm UUID: 6bfece28-65a4-b147-9462-417b2e86acd0 Ancestors: Initial version of the stub version package to track image version number. Starts with 4662 since the sum of version numbers in the very first trunk config map (update.ar-1) was 2518.. 3.10.2 had as highest update 7179 so we use 7179 - 2518 + 1 = 4662 as a base. (it really doesn't matter all that much, we just don't want to go backwards in version numbers) ==================== Snapshot ====================

1 0

Squeak 4.6: ToolsTests-topa.72.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of ToolsTests to project Squeak 4.6: http://source.squeak.org/squeak46/ToolsTests-topa.72.mcz ==================== Summary ==================== Name: ToolsTests-topa.72 Author: topa Time: 14 April 2015, 10:31:36.416 am UUID: 0c975601-52ad-4b6f-96a5-1197a85f7a32 Ancestors: ToolsTests-mt.71 Adapt BrowserTests to rely less on global state, namely SystemOrganization ==================== Snapshot ==================== SystemOrganization addCategory: #'ToolsTests-Browser'! SystemOrganization addCategory: #'ToolsTests-Debugger'! SystemOrganization addCategory: #'ToolsTests-FileList'! SystemOrganization addCategory: #'ToolsTests-Inspector'! TestCase subclass: #BrowseTest instanceVariableNames: 'originalBrowserClass originalHierarchyBrowserClass' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! ----- Method: BrowseTest>>currentBrowsers (in category 'private') ----- currentBrowsers ^ (ActiveWorld submorphs select: [:each | (each isKindOf: SystemWindow) and: [each model isKindOf: Browser]]) asSet! ----- Method: BrowseTest>>currentHierarchyBrowsers (in category 'private') ----- currentHierarchyBrowsers ^ (ActiveWorld submorphs select: [:each | (each isKindOf: SystemWindow) and: [each model isKindOf: HierarchyBrowser]]) asSet! ----- Method: BrowseTest>>ensureMorphic (in category 'private') ----- ensureMorphic self isMorphic ifFalse: [self error: 'This test should be run in Morphic'].! ----- Method: BrowseTest>>isMorphic (in category 'private') ----- isMorphic ^Smalltalk isMorphic! ----- Method: BrowseTest>>setUp (in category 'running') ----- setUp | systemNavigation | systemNavigation := SystemNavigation default. originalBrowserClass := systemNavigation browserClass. originalHierarchyBrowserClass := systemNavigation hierarchyBrowserClass. systemNavigation browserClass: nil. systemNavigation hierarchyBrowserClass: nil. ! ----- Method: BrowseTest>>tearDown (in category 'running') ----- tearDown | systemNavigation | systemNavigation := SystemNavigation default. systemNavigation browserClass: originalBrowserClass. systemNavigation hierarchyBrowserClass: originalHierarchyBrowserClass.! ----- Method: BrowseTest>>testBrowseClass (in category 'testing') ----- testBrowseClass "self debug: #testBrowseClass" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentBrowsers. 1 class browse. browsersAfter := self currentBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! ----- Method: BrowseTest>>testBrowseHierarchyClass (in category 'testing') ----- testBrowseHierarchyClass "self debug: #testBrowseHierarchyClass" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentHierarchyBrowsers. 1 class browseHierarchy. browsersAfter := self currentHierarchyBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! ----- Method: BrowseTest>>testBrowseHierarchyInstance (in category 'testing') ----- testBrowseHierarchyInstance "self debug: #testBrowseHierarchyInstance" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentHierarchyBrowsers. 1 browseHierarchy. browsersAfter := self currentHierarchyBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! ----- Method: BrowseTest>>testBrowseHierarchyMataclass (in category 'testing') ----- testBrowseHierarchyMataclass "self debug: #testBrowseHierarchyMataclass" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentHierarchyBrowsers. 1 class class browseHierarchy. browsersAfter := self currentHierarchyBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == Metaclass). opened delete ! ----- Method: BrowseTest>>testBrowseInstance (in category 'testing') ----- testBrowseInstance "self debug: #testBrowseInstance" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentBrowsers. 1 browse. browsersAfter := self currentBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! ----- Method: BrowseTest>>testBrowseMetaclass (in category 'testing') ----- testBrowseMetaclass "self debug: #testBrowseMetaclass" | browsersBefore browsersAfter opened | self ensureMorphic. browsersBefore := self currentBrowsers. 1 class class browse. browsersAfter := self currentBrowsers. self assert: (browsersAfter size = (browsersBefore size + 1)). opened := browsersAfter removeAll: browsersBefore; yourself. self assert: (opened size = 1). opened := opened asArray first. self assert: (opened model selectedClass == SmallInteger). opened delete ! ----- Method: BrowseTest>>testFindReferencesToFloatNaN (in category 'testing') ----- testFindReferencesToFloatNaN self assert: (SystemNavigation new allCallsOn: (Float bindingOf: #NaN)) notEmpty! ----- Method: BrowseTest>>testSystemNavigationAllBehaviorsDo (in category 'testing') ----- testSystemNavigationAllBehaviorsDo | oc | oc := OrderedCollection new. SystemNavigation new allBehaviorsDo: [:c| oc add: c]. self assert: oc size = oc asSet size! TestCase subclass: #BrowserHierarchicalListTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! !BrowserHierarchicalListTest commentStamp: 'rkrk 8/24/2009 05:11' prior: 0! Tests the optional hierarchical class ordering of Browser.! ----- Method: BrowserHierarchicalListTest>>assertCorrectOrderOf:followedBy:in: (in category 'assertion') ----- assertCorrectOrderOf: classB followedBy: classA in: classCollection "classB comes before classA. Assert that classB is a superclass of classB or that a common superclass is in front of both" | commonSuperclasses commonSuperclass classAIndex classBIndex superIndex | classA == classB ifTrue: [^ self]. (classA inheritsFrom: classB) ifTrue: [^ self]. commonSuperclasses := classA withAllSuperclasses intersection: classB withAllSuperclasses. commonSuperclass := commonSuperclasses first. (classCollection includes: commonSuperclass) ifFalse: [^ self]. classAIndex := classCollection indexOf: classA. classBIndex := classCollection indexOf: classB. superIndex := classCollection indexOf: commonSuperclass. (superIndex < classAIndex and: [superIndex < classBIndex]) ifTrue: [^self]. self fail.! ----- Method: BrowserHierarchicalListTest>>hierarchicalClassListForCategory: (in category 'helper') ----- hierarchicalClassListForCategory: category ^ Browser new selectSystemCategory: category; hierarchicalClassList.! ----- Method: BrowserHierarchicalListTest>>nameToClass: (in category 'helper') ----- nameToClass: classNameWithIndent ^ Smalltalk classNamed: classNameWithIndent withoutLeadingBlanks asSymbol! ----- Method: BrowserHierarchicalListTest>>testListClassesHierarchically1 (in category 'tests') ----- testListClassesHierarchically1 | result classes category | category := 'Collections-Abstract'. result := self hierarchicalClassListForCategory: category. self assert: (SystemOrganization listAtCategoryNamed: category) size equals: result size. classes := result collect: [:ea | self nameToClass: ea]. classes withIndexDo: [:ea : i | classes from: 1 to: i do: [:other | self assertCorrectOrderOf: other followedBy: ea in: classes]].! ----- Method: BrowserHierarchicalListTest>>testListClassesHierarchically2 (in category 'tests') ----- testListClassesHierarchically2 | result classes category | category := 'Tools-Browser'. result := self hierarchicalClassListForCategory: category. self assert: (SystemOrganization listAtCategoryNamed: category) size equals: result size. classes := result collect: [:ea | self nameToClass: ea]. classes withIndexDo: [:ea : i | classes from: 1 to: i do: [:other | self assertCorrectOrderOf: other followedBy: ea in: classes]].! ----- Method: BrowserHierarchicalListTest>>testListClassesHierarchicallyIndent (in category 'tests') ----- testListClassesHierarchicallyIndent | result dict | result := self hierarchicalClassListForCategory: 'Tools-Browser'. "Create class->indent mapping" dict := result inject: Dictionary new into: [:classIndentMapping :className | | indent | indent := className count: [:char | char = Character space or: [char = Character tab]]. classIndentMapping at: (self nameToClass: className) put: indent. classIndentMapping]. "assert that indent of class is larger than indent of superclass" dict keysAndValuesDo: [:class :myIndent | dict at: class superclass ifPresent: [:superIndent | self assert: myIndent > superIndent]].! TestCase subclass: #BrowserTest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! !BrowserTest commentStamp: 'fbs 3/4/2011 07:22' prior: 0! I provide the test suite for Browser. ! ----- Method: BrowserTest>>setUp (in category 'running') ----- setUp browser := Browser new.! ----- Method: BrowserTest>>testAlphabetizeMessageCategories (in category 'as yet unclassified') ----- testAlphabetizeMessageCategories browser selectSystemCategory: browser class category. self deny: browser alphabetizeMessageCategories. browser selectClass: browser class. browser metaClassIndicated: false. self assert: browser alphabetizeMessageCategories. self assert: browser classOrMetaClassOrganizer categories isSorted. browser metaClassIndicated: true. self assert: browser alphabetizeMessageCategories. self assert: browser classOrMetaClassOrganizer categories isSorted.! ----- Method: BrowserTest>>testAlphabetizeMessageCategoriesLeavesClassSelected (in category 'as yet unclassified') ----- testAlphabetizeMessageCategoriesLeavesClassSelected browser selectSystemCategory: browser class category. browser selectClassNamed: browser class name. "This is a no-op." browser alphabetizeMessageCategories. self assert: browser selectedClassName = browser class name.! ----- Method: BrowserTest>>testAlphabetizingMethodsPreservesPlace (in category 'testing - message list') ----- testAlphabetizingMethodsPreservesPlace | oldCategory oldMethod | oldCategory := 'breakpoints'. oldMethod := #toggleBreakOnEntry. browser selectSystemCategory: browser class category. browser selectClass: browser class. browser selectMessageCategoryNamed: oldCategory. browser selectMessageNamed: oldMethod. browser alphabetizeMessageCategories. self assert: browser selectedMessageCategoryName = oldCategory. self assert: browser selectedMessageName = oldMethod.! ----- Method: BrowserTest>>testAlphabetizingMethodsPreservesPlaceWhenNoMessageCategorySelected (in category 'testing - message list') ----- testAlphabetizingMethodsPreservesPlaceWhenNoMessageCategorySelected browser selectSystemCategory: browser class category. browser selectClass: browser class. browser selectMessageCategoryNamed: nil. browser selectMessageNamed: nil. browser alphabetizeMessageCategories. self assert: browser selectedMessageCategoryName = nil. self assert: browser selectedMessageName = nil.! ----- Method: BrowserTest>>testAlphabetizingMethodsPreservesPlaceWhenNoMethodSelected (in category 'testing - message list') ----- testAlphabetizingMethodsPreservesPlaceWhenNoMethodSelected | oldCategory | oldCategory := 'breakpoints'. browser selectSystemCategory: browser class category. browser selectClass: browser class. browser selectMessageCategoryNamed: oldCategory. browser selectMessageNamed: nil. browser alphabetizeMessageCategories. self assert: browser selectedMessageCategoryName = oldCategory. self assert: browser selectedMessageName = nil.! ----- Method: BrowserTest>>testBuildMessageCategoryBrowserEditString (in category 'as yet unclassified') ----- testBuildMessageCategoryBrowserEditString | spawn | browser selectSystemCategory: browser class category. browser selectClass: browser class. browser messageCategoryListIndex: 1. browser messageListIndex: 1. spawn := browser buildMessageCategoryBrowserEditString: 'We don''t yet test that we do the right thing with this string!!'. [self assert: spawn selectedSystemCategory = browser selectedSystemCategory. self assert: spawn selectedClass = browser selectedClass. self assert: spawn messageCategoryListIndex = browser messageCategoryListIndex. self assert: spawn messageListIndex = browser messageListIndex] ensure: [ ToolBuilder default close: spawn topView ].! ----- Method: BrowserTest>>testBuildMessageCategoryBrowserEditStringNoCategorySelected (in category 'as yet unclassified') ----- testBuildMessageCategoryBrowserEditStringNoCategorySelected browser selectSystemCategory: browser class category. browser selectClass: browser class. browser messageCategoryListIndex: 0. self assert: (browser buildMessageCategoryBrowserEditString: 'foo') isNil.! ----- Method: BrowserTest>>testChangeMessageCategoriesLeavesClassSelected (in category 'as yet unclassified') ----- testChangeMessageCategoriesLeavesClassSelected browser selectSystemCategory: browser class category. browser selectClassNamed: browser class name. "This is a no-op." browser changeMessageCategories: browser classOrMetaClassOrganizer printString. self assert: browser selectedClassName = browser class name.! ----- Method: BrowserTest>>testClassCommentAnnotation (in category 'as yet unclassified') ----- testClassCommentAnnotation | annotation | browser selectSystemCategory: browser class category. browser selectClass: browser class. annotation := browser annotationForClassCommentFor: browser class. self assert: (annotation includesSubString: browser class organization commentStamp). self assert: (annotation includesSubString: 'class comment for'). self assert: (annotation includesSubString: browser className).! ----- Method: BrowserTest>>testClassCommentAnnotationIgnoresParameter (in category 'as yet unclassified') ----- testClassCommentAnnotationIgnoresParameter | annotation | browser selectSystemCategory: browser class category. browser selectClass: browser class. "And the method ignores the parameter:" annotation := browser annotationForClassCommentFor: browser class superclass. self assert: (annotation includesSubString: browser className).! ----- Method: BrowserTest>>testClassCommentViewingPersists (in category 'as yet unclassified') ----- testClassCommentViewingPersists browser selectSystemCategory: browser class category. self assert: browser classList size > 1 description: 'We use the first TWO classes in the category!!'. browser classListIndex: 1. browser metaClassIndicated: false. browser editComment. browser classListIndex: 2. self assert: browser editSelection = #editComment.! ----- Method: BrowserTest>>testClassDefinitionAnnotation (in category 'as yet unclassified') ----- testClassDefinitionAnnotation browser selectSystemCategory: browser class category. browser selectClass: browser class. self assert: browser class comment equals: (browser annotationForClassDefinitionFor: browser class). "And the method ignores the parameter:" self assert: browser class comment equals: (browser annotationForClassDefinitionFor: browser class superclass).! ----- Method: BrowserTest>>testContentsNewClass (in category 'as yet unclassified') ----- testContentsNewClass browser selectSystemCategory: browser class category. self assert: (Class template: browser selectedSystemCategory) equals: browser contents. self flag: #todo. "I don't know how to test the other half of this: see Browser >> #newClassContents".! ----- Method: BrowserTest>>testContentsSelection (in category 'as yet unclassified') ----- testContentsSelection browser selectSystemCategory: browser class category. browser selectClass: browser class. "No category or message selected." self assert: browser contentsSelection isEmpty. "Category selected, but no message selected." browser messageCategoryListIndex: 1. browser selectMessageNamed: browser messageList first. self assert: browser contentsSelection isEmpty. "Category and message selected." browser selectMessageNamed: nil. self deny: browser contentsSelection isEmpty.! ----- Method: BrowserTest>>testCreateHierarchyTreeOf (in category 'as yet unclassified') ----- testCreateHierarchyTreeOf "Empty." self assert: (browser createHierarchyTreeOf: #()) isEmpty. "Single class." self assert: { Browser -> #() } = (browser createHierarchyTreeOf: { Browser }). "Single class + 1 subclass" self assert: { Browser->{HierarchyBrowser->#()} } = (browser createHierarchyTreeOf: { Browser. HierarchyBrowser. }). "Single class + 2 subclasses" self assert: { Browser->{HierarchyBrowser->#() . FileContentsBrowser->#()} } = (browser createHierarchyTreeOf: { Browser. HierarchyBrowser. FileContentsBrowser. }). "Superclass, class, subclass" self assert: { CodeHolder->{Browser->{HierarchyBrowser->#()}} } = (browser createHierarchyTreeOf: { CodeHolder. Browser. HierarchyBrowser. }). "Two 'unrelated' classes" self assert: {Browser->#() . SmallInteger->#()} = (browser createHierarchyTreeOf: { Browser. SmallInteger }). "Two 'unrelated' classes and a common ancestor" self assert: {Browser->#() . SmallInteger->#() . ProtoObject->#()} = (browser createHierarchyTreeOf: { Browser. SmallInteger. ProtoObject }).! ----- Method: BrowserTest>>testDefaultClassList (in category 'as yet unclassified') ----- testDefaultClassList browser selectSystemCategory: nil. self assert: browser defaultClassList isEmpty. browser selectSystemCategory: Browser category. self assert: browser defaultClassList = (SystemOrganization listAtCategoryNamed: Browser category)! ----- Method: BrowserTest>>testFileOutMessageCategories (in category 'as yet unclassified') ----- testFileOutMessageCategories | fileName | browser selectSystemCategory: browser class category. browser selectClass: browser class. browser messageCategoryListIndex: 1. "Handcrafted from ClassDescription>>fileOutCategory:asHtml:" fileName := browser selectedClass name, '-', browser selectedMessageCategoryName, FileDirectory dot, 'st'. self deny: (FileDirectory default fileExists: fileName). [browser fileOutMessageCategories. self assert: (FileDirectory default fileExists: fileName). ] ensure: [FileDirectory default deleteFileNamed: fileName].! ----- Method: BrowserTest>>testFlattenHierarchyTreeOnIndent (in category 'as yet unclassified') ----- testFlattenHierarchyTreeOnIndent | flatten | flatten := [:coll | browser flattenHierarchyTree: (browser createHierarchyTreeOf: coll) on: OrderedCollection new indent: '']. "Empty collection." self assert: (flatten value: #()) isEmpty. "Single class." self assert: (OrderedCollection with: 'Browser') = (flatten value: {Browser}). "Single class + subclass." self assert: (OrderedCollection with: 'Browser' with: ' HierarchyBrowser') = (flatten value: {Browser. HierarchyBrowser}). "Single class + 2 subclasses" self assert: (OrderedCollection with: 'Browser' with: ' HierarchyBrowser' with: ' FileContentsBrowser') = (flatten value: { Browser. HierarchyBrowser. FileContentsBrowser. }). "Superclass, class, subclass" self assert: (OrderedCollection with: 'CodeHolder' with: ' Browser' with: ' HierarchyBrowser') = (flatten value: { CodeHolder. Browser. HierarchyBrowser. }). "Two 'unrelated' classes" self assert: (OrderedCollection with: 'Browser' with: 'SmallInteger') = (flatten value: { Browser. SmallInteger }). "Two 'unrelated' classes and a common ancestor" self assert: (OrderedCollection with: 'Browser' with: 'SmallInteger' with: 'ProtoObject') = (flatten value: { Browser. SmallInteger. ProtoObject }).! ----- Method: BrowserTest>>testFlattenHierarchyTreeOnIndentBy (in category 'as yet unclassified') ----- testFlattenHierarchyTreeOnIndentBy | flatten | flatten := [:coll | browser flattenHierarchyTree: (browser createHierarchyTreeOf: coll) on: OrderedCollection new indent: '' by: 'x']. "Empty collection." self assert: (flatten value: #()) isEmpty. "Single class." self assert: (OrderedCollection with: 'Browser') = (flatten value: {Browser}). "Single class + subclass." self assert: (OrderedCollection with: 'Browser' with: 'xHierarchyBrowser') = (flatten value: {Browser. HierarchyBrowser}). "Single class + 2 subclasses" self assert: (OrderedCollection with: 'Browser' with: 'xHierarchyBrowser' with: 'xFileContentsBrowser') = (flatten value: { Browser. HierarchyBrowser. FileContentsBrowser. }). "Superclass, class, subclass" self assert: (OrderedCollection with: 'CodeHolder' with: 'xBrowser' with: 'xxHierarchyBrowser') = (flatten value: { CodeHolder. Browser. HierarchyBrowser. }). "Two 'unrelated' classes" self assert: (OrderedCollection with: 'Browser' with: 'SmallInteger') = (flatten value: { Browser. SmallInteger }). "Two 'unrelated' classes and a common ancestor" self assert: (OrderedCollection with: 'Browser' with: 'SmallInteger' with: 'ProtoObject') = (flatten value: { Browser. SmallInteger. ProtoObject }).! ----- Method: BrowserTest>>testGetSystemCategoryListIndex (in category 'as yet unclassified') ----- testGetSystemCategoryListIndex | cat | cat := browser systemCategoryList first. browser selectSystemCategory: cat. self assert: browser systemCategoryListIndex = (browser systemCategoryList indexOf: browser selectedSystemCategory).! ----- Method: BrowserTest>>testHasClassSelected (in category 'as yet unclassified') ----- testHasClassSelected browser selectSystemCategory: browser class category. self deny: browser hasClassSelected. browser selectClass: browser class. self assert: browser hasClassSelected. browser selectClass: nil. self deny: browser hasClassSelected. browser selectClassNamed: browser class name asString. self assert: browser hasClassSelected.! ----- Method: BrowserTest>>testHasMessageCategorySelected (in category 'as yet unclassified') ----- testHasMessageCategorySelected browser selectSystemCategory: browser class category. browser selectClass: browser class. browser messageCategoryListIndex: 0. self deny: browser hasMessageCategorySelected. browser messageCategoryListIndex: 1. self assert: browser hasMessageCategorySelected. browser messageCategoryListIndex: 0. self deny: browser hasMessageCategorySelected.! ----- Method: BrowserTest>>testHasMessageSelected (in category 'as yet unclassified') ----- testHasMessageSelected browser selectSystemCategory: browser class category. browser selectClass: browser class. browser messageCategoryListIndex: 1. self deny: browser hasMessageSelected. browser messageListIndex: 0. self deny: browser hasMessageSelected. browser messageListIndex: 1. self assert: browser hasMessageSelected. browser messageListIndex: 0. self deny: browser hasMessageSelected.! ----- Method: BrowserTest>>testHomeCategory (in category 'as yet unclassified') ----- testHomeCategory "This also 'just happens' to test #selectOriginalCategoryForCurrentMethod. It's not appropriate to directly test a private method. (It's a private method because its comment says so, not its category.)" browser selectSystemCategory: browser class category. browser selectClass: browser class. browser messageCategoryListIndex: 0. "Select -- all --" browser selectMessageNamed: browser messageList first. browser showHomeCategory. self assert: browser selectedMessageCategoryName = (browser class organization categoryOfElement: browser selectedMessageName).! ----- Method: BrowserTest>>testKeepMethodSelectedWhenChangingClass (in category 'testing - message list') ----- testKeepMethodSelectedWhenChangingClass browser selectSystemCategory: SequenceableCollection category. browser selectClass: SequenceableCollection. browser selectMessageNamed: #add:. self assert: browser selectedMessageName = #add:. "Even though we have no message category selected, stay looking at the #add: method." browser selectClass: Collection. self assert: browser selectedMessageName = #add:.! ----- Method: BrowserTest>>testLabelStringAlwaysShowsBrowserType (in category 'as yet unclassified') ----- testLabelStringAlwaysShowsBrowserType browser selectSystemCategory: browser class category. self assert: (browser labelString includesSubString: 'System Browser'). browser selectClass: browser class. self assert: (browser labelString includesSubString: 'System Browser'). browser selectSystemCategory: DependencyBrowser category. browser selectClass: DependencyBrowser. self assert: (browser labelString includesSubString: 'System Browser').! ----- Method: BrowserTest>>testLabelStringOfNewBrowserShowsBrowserType (in category 'as yet unclassified') ----- testLabelStringOfNewBrowserShowsBrowserType self assert: 'System Browser' equals: browser labelString.! ----- Method: BrowserTest>>testLabelStringShowsBrowsedClassName (in category 'as yet unclassified') ----- testLabelStringShowsBrowsedClassName browser selectSystemCategory: DependencyBrowser category. browser selectClass: DependencyBrowser. self assert: (browser labelString includesSubString: DependencyBrowser name).! ----- Method: BrowserTest>>testMessageCatListSingleton (in category 'as yet unclassified') ----- testMessageCatListSingleton | catName | browser selectSystemCategory: browser class category. browser selectClass: browser class. self assert: browser messageCatListSingleton = #(). catName := browser messageCategoryList second. browser selectMessageCategoryNamed: catName. self assert: browser messageCatListSingleton = {catName}.! ----- Method: BrowserTest>>testMessageCategoryList (in category 'as yet unclassified') ----- testMessageCategoryList browser selectSystemCategory: browser class category. browser selectClass: browser class. self assert: browser messageCategoryList = ({ClassOrganizer allCategory}, browser class organization categories). browser selectClass: nil. self assert: browser messageCategoryList = #(). browser selectClass: browser class. browser metaClassIndicated: true. self assert: browser messageCategoryList = ({ClassOrganizer allCategory}, browser class classSide organization categories).! ----- Method: BrowserTest>>testMessageCategoryListIndex (in category 'as yet unclassified') ----- testMessageCategoryListIndex browser selectSystemCategory: browser class category. browser selectClass: browser class. self assert: browser messageCategoryList size > 1 description: 'Sanity check: test refers to first two categories.'. browser messageCategoryListIndex: 0. self assert: browser selectedMessageCategoryName isNil. browser messageCategoryListIndex: 1. self assert: browser selectedMessageCategoryName = browser messageCategoryList first. browser messageListIndex: 1. browser messageCategoryListIndex: 2. self assert: browser selectedMessageName isNil description: 'Changing category deselects method'.! ----- Method: BrowserTest>>testMessageList (in category 'as yet unclassified') ----- testMessageList browser selectSystemCategory: browser class category. browser selectClass: nil. self assert: browser messageList isEmpty. browser selectClass: browser class. browser messageCategoryListIndex: 0. self assert: browser messageList = browser classOrMetaClassOrganizer allMethodSelectors. browser messageCategoryListIndex: 1. "-- all --" self assert: browser messageList = browser classOrMetaClassOrganizer allMethodSelectors. browser messageCategoryListIndex: 2. self assert: browser messageList = (browser classOrMetaClassOrganizer listAtCategoryNumber: 1). browser metaClassIndicated: true. browser messageCategoryListIndex: 0. self assert: browser messageList = browser classOrMetaClassOrganizer allMethodSelectors. browser messageCategoryListIndex: 1. "-- all --" self assert: browser messageList = browser classOrMetaClassOrganizer allMethodSelectors. browser messageCategoryListIndex: 2. self assert: browser messageList = (browser classOrMetaClassOrganizer listAtCategoryNumber: 1).! ----- Method: BrowserTest>>testMetaClassIndicatedFalseOnExistingClass (in category 'as yet unclassified') ----- testMetaClassIndicatedFalseOnExistingClass browser selectSystemCategory: browser class category. browser selectClass: browser class. browser metaClassIndicated: false. self assert: browser messageListIndex = 0. self assert: browser messageCategoryListIndex = 0. self deny: browser contents isEmpty. "It shows the class definition." self deny: browser messageCategoryList isEmpty. self assert: browser messageList = (browser class organization allMethodSelectors). self assert: browser editSelection = #editClass.! ----- Method: BrowserTest>>testMetaClassIndicatedNotOnNoClass (in category 'as yet unclassified') ----- testMetaClassIndicatedNotOnNoClass browser selectSystemCategory: browser class category. browser selectClass: nil. browser metaClassIndicated: false. self assert: browser messageListIndex = 0. self assert: browser messageCategoryListIndex = 0. self deny: browser contents isEmpty. "It shows the class definition." self assert: browser messageCategoryList isEmpty. self assert: browser messageList isEmpty. self assert: browser editSelection = #newClass.! ----- Method: BrowserTest>>testMetaClassIndicatedNotWithNoSystemCategorySelected (in category 'as yet unclassified') ----- testMetaClassIndicatedNotWithNoSystemCategorySelected browser selectSystemCategory: nil. browser metaClassIndicated: false. self assert: browser messageListIndex = 0. self assert: browser messageCategoryListIndex = 0. self assert: browser contents isEmpty. "It shows the Class definition." self assert: browser messageCategoryList isEmpty. self assert: browser editSelection = #none.! ----- Method: BrowserTest>>testMetaClassIndicatedOnNoClass (in category 'as yet unclassified') ----- testMetaClassIndicatedOnNoClass browser selectSystemCategory: browser class category. browser selectClass: nil. browser metaClassIndicated: true. self assert: browser messageListIndex = 0. self assert: browser messageCategoryListIndex = 0. self assert: browser contents isEmpty. self assert: browser messageCategoryList isEmpty. self assert: browser messageList isEmpty. self assert: browser editSelection = #none.! ----- Method: BrowserTest>>testMetaClassIndicatedTrueOnExistingClass (in category 'as yet unclassified') ----- testMetaClassIndicatedTrueOnExistingClass browser selectSystemCategory: browser class category. browser selectClass: browser class. browser metaClassIndicated: true. self assert: browser messageListIndex = 0. self assert: browser messageCategoryListIndex = 0. self deny: browser contents isEmpty. "It shows the Class definition." self deny: browser messageCategoryList isEmpty. self assert: browser messageList = (browser class classSide organization allMethodSelectors).! ----- Method: BrowserTest>>testMetaClassIndicatedWithNoSystemCategorySelected (in category 'as yet unclassified') ----- testMetaClassIndicatedWithNoSystemCategorySelected browser selectSystemCategory: nil. browser metaClassIndicated: true. self assert: browser messageListIndex = 0. self assert: browser messageCategoryListIndex = 0. self assert: browser contents isEmpty. "It shows the Class definition." self assert: browser messageCategoryList isEmpty. self assert: browser editSelection = #none.! ----- Method: BrowserTest>>testRawMessageCategoryList (in category 'as yet unclassified') ----- testRawMessageCategoryList browser selectSystemCategory: browser class category. browser selectClass: browser class. self assert: browser rawMessageCategoryList = browser class organization categories. browser selectClass: nil. self assert: browser rawMessageCategoryList = #(). browser selectClass: browser class. browser metaClassIndicated: true. self assert: browser rawMessageCategoryList = browser class classSide organization categories.! ----- Method: BrowserTest>>testSelectCategoryForClass (in category 'as yet unclassified') ----- testSelectCategoryForClass browser selectCategoryForClass: Browser. self assert: browser selectedSystemCategory = Browser category. browser selectCategoryForClass: TestCase. self assert: browser selectedSystemCategory = TestCase category.! ----- Method: BrowserTest>>testSelectClass (in category 'as yet unclassified') ----- testSelectClass browser selectSystemCategory: browser class category. browser selectClass: browser class. self assert: browser hasClassSelected. browser selectClass: nil. self deny: browser hasClassSelected.! ----- Method: BrowserTest>>testSelectClassEditSelectionNoClass (in category 'as yet unclassified') ----- testSelectClassEditSelectionNoClass browser selectSystemCategory: browser class category. browser selectClass: nil. self assert: browser editSelection = #newClass.! ----- Method: BrowserTest>>testSelectClassEditSelectionWhenCommentSelected (in category 'as yet unclassified') ----- testSelectClassEditSelectionWhenCommentSelected | editSelection | browser selectSystemCategory: Heap category. browser selectClass: Heap. browser editComment. browser messageListIndex: 0. browser messageListIndex: 0. editSelection := browser editSelection. browser selectClass: Interval. self assert: browser editSelection = editSelection.! ----- Method: BrowserTest>>testSelectClassEditSelectionWhenEditingClass (in category 'as yet unclassified') ----- testSelectClassEditSelectionWhenEditingClass browser selectSystemCategory: Heap category. browser selectClass: Heap. browser metaClassIndicated: false. browser messageListIndex: 0. browser messageListIndex: 0. browser selectClass: Interval. self assert: browser editSelection = #editClass.! ----- Method: BrowserTest>>testSelectClassEditSelectionWhenEditingMetaclass (in category 'as yet unclassified') ----- testSelectClassEditSelectionWhenEditingMetaclass browser selectSystemCategory: Heap category. browser selectClass: Heap. browser metaClassIndicated: true. browser messageListIndex: 0. browser messageListIndex: 0. browser selectClass: Interval. self assert: browser editSelection = #editClass.! ----- Method: BrowserTest>>testSelectClassEditSelectionWhenMsgSelected (in category 'as yet unclassified') ----- testSelectClassEditSelectionWhenMsgSelected browser selectSystemCategory: Heap category. browser selectClass: Heap. browser selectMessageCategoryNamed: 'adding'. browser messageListIndex: (browser messageList indexOf: #add:). browser selectClass: Interval. self assert: browser editSelection = #editMessage.! ----- Method: BrowserTest>>testSelectClassEditSelectionWhenNoMsgButCatSelected (in category 'as yet unclassified') ----- testSelectClassEditSelectionWhenNoMsgButCatSelected browser selectSystemCategory: Heap category. browser selectClass: Heap. browser selectMessageCategoryNamed: 'adding'. browser messageListIndex: 0. browser selectClass: Interval. self assert: browser editSelection = #newMessage.! ----- Method: BrowserTest>>testSelectClassNamed (in category 'as yet unclassified') ----- testSelectClassNamed browser selectSystemCategory: browser class category. browser selectClassNamed: browser class name. self assert: browser selectedClassName = browser class name. browser selectClassNamed: nil. self assert: browser selectedClassName isNil. browser selectClassNamed: browser class name asString. self assert: browser selectedClassName = browser class name.! ----- Method: BrowserTest>>testSelectClassNamedPreservesPlace (in category 'as yet unclassified') ----- testSelectClassNamedPreservesPlace | commonCategory commonSelector otherClass | browser selectSystemCategory: browser class category. otherClass := HierarchyBrowser. "Unlikely to move out of Browser's package!!" browser selectClassNamed: browser class name. commonCategory := (browser class organization categories intersection: otherClass organization categories) first. commonSelector := #classList. browser selectMessageCategoryNamed: commonCategory. browser selectMessageNamed: commonSelector. browser selectClass: otherClass. self assert: browser selectedClassName = otherClass name. self assert: browser selectedMessageCategoryName = commonCategory. self assert: browser selectedMessageName = commonSelector.! ----- Method: BrowserTest>>testSelectClassReselectsMessage (in category 'as yet unclassified') ----- testSelectClassReselectsMessage "Colections-Sequences contains a number of classes with similar protocols. In particular, several classes have a method called #add: in a category 'adding'." | selectedMsgCat selectedMethod | selectedMsgCat := 'adding'. selectedMethod := #add:. browser selectSystemCategory: Heap category. browser selectClass: Heap. browser selectMessageCategoryNamed: selectedMsgCat. browser messageListIndex: (browser messageList indexOf: selectedMethod). browser selectClass: Interval. self assert: browser selectedMessageCategoryName = selectedMsgCat. self assert: browser selectedMessageName = selectedMethod.! ----- Method: BrowserTest>>testSelectClassSelectsClass (in category 'as yet unclassified') ----- testSelectClassSelectsClass browser selectSystemCategory: browser class category. browser selectClass: browser class. self assert: browser classListIndex ~= 0. self assert: browser selectedClass = browser class. self assert: browser selectedClassName = browser class name.! ----- Method: BrowserTest>>testSelectClassWhenNothingSelected (in category 'as yet unclassified') ----- testSelectClassWhenNothingSelected self assert: browser editSelection = #none.! ----- Method: BrowserTest>>testSelectMessageCategoryEditSelection (in category 'as yet unclassified') ----- testSelectMessageCategoryEditSelection browser selectSystemCategory: browser class category. browser selectClass: browser class. browser selectMessageCategoryNamed: browser messageCategoryList first. self assert: browser editSelection = #newMessage.! ----- Method: BrowserTest>>testSelectMessageCategoryEditSelectionNoMsgCat (in category 'as yet unclassified') ----- testSelectMessageCategoryEditSelectionNoMsgCat browser selectSystemCategory: browser class category. browser selectClass: browser class. . browser messageCategoryListIndex: 0. self assert: browser editSelection = #editClass.! ----- Method: BrowserTest>>testSelectMessageCategoryEditSelectionNoMsgCatNoClass (in category 'as yet unclassified') ----- testSelectMessageCategoryEditSelectionNoMsgCatNoClass browser selectSystemCategory: browser class category. browser selectClass: nil. . browser messageCategoryListIndex: 0. self assert: browser editSelection = #newClass.! ----- Method: BrowserTest>>testSelectMessageCategoryNamed (in category 'as yet unclassified') ----- testSelectMessageCategoryNamed | catName | browser selectSystemCategory: browser class category. browser selectClass: browser class. catName := browser messageCategoryList anyOne. browser selectMessageCategoryNamed: catName. self assert: browser selectedMessageCategoryName = catName.! ----- Method: BrowserTest>>testSelectMessageNamed (in category 'as yet unclassified') ----- testSelectMessageNamed browser selectSystemCategory: browser class category. browser selectClass: browser class. browser messageCategoryListIndex: 1. browser selectMessageNamed: browser messageList first. self assert: browser selectedMessageName = browser messageList first. self assert: browser messageListIndex = 1. browser selectMessageNamed: nil. self assert: browser selectedMessageName isNil. self assert: browser messageListIndex = 0. browser selectMessageNamed: browser messageList second. self assert: browser selectedMessageName = browser messageList second. self assert: browser messageListIndex = 2. browser selectMessageNamed: browser messageList first asString. self assert: browser selectedMessageName = browser messageList first. self assert: browser messageListIndex = 1.! ----- Method: BrowserTest>>testSelectedClass (in category 'as yet unclassified') ----- testSelectedClass browser selectSystemCategory: browser class category. browser classListIndex: 0. self assert: browser classListIndex = 0. self assert: browser selectedClass isNil. browser classListIndex: 1. self assert: browser classListIndex = 1. self assert: browser selectedClass notNil.! ----- Method: BrowserTest>>testSelectedEnvironment (in category 'as yet unclassified') ----- testSelectedEnvironment browser selectSystemCategory: browser class category. self assert: browser selectedEnvironment = Smalltalk. browser selectSystemCategory: nil. self assert: browser selectedEnvironment isNil.! ----- Method: BrowserTest>>testSelectedSystemCategory (in category 'as yet unclassified') ----- testSelectedSystemCategory | cat newCat | cat := browser systemCategoryList first. newCat := browser systemCategoryList second. browser selectSystemCategory: cat. self assert: browser selectedSystemCategory = cat. browser systemCategoryListIndex: 2. self assert: browser selectedSystemCategory = newCat.! ----- Method: BrowserTest>>testShowHomeCategory (in category 'as yet unclassified') ----- testShowHomeCategory browser selectSystemCategory: browser class category. browser selectClass: browser class. "Select '--all--'." browser selectMessageCategoryNamed: browser messageCategoryList first. browser selectMessageNamed: browser messageList first. browser showHomeCategory. self assert: browser messageCategoryListIndex > 1.! ----- Method: BrowserTest>>testSpawnHierarchy (in category 'as yet unclassified') ----- testSpawnHierarchy | spawn | browser selectSystemCategory: browser class category. browser selectClass: browser class. browser selectMessageCategoryNamed: browser messageCategoryList last. browser messageListIndex: (browser messageList size). spawn := browser spawnHierarchy. [self assert: spawn selectedSystemCategory = browser selectedSystemCategory. self assert: spawn selectedClassName = browser selectedClassName. self assert: spawn selectedMessageCategoryName = browser selectedMessageCategoryName. self assert: spawn messageListIndex = browser messageListIndex.] ensure: [ ToolBuilder default close: spawn topView ].! ----- Method: BrowserTest>>testSystemCategoryListIndex (in category 'as yet unclassified') ----- testSystemCategoryListIndex | oldCat | browser systemCategoryListIndex: 1. oldCat := browser selectedSystemCategory. self assert: browser selectedSystemCategory = browser systemCategoryList first. browser systemCategoryListIndex: 2. self deny: browser selectedSystemCategory = oldCat. self assert: browser selectedSystemCategory = browser systemCategoryList second.! TestCase subclass: #DebuggerExtensionsTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Debugger'! ----- Method: DebuggerExtensionsTest>>testBooleansGeneralise (in category 'testing - canonical argument names') ----- testBooleansGeneralise self assert: Boolean name equals: true canonicalArgumentName. self assert: Boolean name equals: false canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testByteStringsGeneralise (in category 'testing - canonical argument names') ----- testByteStringsGeneralise self assert: String name equals: ByteString new canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testClassesGeneralise (in category 'testing - canonical argument names') ----- testClassesGeneralise self assert: Class name equals: Class new canonicalArgumentName. self assert: Class name equals: 1 class canonicalArgumentName. self assert: Class name equals: true class canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testCollectionsGeneralise (in category 'testing - canonical argument names') ----- testCollectionsGeneralise self assert: Collection name equals: Array new canonicalArgumentName. self assert: Collection name equals: OrderedCollection new canonicalArgumentName. self assert: Collection name equals: LinkedList new canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testFloatsGeneralise (in category 'testing - canonical argument names') ----- testFloatsGeneralise self assert: Number name equals: 1.0 canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testFractionsGeneralise (in category 'testing - canonical argument names') ----- testFractionsGeneralise self assert: Number name equals: (1 / 2) canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testIntegersDontGeneralise (in category 'testing - canonical argument names') ----- testIntegersDontGeneralise self assert: Integer name equals: 1 canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testLargeNegativeIntegersGeneralise (in category 'testing - canonical argument names') ----- testLargeNegativeIntegersGeneralise self assert: Integer name equals: LargeNegativeInteger initializedInstance canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testLargePositiveIntegersGeneralise (in category 'testing - canonical argument names') ----- testLargePositiveIntegersGeneralise self assert: Integer name equals: LargePositiveInteger initializedInstance canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testOtherObjectsDontGeneralise (in category 'testing - canonical argument names') ----- testOtherObjectsDontGeneralise self assert: Behavior name equals: Behavior new canonicalArgumentName. self assert: UndefinedObject name equals: nil canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testScaledDecimalsGeneralise (in category 'testing - canonical argument names') ----- testScaledDecimalsGeneralise self assert: Number name equals: 2.00s2 canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testStringsDontGeneralise (in category 'testing - canonical argument names') ----- testStringsDontGeneralise self assert: String name equals: String new canonicalArgumentName! ----- Method: DebuggerExtensionsTest>>testWideStringsGeneralise (in category 'testing - canonical argument names') ----- testWideStringsGeneralise self assert: String name equals: WideString new canonicalArgumentName! TestCase subclass: #DebuggerUnwindBug instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Debugger'! ----- Method: DebuggerUnwindBug>>testUnwindBlock (in category 'testing') ----- testUnwindBlock "test if unwind blocks work properly" | sema process | sema := Semaphore forMutualExclusion. self assert: sema isSignaled. "deadlock on the semaphore" process := [sema critical:[sema wait]] forkAt: Processor userInterruptPriority. self deny: sema isSignaled. "terminate process" process terminate. self assert: sema isSignaled. ! ----- Method: DebuggerUnwindBug>>testUnwindDebugger (in category 'testing') ----- testUnwindDebugger "test if unwind blocks work properly when a debugger is closed" | sema process debugger top | sema := Semaphore forMutualExclusion. self assert: sema isSignaled. process := [sema critical:[sema wait]] forkAt: Processor userInterruptPriority. self deny: sema isSignaled. "everything set up here - open a debug notifier" debugger := Debugger openInterrupt: 'test' onProcess: process. "get into the debugger" debugger debug. top := debugger topView. "set top context" debugger toggleContextStackIndex: 1. "close debugger" top delete. "and see if unwind protection worked" self assert: sema isSignaled.! TestCase subclass: #DependencyBrowserTest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! ----- Method: DependencyBrowserTest>>setUp (in category 'running') ----- setUp browser := DependencyBrowser new.! ----- Method: DependencyBrowserTest>>testBrowse (in category 'testing - buttons') ----- testBrowse | b | browser packageListIndex: (browser packageList indexOf: #Collections). browser packageDepsIndex: (browser packageDeps indexOf: #Compiler). browser classDepsIndex: (browser classDeps indexOf: #Scanner). browser classListIndex: (browser classList indexOf: #Symbol). browser messageListIndex: 1. b := browser browseMethodFull. self assert: b notNil. [self assert: b selectedMessageName = (browser messageList at: browser messageListIndex) ] ensure: [ToolBuilder default close: b topView]! ----- Method: DependencyBrowserTest>>testClassList (in category 'testing - class list') ----- testClassList "Warning!! When Collections' dependencies change, this test may start to fail!!" self assert: #() equals: browser classList description: 'classList before package selection'. browser packageListIndex: (browser packageList indexOf: #Collections). self assert: #() equals: browser classList description: 'classList after selecting Collections'. browser packageDepsIndex: (browser packageDeps indexOf: #Compiler). self assert: #() equals: browser classList description: 'classList after selecting Compiler'. browser classDepsIndex: (browser classDeps indexOf: #Scanner). self assert: #(Character Symbol 'Symbol class') equals: browser classList description: 'classList after selecting Scanner class'. browser classListIndex: (browser classList indexOf: #Symbol). self assert: #(Character Symbol 'Symbol class') equals: browser classList description: 'classList after selecting Symbol class'.! ----- Method: DependencyBrowserTest>>testHasPackageSelected (in category 'testing - metaclass') ----- testHasPackageSelected self deny: browser hasPackageSelected. browser packageListIndex: 1. self assert: browser hasPackageSelected. browser packageListIndex: 0. self deny: browser hasPackageSelected.! ----- Method: DependencyBrowserTest>>testSelectedClassOrMetaClass (in category 'testing - metaclass') ----- testSelectedClassOrMetaClass "Warning!! When Collections' dependencies change, this test may start to fail!!" self assert: browser selectedClassOrMetaClass isNil. browser packageListIndex: (browser packageList indexOf: #Collections). self assert: browser selectedClassOrMetaClass isNil. browser packageDepsIndex: (browser packageDeps indexOf: #Compiler). self assert: browser selectedClassOrMetaClass isNil. browser classDepsIndex: (browser classDeps indexOf: #Scanner). self assert: browser selectedClassOrMetaClass isNil. browser classListIndex: (browser classList indexOf: #Symbol). self deny: browser selectedClassOrMetaClass isNil. self assert: browser selectedClassOrMetaClass == Symbol.! ----- Method: DependencyBrowserTest>>testSelectedMessageClassSideShowsSource (in category 'testing - message list') ----- testSelectedMessageClassSideShowsSource "Warning!! When Collections' dependencies change, this test may start to fail!!" browser packageListIndex: (browser packageList indexOf: #Kernel). browser packageDepsIndex: (browser packageDeps indexOf: #Collections). browser classDepsIndex: (browser classDeps indexOf: #'Array'). browser classListIndex: (browser classList indexOf: #'DateAndTime class'). browser messageListIndex: 1. self assert: browser selectedMessageName == #fromSeconds:. self assert: browser contents = (DateAndTime class sourceCodeAt: #fromSeconds:) ! ----- Method: DependencyBrowserTest>>testSelectedMessageName (in category 'testing - message list') ----- testSelectedMessageName "Warning!! When Collections' dependencies change, this test may start to fail!!" self assert: browser selectedMessageName isNil. browser packageListIndex: (browser packageList indexOf: #Collections). self assert: browser selectedMessageName isNil. browser packageDepsIndex: (browser packageDeps indexOf: #Compiler). self assert: browser selectedMessageName isNil. browser classDepsIndex: (browser classDeps indexOf: #Scanner). self assert: browser selectedMessageName isNil. browser classListIndex: (browser classList indexOf: #Symbol). self assert: browser selectedMessageName isNil. browser messageListIndex: 1. self assert: browser selectedMessageName == #storeOn:. browser messageListIndex: 0. self assert: browser selectedMessageName isNil.! ----- Method: DependencyBrowserTest>>testSelectedMessageNameClassSide (in category 'testing - message list') ----- testSelectedMessageNameClassSide "Warning!! When Collections' dependencies change, this test may start to fail!!" self assert: browser selectedMessageName isNil. browser packageListIndex: (browser packageList indexOf: #Kernel). self assert: browser selectedMessageName isNil. browser packageDepsIndex: (browser packageDeps indexOf: #Collections). self assert: browser selectedMessageName isNil. browser classDepsIndex: (browser classDeps indexOf: #Array). self assert: browser selectedMessageName isNil. browser classListIndex: (browser classList indexOf: #'DateAndTime class'). self assert: browser selectedMessageName isNil. browser messageListIndex: 1. self assert: browser selectedMessageName == #fromSeconds:. ! TestCase subclass: #FileContentsBrowserTest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! ----- Method: FileContentsBrowserTest>>expectedFailures (in category 'as yet unclassified') ----- expectedFailures ^ #(testChangeMessageCategoriesLeavesClassSelected) "See Mantis #7615"! ----- Method: FileContentsBrowserTest>>setUp (in category 'as yet unclassified') ----- setUp | fileout testCat package packageDict organizer | testCat := self class category. fileout := WriteStream on: (String new: 10000). SystemOrganization fileOutCategory: testCat on: fileout. packageDict := Dictionary new. browser := FileContentsBrowser new. organizer := SystemOrganizer defaultList: Array new. package := (FilePackage new fullName: testCat; fileInFrom: fileout readStream). packageDict at: package packageName put: package. organizer classifyAll: package classes keys under: package packageName. (browser := FileContentsBrowser systemOrganizer: organizer) packages: packageDict.! ----- Method: FileContentsBrowserTest>>testChangeMessageCategoriesLeavesClassSelected (in category 'as yet unclassified') ----- testChangeMessageCategoriesLeavesClassSelected browser selectSystemCategory: browser systemCategoryList first. browser selectClassNamed: browser classList first. "This is a no-op." browser changeMessageCategories: browser classOrMetaClassOrganizer printString. self assert: browser selectedClassName = browser class name.! TestCase subclass: #FileList2ModalDialogsTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-FileList'! !FileList2ModalDialogsTest commentStamp: '<historical>' prior: 0! TestRunner open! ----- Method: FileList2ModalDialogsTest>>testModalFileSelector (in category 'running') ----- testModalFileSelector | window fileList2 | window := FileList2 morphicViewFileSelector. window openCenteredInWorld. fileList2 := window valueOfProperty: #fileListModel. fileList2 fileListIndex: 1. window delete. self assert: fileList2 getSelectedFile isNil. fileList2 okHit. self deny: fileList2 getSelectedFile isNil ! ----- Method: FileList2ModalDialogsTest>>testModalFileSelectorForSuffixes (in category 'running') ----- testModalFileSelectorForSuffixes | window fileList2 | window := FileList2 morphicViewFileSelectorForSuffixes: nil. window openCenteredInWorld. fileList2 := window valueOfProperty: #fileListModel. fileList2 fileListIndex: 1. window delete. self assert: fileList2 getSelectedFile isNil. fileList2 okHit. self deny: fileList2 getSelectedFile isNil ! ----- Method: FileList2ModalDialogsTest>>testModalFolderSelector (in category 'running') ----- testModalFolderSelector | window fileList2 | window := FileList2 morphicViewFolderSelector. fileList2 := window model. window openInWorld: self currentWorld extent: 300@400. fileList2 fileListIndex: 1. window delete. self assert: fileList2 getSelectedDirectory withoutListWrapper isNil. fileList2 okHit. self deny: fileList2 getSelectedDirectory withoutListWrapper isNil ! ----- Method: FileList2ModalDialogsTest>>testModalFolderSelectorForProjectLoad (in category 'running') ----- testModalFolderSelectorForProjectLoad | window fileList2 w | window := FileList2 morphicViewProjectLoader2InWorld: self currentWorld reallyLoad: false. fileList2 := window valueOfProperty: #FileList. w := self currentWorld. window position: w topLeft + (w extent - window extent // 2). window openInWorld: w. window delete. self assert: fileList2 getSelectedDirectory withoutListWrapper isNil. fileList2 okHit. self deny: fileList2 getSelectedDirectory withoutListWrapper isNil ! TestCase subclass: #HierarchyBrowserTest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! ----- Method: HierarchyBrowserTest>>setUp (in category 'as yet unclassified') ----- setUp browser := HierarchyBrowser new.! ----- Method: HierarchyBrowserTest>>testClassList (in category 'as yet unclassified') ----- testClassList | c displayedClasses hierarchy | browser initHierarchyForClass: browser class. c := browser class theNonMetaClass. displayedClasses := browser classList collect: [:each | each withoutLeadingBlanks ]. hierarchy := (c allSuperclasses reversed, {browser class}, c allSubclasses) collect: [ :each | each name ]. self assert: displayedClasses = hierarchy.! ----- Method: HierarchyBrowserTest>>testClassListIndex (in category 'as yet unclassified') ----- testClassListIndex | expectedCat | expectedCat := [:i | (Smalltalk at: (browser classList at: i) withoutLeadingBlanks asSymbol) category ]. browser initHierarchyForClass: browser class. self deny: browser classListIndex = 0. 1 to: 3 do: [:n | browser classListIndex: n. self assert: browser classListIndex = n. self assert: browser selectedSystemCategory = (expectedCat value: n)]! ----- Method: HierarchyBrowserTest>>testClassListSansWhitespace (in category 'as yet unclassified') ----- testClassListSansWhitespace | c displayedClasses hierarchy | browser initHierarchyForClass: browser class. c := browser class theNonMetaClass. displayedClasses := browser classList collect: [:each | each withoutLeadingBlanks ]. hierarchy := (c allSuperclasses reversed, {browser class}, c allSubclasses) collect: [ :each | each name ]. self assert: displayedClasses = hierarchy.! ----- Method: HierarchyBrowserTest>>testInitHierarchyForClass (in category 'as yet unclassified') ----- testInitHierarchyForClass | b | b := HierarchyBrowser new initHierarchyForClass: browser class. self assert: b selectedClassName = browser class name.! ----- Method: HierarchyBrowserTest>>testSelectClass (in category 'as yet unclassified') ----- testSelectClass browser initHierarchyForClass: browser class. browser selectClass: ProtoObject. self assert: browser selectedClass = ProtoObject. browser selectClass: CodeHolder. self assert: browser selectedClass = CodeHolder.! ----- Method: HierarchyBrowserTest>>testSelectedClassName (in category 'as yet unclassified') ----- testSelectedClassName browser initHierarchyForClass: browser class. self assert: browser selectedClassName = browser class name. browser classListIndex: 0. self assert: browser selectedClassName isNil.! TestCase subclass: #MessageNamesTest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! ----- Method: MessageNamesTest>>setUp (in category 'as yet unclassified') ----- setUp browser := MessageNames openMessageNames.! ----- Method: MessageNamesTest>>tearDown (in category 'as yet unclassified') ----- tearDown browser topView ifNotNil: [:v | ToolBuilder default close: v].! ----- Method: MessageNamesTest>>testCannotUnselectCategory (in category 'as yet unclassified') ----- testCannotUnselectCategory | selectorList | browser searchString: 'cull'. browser selectorListIndex: 1. selectorList := browser selectorList copy. browser selectorListIndex: 0. self assert: selectorList = browser selectorList.! ----- Method: MessageNamesTest>>testOpenMessageNames (in category 'as yet unclassified') ----- testOpenMessageNames | b | b := MessageNames openMessageNames. [self assert: (b isKindOf: MessageNames)] ensure: [ToolBuilder default close: b topView].! ----- Method: MessageNamesTest>>testSearchString (in category 'as yet unclassified') ----- testSearchString | cCount cullCount cullCullCount | browser searchString: 'c'. cCount := browser selectorList size. browser searchString: 'cull:'. cullCount := browser selectorList size. self assert: cullCount < cCount. browser searchString: 'cull:cull:'. cullCullCount := browser selectorList size. self assert: cullCullCount < cullCount.! ----- Method: MessageNamesTest>>testSelectedClassOrMetaClass (in category 'as yet unclassified') ----- testSelectedClassOrMetaClass | firstClass | browser searchString: 'cull'. firstClass := browser messageList first actualClass. browser messageListIndex: 1. self assert: browser selectedClassOrMetaClass = firstClass. browser messageListIndex: 0. self assert: browser selectedClassOrMetaClass isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selectedClassOrMetaClass = firstClass.! ----- Method: MessageNamesTest>>testSelectedMessageCategoryName (in category 'as yet unclassified') ----- testSelectedMessageCategoryName browser searchString: 'cull'. browser selectorListIndex: 1. browser messageListIndex: 1. self deny: browser selectedMessageCategoryName isNil. browser messageListIndex: 0. self assert: browser selectedMessageCategoryName isNil.! ----- Method: MessageNamesTest>>testSelection (in category 'as yet unclassified') ----- testSelection browser searchString: 'cull'. browser selectorListIndex: 1. browser messageListIndex: 1. self assert: (browser selection isKindOf: MethodReference). browser messageListIndex: 0. self assert: browser selection isNil.! TestCase subclass: #MessageSetTest instanceVariableNames: 'browser updates' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! ----- Method: MessageSetTest>>initialize (in category 'initialize-release') ----- initialize super initialize. "Contains the triggers sent by the model during its updates." updates := OrderedCollection new.! ----- Method: MessageSetTest>>setUp (in category 'running') ----- setUp browser := (MessageSet openMessageList: (SystemNavigation default allImplementorsOf: #browseAllImplementorsOf:) name: 'Test MessageSet' autoSelect: nil) model. browser addDependent: self.! ----- Method: MessageSetTest>>tearDown (in category 'running') ----- tearDown ToolBuilder default close: browser topView.! ----- Method: MessageSetTest>>testAutoSelectString (in category 'testing') ----- testAutoSelectString browser autoSelectString: 'browseAllImplementorsOf:'. self assert: browser autoSelectString = 'browseAllImplementorsOf:'. browser messageListIndex: 2. self assert: (updates includes: #autoSelect).! ----- Method: MessageSetTest>>testContents (in category 'testing') ----- testContents browser messageListIndex: 0. self assert: browser contents = ''. browser messageListIndex: 1. self deny: browser contents = ''. ! ----- Method: MessageSetTest>>testHasMessageSelected (in category 'testing') ----- testHasMessageSelected browser messageListIndex: 1. self assert: browser hasMessageSelected. browser messageListIndex: 0. self deny: browser hasMessageSelected. "And just to be sure:" browser messageListIndex: 1. self assert: browser hasMessageSelected.! ----- Method: MessageSetTest>>testRemoveMessageFromBrowser (in category 'testing') ----- testRemoveMessageFromBrowser | count sel | browser messageListIndex: 1. sel := browser selection. browser removeMessageFromBrowser. self deny: (browser messageList includes: sel) description: 'Method not removed'. browser messageListIndex: 0. count := browser messageList size. browser removeMessageFromBrowser. self assert: count = browser messageList size description: 'Some method was removed'.! ----- Method: MessageSetTest>>testSelectedClassOrMetaClass (in category 'testing') ----- testSelectedClassOrMetaClass | firstClass | firstClass := browser messageList first actualClass. browser messageListIndex: 1. self assert: browser selectedClassOrMetaClass = firstClass. browser messageListIndex: 0. self assert: browser selectedClassOrMetaClass isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selectedClassOrMetaClass = firstClass.! ----- Method: MessageSetTest>>testSelectedMessageCategoryName (in category 'testing') ----- testSelectedMessageCategoryName | firstCat methodRef | methodRef := browser messageList first. firstCat := methodRef actualClass organization categoryOfElement: methodRef selector. browser messageListIndex: 1. self assert: browser selectedMessageCategoryName = firstCat. browser messageListIndex: 0. self assert: browser selectedMessageCategoryName isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selectedMessageCategoryName = firstCat.! ----- Method: MessageSetTest>>testSelectedMessageName (in category 'testing') ----- testSelectedMessageName | firstSel | firstSel := browser messageList first selector. browser messageListIndex: 1. self assert: browser selectedMessageName = firstSel. browser messageListIndex: 0. self assert: browser selectedMessageName isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selectedMessageName = firstSel.! ----- Method: MessageSetTest>>testSelection (in category 'testing') ----- testSelection | firstRef | firstRef := browser messageList first. browser messageListIndex: 1. self assert: browser selection = firstRef. browser messageListIndex: 0. self assert: browser selection isNil. "And just to be sure:" browser messageListIndex: 1. self assert: browser selection = firstRef.! ----- Method: MessageSetTest>>update: (in category 'private') ----- update: aSelector updates addLast: aSelector.! MessageSetTest subclass: #MessageTraceTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! ----- Method: MessageTraceTest>>setUp (in category 'as yet unclassified') ----- setUp browser := (MessageTrace openMessageList: (SystemNavigation default allImplementorsOf: #browseAllImplementorsOf:) name: 'Test MessageSet' autoSelect: nil) model. browser addDependent: self.! ----- Method: MessageTraceTest>>testRemoveMessageFromBrowser (in category 'as yet unclassified') ----- testRemoveMessageFromBrowser | count sel | browser messageListIndex: 1. sel := browser selection. browser removeMessageFromBrowser. self deny: (browser messageList includes: sel) description: 'Method not removed'. "In a MessageTrace, having an unselected message and then removing it means 'remove the first message'." browser messageListIndex: 0. count := browser messageList size. browser removeMessageFromBrowser. self assert: count - 1 = browser messageList size description: 'Method not removed'.! TestCase subclass: #OrderedCollectionInspectorTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Inspector'! ----- Method: OrderedCollectionInspectorTest>>testUninitialized (in category 'as yet unclassified') ----- testUninitialized "Single stepping through a debugger can observe the object state after creation but before initiialisation." "Thus 'object size' may throw an axception for trying to do arithmetic on nil." "Modified OrderedCollectionInspector>>fieldList to call 'self objectSize' to handle this exception." "Original error reproduction: [ self halt. OrderedCollectionInspector openOn: (OrderedCollection new: 5) ] " "This should not throw an exception." (OrderedCollectionInspector openOn: OrderedCollection basicNew) delete.! TestCase subclass: #PackagePaneBrowserTest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Browser'! ----- Method: PackagePaneBrowserTest>>setUp (in category 'as yet unclassified') ----- setUp browser := PackagePaneBrowser new.! ----- Method: PackagePaneBrowserTest>>testClassList (in category 'as yet unclassified') ----- testClassList browser selectSystemCategory: browser class category. self assert: browser classList = (SystemOrganization listAtCategoryNamed: browser class category). browser selectSystemCategory: nil. self assert: browser classList isEmpty.! ----- Method: PackagePaneBrowserTest>>testPackageListIndex (in category 'as yet unclassified') ----- testPackageListIndex browser packageListIndex: 0. self assert: browser selectedClass isNil. browser selectCategoryForClass: browser class. "Clicking the selected package unselects the selected class." browser packageListIndex: browser packageListIndex. self assert: browser selectedClass isNil.! ----- Method: PackagePaneBrowserTest>>testSelectCategoryForClass (in category 'as yet unclassified') ----- testSelectCategoryForClass | pkgName | pkgName := browser class category copyUpTo: $-. browser selectCategoryForClass: browser class. self assert: browser selectedSystemCategory = browser class category. self assert: browser packageListIndex = (browser packageList indexOf: pkgName). browser selectSystemCategory: nil. self assert: browser classList isEmpty.! TestCase subclass: #WeakSetInspectorTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Inspector'! ----- Method: WeakSetInspectorTest>>testSymbolTableM6812 (in category 'testing') ----- testSymbolTableM6812 "this test is related to http://bugs.squeak.org/view.php?id=6812" | aWeakSet anInspector fieldSize | aWeakSet := (Symbol classPool at: #SymbolTable). anInspector := (ToolSet inspectorClassOf: aWeakSet) inspect: aWeakSet. fieldSize := anInspector fieldList size. Smalltalk garbageCollect. self assert: fieldSize = anInspector fieldList size. ! Object subclass: #DummyToolWorkingWithFileList instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-FileList'! !DummyToolWorkingWithFileList commentStamp: '<historical>' prior: 0! I'm a dummy class for testing that the registration of the tool to the FileList of actually happens. In the future the tests should cover that the class register when loaded in memory and unregister when unloaded.! ----- Method: DummyToolWorkingWithFileList class>>fileReaderServicesForFile:suffix: (in category 'class initialization') ----- fileReaderServicesForFile: fullName suffix: suffix ^ (suffix = 'kkk') ifTrue: [ self services] ifFalse: [#()] ! ----- Method: DummyToolWorkingWithFileList class>>initialize (in category 'class initialization') ----- initialize "self initialize" FileList registerFileReader: self ! ----- Method: DummyToolWorkingWithFileList class>>loadAFileForTheDummyTool: (in category 'class initialization') ----- loadAFileForTheDummyTool: aFileListOrAPath "attention. if the file list selects a file the argument will be a fullpath of the selected file else it will pass the filelist itself"! ----- Method: DummyToolWorkingWithFileList class>>serviceLoadAFilForDummyTool (in category 'class initialization') ----- serviceLoadAFilForDummyTool "Answer a service for opening the Dummy tool" ^ SimpleServiceEntry provider: self label: 'menu label' selector: #loadAFileForTheDummyTool: description: 'Menu label for dummy tool' buttonLabel: 'test'! ----- Method: DummyToolWorkingWithFileList class>>services (in category 'class initialization') ----- services ^ Array with: self serviceLoadAFilForDummyTool ! ----- Method: DummyToolWorkingWithFileList class>>unload (in category 'class initialization') ----- unload FileList unregisterFileReader: self ! ----- Method: DummyToolWorkingWithFileList class>>unregister (in category 'class initialization') ----- unregister FileList unregisterFileReader: self. ! ClassTestCase subclass: #FileListTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-FileList'! ----- Method: FileListTest>>checkIsServiceIsFromDummyTool: (in category 'private') ----- checkIsServiceIsFromDummyTool: service ^ (service instVarNamed: #provider) = DummyToolWorkingWithFileList and: [ service label = 'menu label' and: [ (service instVarNamed: #selector) = #loadAFileForTheDummyTool: ] ]! ----- Method: FileListTest>>setUp (in category 'initialize') ----- setUp DummyToolWorkingWithFileList initialize.! ----- Method: FileListTest>>tearDown (in category 'initialize') ----- tearDown DummyToolWorkingWithFileList unregister.! ----- Method: FileListTest>>testAllRegisteredServices (in category 'test') ----- testAllRegisteredServices "(self selector: #testAllRegisteredServices) debug" "This should not throw an exception." FileList allRegisteredServices.! ----- Method: FileListTest>>testMenuReturned (in category 'test') ----- testMenuReturned "(self selector: #testToolRegistered) debug" self assert: (FileList registeredFileReaderClasses includes: DummyToolWorkingWithFileList)! ----- Method: FileListTest>>testService (in category 'test') ----- testService "a stupid test to check that the class returns a service" "(self selector: #testService) debug" | service | service := (DummyToolWorkingWithFileList fileReaderServicesForFile: 'abab.kkk' suffix: 'kkk') first. self assert: (self checkIsServiceIsFromDummyTool: service). service := (DummyToolWorkingWithFileList fileReaderServicesForFile: 'zkk.gz' suffix: 'gz'). self assert: service isEmpty! ----- Method: FileListTest>>testServicesForFileEnding (in category 'test') ----- testServicesForFileEnding "(self selector: #testServicesForFileEnding) debug" self assert: (((FileList new directory: FileDirectory default; yourself) itemsForFile: 'aaa.kkk') anySatisfy: [ :ea | self checkIsServiceIsFromDummyTool: ea ]). ! ----- Method: FileListTest>>testToolRegistered (in category 'test') ----- testToolRegistered "(self selector: #testToolRegistered) debug" self assert: (FileList registeredFileReaderClasses includes: DummyToolWorkingWithFileList)! ----- Method: FileListTest>>testToolRegisteredUsingInterface (in category 'test') ----- testToolRegisteredUsingInterface "(self selector: #testToolRegisteredUsingInterface) debug" self assert: (FileList isReaderNamedRegistered: #DummyToolWorkingWithFileList)!

1 0

Squeak 4.6: MultilingualTests-fbs.18.mcz
by commits＠source.squeak.org 05 Jun '15

05 Jun '15

Chris Muller uploaded a new version of MultilingualTests to project Squeak 4.6: http://source.squeak.org/squeak46/MultilingualTests-fbs.18.mcz ==================== Summary ==================== Name: MultilingualTests-fbs.18 Author: fbs Time: 6 November 2013, 6:35:02.811 pm UUID: 07e26018-8455-3349-9b44-9ecb4aaeefb2 Ancestors: MultilingualTests-nice.17 More #shouldnt:raise: Error fixes. ==================== Snapshot ==================== SystemOrganization addCategory: #'MultilingualTests-TextConversion'! SystemOrganization addCategory: #'MultilingualTests-Display'! TestCase subclass: #FontTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MultilingualTests-Display'! !FontTest commentStamp: 'tak 3/11/2005 14:31' prior: 0! I am mainly a test for fallback font. FontTest buildSuite run! ----- Method: FontTest>>testDisplay (in category 'testing') ----- testDisplay "self debug: #testDisplay" | text font bb destPoint width | text := 'test' asText. font := TextStyle default fontOfSize: 21. text addAttribute: (TextFontReference toFont: font). bb := (Form extent: 100 @ 30) getCanvas privatePort. bb combinationRule: Form paint. font installOn: bb foregroundColor: Color black backgroundColor: Color white. destPoint := font displayString: text asString on: bb from: 1 to: 4 at: 0@0 kern: 1. width := text inject: 0 into: [:max :char | max + (font widthOf: char)]. self assert: destPoint x = (width + 4). "bb destForm asMorph openInHand." ! ----- Method: FontTest>>testFallback (in category 'testing') ----- testFallback "self debug: #testFallback" | text font bb destPoint | text := (Character value: 257) asString asText. font := TextStyle default fontOfSize: 21. text addAttribute: (TextFontReference toFont: font). bb := (Form extent: 100 @ 30) getCanvas privatePort. bb combinationRule: Form paint. font installOn: bb foregroundColor: Color black backgroundColor: Color white. destPoint := font displayString: text asString on: bb from: 1 to: 1 at: 0@0 kern: 1. "bb destForm asMorph openInHand." self assert: destPoint x = ((font widthOf: $?) + 1). ! ----- Method: FontTest>>testMultistringFallbackFont (in category 'testing') ----- testMultistringFallbackFont "self debug: #testMultistringFallbackFont" | text p style height width | [(TextStyle default fontArray at: JapaneseEnvironment leadingChar) ifNil: [^ self]] ifError: [:err :rcvr | ^ self]. text := ((#(20983874 20983876 20983878 ) collect: [:e | e asCharacter]) as: String) asText. p := NewParagraph new. style := TextStyle new leading: 0; newFontArray: {Preferences standardFlapFont}. p compose: text style: style from: 1 in: (0 @ 0 corner: 100 @ 100). "See CompositionScanner>>setActualFont: & CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:" height := style defaultFont height + style leading. width := text inject: 0 into: [:tally :next | tally + (style defaultFont widthOf: next)]. p adjustRightX. self assert: p extent = (width @ height). "Display getCanvas paragraph: p bounds: (10 @ 10 extent: 100 @ 100) color: Color black"! ----- Method: FontTest>>testMultistringFont (in category 'testing') ----- testMultistringFont "self debug: #testMultistringFont" | text p style height width | [(TextStyle default fontArray at: JapaneseEnvironment leadingChar) ifNil: [^ self]] ifError: [:err :rcvr | ^ self]. text := ((#(20983874 20983876 20983878 ) collect: [:e | e asCharacter]) as: String) asText. p := NewParagraph new. style := TextStyle default. p compose: text style: style from: 1 in: (0 @ 0 corner: 100 @ 100). "See CompositionScanner>>setActualFont: & CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:" height := style defaultFont height + style leading. width := text inject: 0 into: [:tally :next | tally + (style defaultFont widthOf: next)]. p adjustRightX. self assert: p extent = (width @ height). "Display getCanvas paragraph: p bounds: (10 @ 10 extent: 100 @ 100) color: Color black"! ----- Method: FontTest>>testParagraph (in category 'testing') ----- testParagraph "self debug: #testParagraph" | text p style height width | text := 'test' asText. p := NewParagraph new. style := TextStyle default. p compose: text style: style from: 1 in: (0 @ 0 corner: 100 @ 100). "See CompositionScanner>>setActualFont: & CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:" height := style defaultFont height + style leading. width := text inject: 0 into: [:tally :next | tally + (style defaultFont widthOf: next)]. p adjustRightX. self assert: p extent = (width @ height)! ----- Method: FontTest>>testParagraphFallback (in category 'testing') ----- testParagraphFallback "self debug: #testParagraphFallback" | text p style height width e expect | e := (Character value: 257) asString. text := ('test' , e , e , e , e , 'test') asText. expect := 'test????test'. p := NewParagraph new. style := TextStyle default. p compose: text style: style from: 1 in: (0 @ 0 corner: 100 @ 100). "See CompositionScanner>>setActualFont: & CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:" height := style defaultFont height + style leading. width := expect inject: 0 into: [:tally :next | tally + (style defaultFont widthOf: next)]. p adjustRightX. self assert: p extent = (width @ height). "Display getCanvas paragraph: p bounds: (10 @ 10 extent: 100 @ 100) color: Color black"! ----- Method: FontTest>>testResetAfterEmphasized (in category 'testing') ----- testResetAfterEmphasized "self debug: #testResetAfterEmphasized" | normal derivative | normal := TextStyle defaultFont. derivative := normal emphasized: 3. self assert: (normal derivativeFonts at: 3) == derivative. normal reset. self assert: (normal derivativeFonts select:[:any| any isSynthetic]) isEmpty ! TestCase subclass: #MultiByteFileStreamTest instanceVariableNames: 'fileName' classVariableNames: '' poolDictionaries: '' category: 'MultilingualTests-TextConversion'! ----- Method: MultiByteFileStreamTest>>tearDown (in category 'running') ----- tearDown fileName ifNotNil: [ FileDirectory default deleteFileNamed: fileName ]! ----- Method: MultiByteFileStreamTest>>testAsciiBackChunk (in category 'testing') ----- testAsciiBackChunk fileName := 'foobackchunk.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file lineEndConvention: #cr; converter: UTF8TextConverter new; cr; nextChunkPut: 'test1' printString; cr; nextChunkPut: 'test2' printString. self assert: file backChunk = (String cr , 'test2' printString); assert: file backChunk = (String cr , 'test1' printString) ]! ----- Method: MultiByteFileStreamTest>>testBinaryUpTo (in category 'testing') ----- testBinaryUpTo "This is a non regression test for bug http://bugs.squeak.org/view.php?id=6933" fileName := 'foobug6933'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file binary; nextPutAll: #[ 1 2 3 4 ] ]. MultiByteFileStream oldFileNamed: fileName do: [ :file | file binary. self assert: (file upTo: 3) = #[ 1 2 ] ]! ----- Method: MultiByteFileStreamTest>>testByteTextConverter (in category 'testing') ----- testByteTextConverter | strings converterClasses | strings := { String newFrom: ((0 to: 255) collect: [:e | e asCharacter]). }. converterClasses := ByteTextConverter allSubclasses. converterClasses do: [:converterClass | strings do: [:string | | converter stream encoded decoded encoded2 | converter := converterClass new. stream := string readStream. encoded := string select: [:e | (converter nextFromStream: stream) notNil]. stream := encoded readStream. decoded := encoded collect: [:e | converter nextFromStream: stream]. self assert: stream atEnd. stream := String new writeStream. converter nextPutAll: decoded toStream: stream. encoded2 := stream contents. self assert: (encoded2 collect: [:e | e charCode] as: Array) = (encoded collect: [:e | e charCode] as: Array). stream := String new writeStream. decoded do: [:e | converter nextPut: e toStream: stream]. encoded2 := stream contents. self assert: (encoded2 collect: [:e | e charCode] as: Array) = (encoded collect: [:e | e charCode] as: Array)]]! ----- Method: MultiByteFileStreamTest>>testLineEndConvention:withConverter:ifFail: (in category 'helpers') ----- testLineEndConvention: lineEndConvention withConverter: textConverterClass ifFail: failBlock | expectedResult result | [ MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file converter: textConverterClass new; lineEndConvention: lineEndConvention; cr; nextPut: Character cr; nextPutAll: String cr; nextPutAll: String cr asWideString ]. result := StandardFileStream oldFileNamed: fileName do: [ :file | file contents ]. expectedResult := String streamContents: [ :stream | 4 timesRepeat: [ stream perform: lineEndConvention ] ]. result = expectedResult ifFalse: [ failBlock value: expectedResult asByteArray value: result asByteArray ] ] on: Error do: [ :err | failBlock value: err messageText value: err messageText ]! ----- Method: MultiByteFileStreamTest>>testLineEndConversion (in category 'testing') ----- testLineEndConversion | failures | fileName := 'foolinendconversion.txt'. failures := OrderedCollection new. TextConverter allSubclassesDo: [ :textConverterClass | textConverterClass encodingNames ifNotEmpty: [ #(cr lf crlf) do: [ :lineEndConvention | self testLineEndConvention: lineEndConvention withConverter: textConverterClass ifFail: [ :expectedResult :result | failures add: { textConverterClass. lineEndConvention. expectedResult. result } ] ] ] ]. self assert: failures isEmpty! ----- Method: MultiByteFileStreamTest>>testLineEnding (in category 'testing') ----- testLineEnding fileName := 'foolinend.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file wantsLineEndConversion: false; nextPutAll: 'line 1'; cr; nextPutAll: 'line 2'; crlf; nextPutAll: 'line 3'; lf; nextPutAll: 'line 4' ]. { {#cr. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#lf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#crlf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {nil. 'line 1' , String cr , 'line 2' , String crlf , 'line 3' , String lf , 'line 4'} } do: [:lineEndingResult | MultiByteFileStream oldFileNamed: fileName do: [ :file | file lineEndConvention: lineEndingResult first. self assert: file upToEnd = lineEndingResult last ] ]! ----- Method: MultiByteFileStreamTest>>testLineEndingChunk (in category 'testing') ----- testLineEndingChunk fileName := 'foolinend.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file wantsLineEndConversion: false; nextPutAll: 'line 1'; cr; nextPutAll: 'line 2'; crlf; nextPutAll: 'line 3'; lf; nextPutAll: 'line 4'; nextPut: $!! ]. { {#cr. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#lf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#crlf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {nil. 'line 1' , String cr , 'line 2' , String crlf , 'line 3' , String lf , 'line 4'} } do: [:lineEndingResult | MultiByteFileStream oldFileNamed: fileName do: [ :file | file lineEndConvention: lineEndingResult first. self assert: lineEndingResult last equals: file nextChunk ] ]! ----- Method: MultiByteFileStreamTest>>testLineEndingWithWideStrings (in category 'testing') ----- testLineEndingWithWideStrings | cr lf crlf | fileName := 'foolinend.txt'. cr := String cr asWideString. lf := String lf asWideString. crlf := String crlf asWideString. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file wantsLineEndConversion: false; nextPutAll: 'line 1'; nextPutAll: cr; nextPutAll: 'line 2'; nextPutAll: crlf; nextPutAll: 'line 3'; nextPutAll: lf; nextPutAll: 'line 4' ]. { {#cr. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#lf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {#crlf. 'line 1' , String cr , 'line 2' , String cr , 'line 3' , String cr , 'line 4'}. {nil. 'line 1' , String cr , 'line 2' , String crlf , 'line 3' , String lf , 'line 4'} } do: [ :lineEndingResult | MultiByteFileStream oldFileNamed: fileName do: [ :file | file lineEndConvention: lineEndingResult first. self assert: file upToEnd = lineEndingResult last ] ]! ----- Method: MultiByteFileStreamTest>>testMultiByteTextConverter (in category 'testing') ----- testMultiByteTextConverter | strings converterClasses | strings := { String newFrom: ((0 to: 255) collect: [:e | Unicode value: e]). String newFrom: ((0 to: 1023) collect: [:e | Unicode value: e]). }. converterClasses := { UTF8TextConverter . UTF16TextConverter . "CompoundTextConverter ." "EUCJPTextConverter . CNGBTextConverter . ShiftJISTextConverter . EUCKRTextConverter"}. converterClasses do: [:converterClass | strings do: [:string | | converter stream | converter := converterClass new. stream := String new writeStream. converter nextPutAll: string toStream: stream. stream := stream contents readStream. string do: [:e | | decoded | decoded := converter nextFromStream: stream. self assert: e charCode = decoded charCode]. self assert: stream atEnd. stream := String new writeStream. string do: [:e | converter nextPut: e toStream: stream]. stream := stream contents readStream. string do: [:e | | decoded | decoded := converter nextFromStream: stream. self assert: e charCode = decoded charCode]. self assert: stream atEnd]]! ----- Method: MultiByteFileStreamTest>>testNextLine (in category 'testing') ----- testNextLine fileName := 'foonextline.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file wantsLineEndConversion: false; nextPutAll: 'line 1'; cr; nextPutAll: 'line 2'; crlf; nextPutAll: 'line 3'; lf; nextPutAll: 'line 4' ]. #(cr lf crlf nil) do: [:lineEnding | MultiByteFileStream oldFileNamed: fileName do: [ :file | file lineEndConvention: lineEnding. self assert: file nextLine = 'line 1'; assert: file nextLine = 'line 2'; assert: file nextLine = 'line 3'; assert: file nextLine = 'line 4'; assert: file nextLine = nil ] ]! ----- Method: MultiByteFileStreamTest>>testNextPutAllStartingAt (in category 'testing') ----- testNextPutAllStartingAt | result | fileName := 'foonextputallstartingat.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | { 'abcde' asWideString. 'abcde' } do: [ :string | file next: 1 putAll: string startingAt: 5; next: 3 putAll: string startingAt: 2; next: 1 putAll: string startingAt: 1 ] ]. result := StandardFileStream readOnlyFileNamed: fileName do: [ :file | file binary; contents ]. self assert: #[101 98 99 100 97 101 98 99 100 97] equals: result ! ----- Method: MultiByteFileStreamTest>>testNonAsciiBackChunk (in category 'testing') ----- testNonAsciiBackChunk "Note: this is an expected failure: MultiByteFileStream is not equipped to read back non ASCII String... (no comment) As a consequence, never use non ASCII in method category nor in your initials. That would make a few tools blind..." fileName := 'foobackchunk.txt'. MultiByteFileStream forceNewFileNamed: fileName do: [ :file | file lineEndConvention: #cr; converter: UTF8TextConverter new; cr; nextChunkPut: 'testé' printString; cr; nextChunkPut: 'test' printString. self assert: file backChunk = (String cr , 'test' printString). self assert: file backChunk = (String cr , 'testé' printString) ]! TestCase subclass: #UTF16TextConverterTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MultilingualTests-TextConversion'! ----- Method: UTF16TextConverterTest>>testByteOrders (in category 'testing') ----- testByteOrders |converter originalText bytes decodedText | originalText := 'test'. converter := UTF16TextConverter new. "Default (ie useLittleEndian instvar nil)" bytes := (originalText convertToWithConverter: converter). decodedText := bytes convertFromWithConverter: converter. self assert: originalText equals: decodedText. "Little-endian" converter useLittleEndian: true. bytes := (originalText convertToWithConverter: converter). decodedText := bytes convertFromWithConverter: converter. self assert: originalText equals: decodedText. "Big-endian" converter useLittleEndian: false. bytes := (originalText convertToWithConverter: converter). decodedText := bytes convertFromWithConverter: converter. self assert: originalText equals: decodedText. ! ClassTestCase subclass: #UTF8TextConverterTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MultilingualTests-TextConversion'! ----- Method: UTF8TextConverterTest>>testLazyConversion (in category 'tests') ----- testLazyConversion "Ensure the lazy conversions do what they should" | strict result | strict := UTF8TextConverter strictUtf8Conversions. [UTF8TextConverter strictUtf8Conversions: false. result := 'Grüß Gott' utf8ToSqueak. ] ensure:[UTF8TextConverter strictUtf8Conversions: strict]. self assert: result = 'Grüß Gott'. ! ----- Method: UTF8TextConverterTest>>testSqueakToUtf8 (in category 'tests') ----- testSqueakToUtf8 "Ensure proper encoding" self assert: '' squeakToUtf8 equals: ''. self assert: 'Hello World' squeakToUtf8 equals: 'Hello World'. self assert: 'Grüß Gott' squeakToUtf8 asByteArray equals: #[71 114 195 188 195 159 32 71 111 116 116]! ----- Method: UTF8TextConverterTest>>testStrictConversion (in category 'tests') ----- testStrictConversion "Ensure the strict conversions do what they should" | strict | strict := UTF8TextConverter strictUtf8Conversions. [UTF8TextConverter strictUtf8Conversions: true. self should:[ 'Grüß Gott' utf8ToSqueak ] raise: Error. ] ensure:[UTF8TextConverter strictUtf8Conversions: strict].! ----- Method: UTF8TextConverterTest>>testUtf8ToSqueak (in category 'tests') ----- testUtf8ToSqueak "Ensure proper encoding" self assert: '' utf8ToSqueak equals: ''. self assert: 'Hello World' utf8ToSqueak equals: 'Hello World'. self assert: #[71 114 195 188 195 159 32 71 111 116 116] asString utf8ToSqueak equals: 'Grüß Gott' !

1 0

← Newer
1
...
8
9
10
11
12
13
14
...
17
Older →

Jump to page: