Packages April 2020

packages@lists.squeakfoundation.org

1 participants
67 discussions

The Trunk: Morphic-fn.1654.mcz
by commits＠source.squeak.org 30 Apr '20

30 Apr '20

Fabio Niephaus uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-fn.1654.mcz ==================== Summary ==================== Name: Morphic-fn.1654 Author: fn Time: 30 April 2020, 3:27:32.337614 pm UUID: 7c5e8137-2bf8-4480-8713-905cd3640a4d Ancestors: Morphic-mt.1653 Inject `style` variable via #ifNotNil:. =============== Diff against Morphic-mt.1653 =============== Item was changed: ----- Method: ImageMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + self borderStyle ifNotNil:[:style | - | style | - (style := self borderStyle) ifNotNil:[ style frameRectangle: bounds on: aCanvas. ]. self isOpaque ifTrue:[aCanvas drawImage: image at: self innerBounds origin] ifFalse:[aCanvas translucentImage: image at: self innerBounds origin]!

1 0

The Trunk: KernelTests-mt.380.mcz
by commits＠source.squeak.org 30 Apr '20

30 Apr '20

Marcel Taeumel uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-mt.380.mcz ==================== Summary ==================== Name: KernelTests-mt.380 Author: mt Time: 30 April 2020, 12:22:16.766652 pm UUID: c45fab34-ced0-9340-9f23-8f6af2c21f88 Ancestors: KernelTests-mt.379 Split up memory allocation tests. =============== Diff against KernelTests-mt.379 =============== Item was changed: ----- Method: AllocationTest>>testOutOfMemorySignal (in category 'tests') ----- testOutOfMemorySignal + "Ensure that OutOfMemory is signaled eventually. Restrain the available memory first to not stress the machine too much." + - "Ensure that OutOfMemory is signaled eventually" | sz | self setFreeSpaceLimitOf: 1024 * 1024 * 1024 * (Smalltalk wordSize = 8 ifTrue: [4] ifFalse: [1.5]) around: [sz := 512*1024*1024. "work around the 1GB alloc bug" + self should: [(1 to: 2000) collect: [:i| Array new: sz]] raise: OutOfMemory].! - self should: [(1 to: 2000) collect: [:i| Array new: sz]] raise: OutOfMemory]. - - "Call me when this test fails, I want your machine." - "Current (2017) Spur VMs fail new: & basicNew: with #'bad argument' if given other than a non-negative SmallInteger." - sz := 1024*1024*1024*1024. - self should: [Array new: sz] - raise: OutOfMemory, Error - withExceptionDo: - [:ex| - ex class == Error ifTrue: - [self assert: [ex messageText includesSubstring: 'basicNew: with invalid argument']]]! Item was added: + ----- Method: AllocationTest>>testOutOfMemorySignalExtreme (in category 'tests') ----- + testOutOfMemorySignalExtreme + "Try to allocate a ridiculous amount of memory and check whether the expected error is signaled. Call Eliot when this test fails, he want your machine. :-) + + Note that current (2017) Spur VMs fail in #new: and #basicNew: with #'bad argument' if given other than a non-negative SmallInteger. + + Also note that this test can be quite stressful to your machine depending on how your operating system allocates the required memory behind the curtains. Better not triggering some robot fetching a tape from somewhere..." + + | sz | + sz := 1024*1024*1024*1024. "= 1 TiB" + self should: [Array new: sz] + raise: OutOfMemory, Error + withExceptionDo: + [:ex| + ex class == Error ifTrue: + [self assert: [ex messageText includesSubstring: 'basicNew: with invalid argument']]]!

1 0

The Trunk: Help-Squeak-Project-nice.80.mcz
by commits＠source.squeak.org 29 Apr '20

29 Apr '20

Nicolas Cellier uploaded a new version of Help-Squeak-Project to project The Trunk: http://source.squeak.org/trunk/Help-Squeak-Project-nice.80.mcz ==================== Summary ==================== Name: Help-Squeak-Project-nice.80 Author: nice Time: 29 April 2020, 10:36:37.48125 pm UUID: e5ced11f-73d5-1d4f-a9ac-5af520cc1abe Ancestors: Help-Squeak-Project-mt.79 Let Help survive to Inspector refactorings. =============== Diff against Help-Squeak-Project-mt.79 =============== Item was changed: ----- Method: SqueakMessageCategoriesHelp>>menu (in category 'menu') ----- menu "This category includes all methods related to menus, often context menus in particular. It contains methods defining the menu as well as often callbacks for the labels of menu items or the actions to be executed. Sometimes the menus are split up in different categories if there are multiple menus or submenus." + ^ {Inspector>>#mainFieldListMenu: . SystemWindow>>#makeClosable}! - ^ {DictionaryInspector>>#mainFieldListMenu: . SystemWindow>>#makeClosable}!

1 0

The Trunk: PreferenceBrowser-mt.103.mcz
by commits＠source.squeak.org 29 Apr '20

29 Apr '20

Marcel Taeumel uploaded a new version of PreferenceBrowser to project The Trunk: http://source.squeak.org/trunk/PreferenceBrowser-mt.103.mcz ==================== Summary ==================== Name: PreferenceBrowser-mt.103 Author: mt Time: 29 April 2020, 8:45:37.770261 pm UUID: b939aeb0-0229-c14b-94fe-2fd07189ecb8 Ancestors: PreferenceBrowser-mt.102 Fixes a bug with some redundant tooltip ... because that quick-and-dirty way to find existing preferences did not work out. Note that the preference wizard can provide its own namespace for preferences with custom state/getter and setter messages. Luckily, much of the wizard's selection matches something from the system-wide Preferences. Look at the wizard as something that provides a nice first contact to set up important stuff in the environment. That "stuff" is not necessarily present in Preferences but maybe also in some specific class such as for pragma preferences. So the wizard acts as a GoF Facade. =============== Diff against PreferenceBrowser-mt.102 =============== Item was changed: ----- Method: PreferenceWizardMorph>>initializePage04InteractionMore (in category 'initialization - pages') ----- initializePage04InteractionMore | currentPage pane | currentPage := pages add: self createPage. pane := self createScrollPane. currentPage addMorphBack: (self createLabel: 'Choose more interaction settings' color: Color white). currentPage addMorphBack: pane. pane scroller firstSubmorph addAllMorphsBack: { self createCheckbox: 'Windows raise on click' translated for: #WindowsRaiseOnClick help: #(window raise). self createCheckbox: 'Windows always active' for: #WindowsAlwaysActive help: #(window content active). self createCheckbox: 'Window buttons always active' translated for: #WindowButtonsAlwaysActive help: #(window control active). self createVerticalSpace. self createCheckbox: 'Smart horizontal splitters' translated for: #SmartHorizontalSplitters help: #(horizontal splitter). self createCheckbox: 'Smart vertical splitters' translated for: #SmartVerticalSplitters help: #(vertical splitter). self createVerticalSpace. + self createCheckbox: 'Filterable lists and trees' translated for: #FilterableLists help: 'Type something to filter lists. Press [return] to clear the filter. Press [backspace] to clear and restore prior selection.' translated. - self createCheckbox: 'Filterable lists and trees' translated for: #FilterableLists help: #(filterable). self createCheckbox: 'Filters clear if unfocused' translated for: #ClearFilterAutomatically help: #(filter clear). self createVerticalSpace. self createCheckbox: 'Attach tools to mouse' translated for: #AttachToolsToMouse help: #(tools attach). }.!

1 0

The Trunk: System-mt.1155.mcz
by commits＠source.squeak.org 28 Apr '20

28 Apr '20

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1155.mcz ==================== Summary ==================== Name: System-mt.1155 Author: mt Time: 28 April 2020, 12:11:07.714111 pm UUID: 6949d8a6-9bc9-3948-ac32-9934474feb74 Ancestors: System-eem.1154 Fixes URL to CI badge. Not sure why it has worked before. =============== Diff against System-eem.1154 =============== Item was changed: ----- Method: SystemVersion>>ciStatusBadgeUrl (in category 'continuous integration') ----- ciStatusBadgeUrl | branch | branch := 'squeak-{1}{2}{3}' format: { self isRelease ifTrue: [self majorVersionNumber] ifFalse: ['']. self isRelease ifTrue: ['.'] ifFalse: ['trunk']. self isRelease ifTrue: [self minorVersionNumber] ifFalse: [''] }. + ^ 'https://api.travis-ci.org/squeak-smalltalk/squeak-app.png?branch=', branch! - ^ 'https://secure.travis-ci.org/squeak-smalltalk/squeak-app.png?branch=', branch!

1 0

The Trunk: 60Deprecated-mt.75.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-mt.75.mcz ==================== Summary ==================== Name: 60Deprecated-mt.75 Author: mt Time: 27 April 2020, 10:23:37.40034 am UUID: aa22ba85-9bb6-ec4c-837e-afefdf3fc490 Ancestors: 60Deprecated-nice.74 Complements Tools-mt.965. Inspector refactoring. See: http://forum.world.st/Please-try-out-Inspector-Refactoring-tp5114974.html =============== Diff against 60Deprecated-nice.74 =============== Item was added: + CompiledCodeInspector subclass: #CompiledMethodInspector + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: '60Deprecated-Tools-Inspector'! + + !CompiledMethodInspector commentStamp: 'mt 4/6/2020 08:30' prior: 0! + Deprecated since CompiledCodeInspector can inspect both CompiledBlock and CompiledMethod.! Item was added: + ----- Method: Debugger>>receiverInspectorObject:context: (in category '*60Deprecated-accessing') ----- + receiverInspectorObject: obj context: ctxt + "set context before object so it can refer to context when building field list" + + self deprecated: 'Talk to #receiverInspector directly.'. + + receiverInspector context: ctxt. + receiverInspector inspect: obj. + ! Item was added: + ----- Method: DictionaryInspector>>refreshView (in category '*60Deprecated-menu commands') ----- + refreshView + + self deprecated: 'Use #update instead.'. + ^ self update! Item was added: + ----- Method: DictionaryInspector>>selectionReferences (in category '*60Deprecated-menu commands') ----- + selectionReferences + + self deprecated: 'Use #usersOfSelectedBinding.'. + self usersOfSelectedBinding.! Item was removed: - ----- Method: ExternalStructureInspector>>fieldList (in category 'accessing') ----- - fieldList - ^ (Array with: 'self: ', object defaultLabelForInspector with: 'all inst vars'), self recordFieldList! Item was added: + ----- Method: ExternalStructureInspector>>fieldSelf (in category 'fields') ----- + fieldSelf + + ^ super fieldSelf + name: 'self: ', object defaultLabelForInspector; + yourself! Item was added: + ----- Method: ExternalStructureInspector>>fieldsRecordsOn: (in category 'fields') ----- + fieldsRecordsOn: aStream + + self recordFieldList do: [:field | + aStream nextPut: ((self newFieldForType: #record key: field) + valueGetter: [:object | object perform: field]; + valueSetter: [:object :value | (field, ':') asSymbol with: value]; + yourself)].! Item was removed: - ----- Method: ExternalStructureInspector>>replaceSelectionValue: (in category 'selecting') ----- - replaceSelectionValue: anObject - "Add colon to fieldname to get setter selector, and send it to object with the argument. - Refer to the comment in Inspector|replaceSelectionValue:." - - selectionIndex = 1 - ifTrue: [^object] - ifFalse: [^object perform: ((self fieldList at: selectionIndex), ':') asSymbol with: anObject]! Item was removed: - ----- Method: ExternalStructureInspector>>selection (in category 'selecting') ----- - selection - "Refer to the comment in Inspector|selection." - selectionIndex = 0 ifTrue:[^object printString]. - selectionIndex = 1 ifTrue: [^object]. - selectionIndex = 2 ifTrue:[^object longPrintString]. - selectionIndex > 2 - ifTrue: [^object perform: (self fieldList at: selectionIndex)]! Item was added: + ----- Method: ExternalStructureInspector>>streamFieldsOn: (in category 'fields') ----- + streamFieldsOn: aStream + + self + streamBaseFieldsOn: aStream; + fieldsRecordsOn: aStream.! Item was added: + ----- Method: Inspector>>classHierarchy (in category '*60Deprecated-menu') ----- + classHierarchy + + self deprecated. + ^ self browseClassHierarchy! Item was added: + ----- Method: Inspector>>exploreObject (in category '*60Deprecated-toolbuilder') ----- + exploreObject + + self deprecated. + self replaceInspectorWithExplorer.! Item was added: + ----- Method: MorphExtension>>inspectElement (in category '*60Deprecated-other') ----- + inspectElement + + self deprecated: 'Use MorphInspector. Also see Inspector >> #inspectOne'.! Item was added: + CollectionInspector subclass: #OrderedCollectionInspector + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: '60Deprecated-Tools-Inspector'! + + !OrderedCollectionInspector commentStamp: 'mt 4/6/2020 08:30' prior: 0! + I am an Inspector that is specialized for inspecting OrderedCollections. Deprecated since regular CollectionInspector can add and remove elements.!

1 0

The Trunk: EToys-mt.391.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.391.mcz ==================== Summary ==================== Name: EToys-mt.391 Author: mt Time: 27 April 2020, 10:22:52.65734 am UUID: 7f2547da-e6cd-4b47-b5ba-dba9f4b65efc Ancestors: EToys-mt.390 Complements Tools-mt.965. Inspector refactoring. See: http://forum.world.st/Please-try-out-Inspector-Refactoring-tp5114974.html =============== Diff against EToys-mt.390 =============== Item was removed: - ----- Method: HtmlEntity>>inspect (in category 'user interface') ----- - inspect - "Open an HtmlEntityInspector on the receiver. - Use basicInspect to get a normal type of inspector." - - HtmlEntityInspector openOn: self! Item was removed: - ----- Method: HtmlEntity>>inspectWithLabel: (in category 'user interface') ----- - inspectWithLabel: aLabel - "Open a HtmlEntityInspector on the receiver. Use basicInspect to get a normal (less useful) type of inspector." - - HtmlEntityInspector openOn: self withLabel: aLabel! Item was added: + ----- Method: HtmlEntity>>inspectorClass (in category 'user interface') ----- + inspectorClass + + ^ HtmlEntityInspector! Item was changed: Inspector subclass: #HtmlEntityInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Etoys-Squeakland-Network-HTML-Parser'! + + !HtmlEntityInspector commentStamp: 'mt 4/22/2020 08:13' prior: 0! + I am an inspector for HTML entities.! Item was added: + ----- Method: HtmlEntityInspector>>fieldHtml (in category 'fields') ----- + fieldHtml + + ^ (self newFieldForType: #custom key: #html) + name: 'asHtml'; emphasizeName; + valueGetter: [:object | object asHtml]; + yourself! Item was removed: - ----- Method: HtmlEntityInspector>>fieldList (in category 'accessing') ----- - fieldList - ^ super fieldList, (Array with: 'asHtml')! Item was changed: + ----- Method: HtmlEntityInspector>>initialExtent (in category 'toolbuilder') ----- - ----- Method: HtmlEntityInspector>>initialExtent (in category 'accessing') ----- initialExtent "Answer the desired extent for the receiver when it is first opened on the screen. " ^ 300 @ 300! Item was removed: - ----- Method: HtmlEntityInspector>>selection (in category 'selecting') ----- - selection - selectionIndex = self fieldList size - ifTrue: [^object asHtml] - ifFalse: [^super selection]! Item was added: + ----- Method: HtmlEntityInspector>>streamFieldsOn: (in category 'fields') ----- + streamFieldsOn: aStream + + super streamFieldsOn: aStream. + aStream nextPut: self fieldHtml.! Item was changed: ----- Method: Inspector class>>horizontalDividerProportion (in category '*Etoys-Squeakland-instance creation') ----- horizontalDividerProportion + self deprecated. ^ 0.4! Item was changed: ----- Method: Inspector>>tearOffTile (in category '*Etoys-menu commands') ----- tearOffTile "Tear off a tile that refers to the receiver's selection, and place it in the mophic hand" + self currentHand attachMorph: (TileMorph new referTo: self selectionOrObject)! - | objectToRepresent | - objectToRepresent := self selectionIndex = 0 ifTrue: [object] ifFalse: [self selection]. - self currentHand attachMorph: (TileMorph new referTo: objectToRepresent) - ! Item was added: + ----- Method: Object>>tearOffTile (in category '*Etoys-tiles') ----- + tearOffTile + + | tile | + tile := TileMorph new referTo: self. + self currentHand attachMorph: tile. + ^ tile!

1 0

The Trunk: Protocols-mt.73.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of Protocols to project The Trunk: http://source.squeak.org/trunk/Protocols-mt.73.mcz ==================== Summary ==================== Name: Protocols-mt.73 Author: mt Time: 27 April 2020, 10:22:25.97834 am UUID: 09725779-11da-f54f-a16f-d9c5823cf532 Ancestors: Protocols-nice.72 Complements Tools-mt.965. Inspector refactoring. See: http://forum.world.st/Please-try-out-Inspector-Refactoring-tp5114974.html =============== Diff against Protocols-nice.72 =============== Item was changed: ----- Method: Inspector>>browseFullProtocol (in category '*Protocols-Tools') ----- browseFullProtocol "Open up a protocol-category browser on the value of the receiver's current selection. If in mvc, an old-style protocol browser is opened instead." + self flag: #ct "ToolSet?". - | objectToRepresent | Smalltalk isMorphic ifFalse: [^ self spawnProtocol]. + ^ InstanceBrowser new openOnObject: self selectionOrObject showingSelector: nil! - - objectToRepresent := self selectionIndex = 0 ifTrue: [object] ifFalse: [self selection]. - InstanceBrowser new openOnObject: objectToRepresent showingSelector: nil! Item was changed: ----- Method: Inspector>>spawnFullProtocol (in category '*Protocols-Tools') ----- spawnFullProtocol "Spawn a window showing full protocol for the receiver's selection" + ^ ProtocolBrowser openFullProtocolForClass: self classOfSelection! - | objectToRepresent | - objectToRepresent := self selectionIndex = 0 ifTrue: [object] ifFalse: [self selection]. - ProtocolBrowser openFullProtocolForClass: objectToRepresent class! Item was changed: ----- Method: Inspector>>spawnProtocol (in category '*Protocols-Tools') ----- spawnProtocol "Spawn a protocol on browser on the receiver's selection" + ^ ProtocolBrowser openSubProtocolForClass: self classOfSelection! - | objectToRepresent | - objectToRepresent := self selectionIndex = 0 ifTrue: [object] ifFalse: [self selection]. - ProtocolBrowser openSubProtocolForClass: objectToRepresent class!

1 0

The Trunk: ToolsTests-mt.95.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-mt.95.mcz ==================== Summary ==================== Name: ToolsTests-mt.95 Author: mt Time: 27 April 2020, 10:21:57.45834 am UUID: 6cb806ff-2f3c-d243-b561-1590e1cef376 Ancestors: ToolsTests-mt.94 Complements Tools-mt.965. Inspector refactoring. See: http://forum.world.st/Please-try-out-Inspector-Refactoring-tp5114974.html =============== Diff against ToolsTests-mt.94 =============== Item was added: + InspectorTest subclass: #BasicInspectorTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: BasicInspectorTest>>expectedFieldExpressionFailures (in category 'failures') ----- + expectedFieldExpressionFailures + + ^ #('self')! Item was added: + ----- Method: BasicInspectorTest>>selectInvalidField (in category 'support - error') ----- + selectInvalidField + "Create a custom field. The existing fields will all work because the basic inspector shows only minimal information about the object." + + self + during: [self inspector addCustomField] + type: 'self printString'.! Item was added: + ----- Method: BasicInspectorTest>>testFieldList (in category 'tests') ----- + testFieldList + + #(self 'class' 'size') do: [:label | + self assertFieldVisible: label].! Item was added: + ----- Method: BasicInspectorTest>>testFieldSelf (in category 'tests') ----- + testFieldSelf + "The basic inspector sends as little messages as possible to the object-under-inspector. So, just look for the correct class name in a field's contents." + + | namePattern | + namePattern := '*{1}*' format: { (thisContext objectClass: self object) name }. + self assert: (self inspector fields anySatisfy: [:field | namePattern match: field value]).! Item was added: + InspectorTest subclass: #ClassInspectorTest + instanceVariableNames: '' + classVariableNames: 'InnerTestObject' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: ClassInspectorTest>>createObject (in category 'running') ----- + createObject + + InnerTestObject := super createObject. + ^ self class! Item was added: + ----- Method: ClassInspectorTest>>makeObjectInvalid (in category 'support - error') ----- + makeObjectInvalid + + InnerTestObject beInvalid.! Item was added: + ----- Method: ClassInspectorTest>>selectInvalidField (in category 'support - error') ----- + selectInvalidField + + self inspector selectFieldSuchThat: [:field | + field type = #classVar and: [field value == InnerTestObject]].! Item was added: + ----- Method: ClassInspectorTest>>tearDown (in category 'running') ----- + tearDown + + InnerTestObject := nil. + super tearDown.! Item was added: + ----- Method: ClassInspectorTest>>testCustomField (in category 'tests') ----- + testCustomField + + self + during: [self inspector addCustomField] + type: 'self packageInfo'. + + self assertFieldVisible: 'self packageInfo'. + self assertFieldSelected: 'self packageInfo'. + self assertValuePaneShows: '*ToolsTests*'.! Item was added: + ----- Method: ClassInspectorTest>>testFieldList (in category 'tests') ----- + testFieldList + + #(self 'all inst vars' superclass InnerTestObject) do: [:label | + self assertFieldVisible: label].! Item was added: + ----- Method: ClassInspectorTest>>testPoolDictionaries (in category 'tests') ----- + testPoolDictionaries + "All class inspectors should list the referenced pool dictionaries. Use an existing class from the base system that is known to rely of such a pool. If we would add our own references, loading these tests could raise extra dialog prompts." + + self denyFieldVisible: 'TextConstants'. + self inspector object: TextStyle. + self assertFieldVisible: 'TextConstants'.! Item was added: + ----- Method: ClassInspectorTest>>testValuePaneModify (in category 'tests') ----- + testValuePaneModify + + self inspector selectFieldNamed: 'InnerTestObject'. + self assertFieldSelected: 'InnerTestObject'. + + self deny: 42 equals: InnerTestObject. + self inValuePaneTypeAndAccept: '42'. + self assert: 42 equals: InnerTestObject.! Item was added: + InspectorTest subclass: #CollectionInspectorTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: CollectionInspectorTest>>createObject (in category 'running') ----- + createObject + + ^ OrderedCollection new + addAll: #(discovery navel smith); + yourself! Item was added: + ----- Method: CollectionInspectorTest>>createObjectWithTruncation (in category 'running') ----- + createObjectWithTruncation + + ^ (1 to: 500) asOrderedCollection! Item was added: + ----- Method: CollectionInspectorTest>>fieldTypeOfIndexedVariable (in category 'support') ----- + fieldTypeOfIndexedVariable + + ^ #element! Item was added: + ----- Method: CollectionInspectorTest>>makeObjectInvalid (in category 'support - error') ----- + makeObjectInvalid + + self object at: 1 put: InspectorTestObject newInvalid. + self simulateStepping.! Item was added: + ----- Method: CollectionInspectorTest>>selectInvalidField (in category 'support - error') ----- + selectInvalidField + + self inspector selectFieldNamed: '1'.! Item was added: + ----- Method: CollectionInspectorTest>>testAddElement (in category 'tests') ----- + testAddElement + "Add a new element through the Smalltalk expression '6 * 7' and check whether the field representing that new element will be selected automatically." + + | objectSize | + objectSize := self object size. + + self assertFieldVisible: objectSize asString. + self deny: (self object includes: 42). + + self + during: [self inspector addElement] + type: '6 * 7'. "42" + + self assert: (self object includes: 42). + + self assertFieldVisible: (objectSize + 1) asString. + self assertFieldSelected: (objectSize + 1) asString. + self assertValuePaneShows: '42'.! Item was added: + ----- Method: CollectionInspectorTest>>testAddElementError (in category 'tests - special') ----- + testAddElementError + "Not all collections support addition or removal of elements." + + self class == CollectionInspectorTest ifFalse: [^ self "Pass the test automatically"]. + + self inspector object: Array new. + self + should: [self inspector addElement: 1] + raise: Error.! Item was added: + ----- Method: CollectionInspectorTest>>testAddElementMenu (in category 'tests') ----- + testAddElementMenu + + | testMenuEntry | + testMenuEntry := [self fieldListMenu items anySatisfy: [:item | '*add*element*' match: item contents ]]. + + self inspector selectField: nil. + self assert: testMenuEntry. + self inspector ensureSelectedField. + self assert: testMenuEntry.! Item was added: + ----- Method: CollectionInspectorTest>>testAddElementMenuHidden (in category 'tests - special') ----- + testAddElementMenuHidden + + | testMenuEntry | + self class == CollectionInspectorTest ifFalse: [^ self "Pass the test automatically"]. + + testMenuEntry := [self fieldListMenu items anySatisfy: [:item | '*add*element*' match: item contents ]]. + + self inspector object: Array new. + self deny: testMenuEntry.! Item was added: + ----- Method: CollectionInspectorTest>>testCustomField (in category 'tests') ----- + testCustomField + + self + during: [self inspector addCustomField] + type: 'self take: 5'. + + self assertFieldVisible: 'self take: 5'. + self assertFieldSelected: 'self take: 5'. + self assertValuePaneShows: '*navel*'.! Item was added: + ----- Method: CollectionInspectorTest>>testFieldList (in category 'tests') ----- + testFieldList + + #(self 'all inst vars') do: [:label | self assertFieldVisible: label]. + 1 to: self object size do: [:index | self assertFieldVisible: index printString].! Item was added: + ----- Method: CollectionInspectorTest>>testRemoveElement (in category 'tests') ----- + testRemoveElement + "Remove an element from the collection-under-inspection by selecting any element's field first and then removing that selected element." + + | element | + self assert: self object size > 1. + self inspector selectFieldSuchThat: [:field | field type = #element]. + + element := self inspector selection. + self assert: (self object includes: element). + + self inspector removeSelection. + self deny: (self object includes: element). + + "The next remaining element will automatically be selected." + self assert: #element equals: self inspector selectedField type. + self assert: (self object includes: self inspector selection).! Item was added: + ----- Method: CollectionInspectorTest>>testUninitialized (in category 'tests') ----- + testUninitialized + "Single stepping through a debugger can observe the object state after creation but before initialization. Thus 'object size' may throw an exception for trying to do arithmetic on nil." + + self inspector selectFieldNamed: 'self'. + self assertFieldSelected: 'self'. + self assertValuePaneWorks. + + self inspector object: self object class basicNew. + self assertFieldSelected: 'self'. + self denyValuePaneWorks. "It's okay because the inspector is still working."! Item was added: + ----- Method: CollectionInspectorTest>>testValuePaneModify (in category 'tests') ----- + testValuePaneModify + + | overwrittenElement | + self inspector selectFieldSuchThat: [:field | field type = #element]. + overwrittenElement := self inspector selection. + + self assert: (self object includes: overwrittenElement). + self deny: (self object includes: #ontario). + + self inValuePaneTypeAndAccept: '#ontario'. + self assertValuePaneShows: '#ontario'. + + self deny: (self object includes: overwrittenElement). + self assert: (self object includes: #ontario).! Item was added: + InspectorTest subclass: #CompiledCodeInspectorTest + instanceVariableNames: '' + classVariableNames: 'InnerTestObject' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: CompiledCodeInspectorTest>>createObject (in category 'running') ----- + createObject + "Note that we cannot return the block directly but require the indirection of #evaluate: because the resulting block will be modified during the tests. A block directly embedded in this #createObject method, however, would be re-used across test runs." + + InnerTestObject := super createObject. + ^ Compiler new + evaluate: '[String withAll: #[67 97 114 112 101] "Carpe", #Squeak, InnerTestObject printString] compiledBlock' + in: nil + to: self "Required for access to InnerTestObject"! Item was added: + ----- Method: CompiledCodeInspectorTest>>evaluateObject (in category 'running') ----- + evaluateObject + + ^ (FullBlockClosure + receiver: nil + outerContext: nil + method: self object + copiedValues: nil) value! Item was added: + ----- Method: CompiledCodeInspectorTest>>expectedFieldExpressionFailures (in category 'failures') ----- + expectedFieldExpressionFailures + + ^ #('source code')! Item was added: + ----- Method: CompiledCodeInspectorTest>>makeObjectInvalid (in category 'support - error') ----- + makeObjectInvalid + + InnerTestObject beInvalid.! Item was added: + ----- Method: CompiledCodeInspectorTest>>selectInvalidField (in category 'support - error') ----- + selectInvalidField + + self inspector selectFieldSuchThat: [:field | + field type = #literal and: [field value "binding" value == InnerTestObject]].! Item was added: + ----- Method: CompiledCodeInspectorTest>>tearDown (in category 'running') ----- + tearDown + + InnerTestObject := nil. + super tearDown.! Item was added: + ----- Method: CompiledCodeInspectorTest>>testCustomField (in category 'tests') ----- + testCustomField + + self + during: [self inspector addCustomField] + type: 'self allLiterals'. + + self assertFieldVisible: 'self allLiterals'. + self assertFieldSelected: 'self allLiterals'. + self assertValuePaneShows: '*#[*]*Squeak*'.! Item was added: + ----- Method: CompiledCodeInspectorTest>>testFieldList (in category 'tests') ----- + testFieldList + + #(self '*bytecodes*' 'header' 'literal*') do: [:label | + self assertFieldVisible: label].! Item was added: + ----- Method: CompiledCodeInspectorTest>>testValuePaneModify (in category 'tests') ----- + testValuePaneModify + "Overridden to specify the kind of value to modify in a compiled-code object: the bytecodes. Looking at #createObject, we try to replace the pushConstant of the byte array at 34 with the one at 35. So, the beginning of the resulting string will change from 'CarpeSqueak' to 'SqueakSqueak'." + + self assert: 35 equals: (self object at: 38). "pushConstant: #[ ... ]" + self assert: 36 equals: (self object at: 39). "pushConstant: #Squeak" + self assert: (self evaluateObject beginsWith: 'CarpeSqueak'). + + self inspector selectFieldNamed: '38'. "pushConstant: #[ ... ]" + self assertFieldSelected: '38'. + self inValuePaneTypeAndAccept: '36'. "pushConstant: #Squeak" + + self assert: 36 equals: (self object at: 38). "pushConstant: #Squeak" + self assert: 36 equals: (self object at: 39). "pushConstant: #Squeak" + self assert: (self evaluateObject beginsWith: 'SqueakSqueak').! Item was added: + ----- Method: CompiledCodeInspectorTest>>testValuePaneModifyLiteral (in category 'tests') ----- + testValuePaneModifyLiteral + + self inspector selectFieldSuchThat: [:field | + field type = #literal and: [field value = #Squeak]]. + + self assert: (self evaluateObject beginsWith: 'CarpeSqueak'). + self inValuePaneTypeAndAccept: '#Smalltalk'. + self assert: (self evaluateObject beginsWith: 'CarpeSmalltalk').! Item was added: + InspectorTest subclass: #ContextInspectorTest + instanceVariableNames: '' + classVariableNames: 'InnerTestObject' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: ContextInspectorTest>>createObject (in category 'running') ----- + createObject + + InnerTestObject := super createObject. + [[:arg1 :arg2 | + | temp1 temp2 | + temp1 := arg1 printString size - 1. + temp2 := arg2 - 1. + temp1 / temp2] + value: InnerTestObject value: 1] + on: Error do: [:error | + ^ error signalerContext sender copy + push: 42; + yourself]. + self error: 'Failed to set up context to inspect'! Item was added: + ----- Method: ContextInspectorTest>>makeObjectInvalid (in category 'support - error') ----- + makeObjectInvalid + + InnerTestObject beInvalid.! Item was added: + ----- Method: ContextInspectorTest>>selectInvalidField (in category 'support - error') ----- + selectInvalidField + + self inspector selectFieldSuchThat: [:field | + field type = #tempVar and: [field value == InnerTestObject]].! Item was added: + ----- Method: ContextInspectorTest>>tearDown (in category 'running') ----- + tearDown + + InnerTestObject := nil. + super tearDown.! Item was added: + ----- Method: ContextInspectorTest>>testCustomField (in category 'tests') ----- + testCustomField + + self + during: [self inspector addCustomField] + type: 'self isDead'. + + self assertFieldVisible: 'self isDead'. + self assertFieldSelected: 'self isDead'. + self assertValuePaneShows: 'false'.! Item was added: + ----- Method: ContextInspectorTest>>testDebugConstruction (in category 'tests') ----- + testDebugConstruction + + self shouldntRaiseWhileDebugging: [ + [| foo | (foo := self) yourself] asContext]! Item was added: + ----- Method: ContextInspectorTest>>testFieldList (in category 'tests') ----- + testFieldList + "No need to look for the fields for temporaries because those will be covered in other tests, which is more useful. Only list the mandatory fields here." + + #(self 'all inst vars' 'sender' 'pc' 'stackp' 'method' 'closureOrNil' 'receiver') + do: [:label | self assertFieldVisible: label].! Item was added: + ----- Method: ContextInspectorTest>>testValuePaneModify (in category 'tests') ----- + testValuePaneModify + "Try to change the values of all arguments and temporary variables. Check if the object-under-inspection receives those changes." + + | testObjectFound | + testObjectFound := false. + + self object tempNames doWithIndex: [:temp :index | + | prior current input | + self inspector selectFieldSuchThat: [:field | field type = #tempVar and: [field key = temp]]. + self assertFieldSelected: '*', temp, '*'. "allow bells and whistles" + + prior := self object namedTempAt: index. + self assert: (prior isNumber or: [prior == InnerTestObject]). + + testObjectFound := testObjectFound or: [prior == InnerTestObject]. + current := (prior isNumber ifTrue: [prior + 1] ifFalse: [#smith]). + input := prior isNumber ifTrue: [self inspector contents, ' +1'] ifFalse: ['#smith']. + + self deny: current equals: (self object namedTempAt: index). + self inValuePaneTypeAndAccept: input. + self assert: current equals: (self object namedTempAt: index)]. + + self assert: testObjectFound.! Item was added: + ContextInspectorTest subclass: #ContextVariablesInspectorTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Debugger'! Item was added: + ----- Method: ContextVariablesInspectorTest>>expectedFieldExpressionFailures (in category 'failures') ----- + expectedFieldExpressionFailures + + ^ #('stack top')! Item was added: + ----- Method: ContextVariablesInspectorTest>>testCustomField (in category 'tests') ----- + testCustomField + + self + during: [self inspector addCustomField] + type: 'thisContext isDead'. + + self assertFieldVisible: 'thisContext isDead'. + self assertFieldSelected: 'thisContext isDead'. + self assertValuePaneShows: 'false'.! Item was added: + ----- Method: ContextVariablesInspectorTest>>testFieldList (in category 'tests') ----- + testFieldList + + #(thisContext 'stack top' 'all temp vars' '*arg*' '*temp*') + do: [:label | self assertFieldVisible: label].! Item was added: + ----- Method: ContextVariablesInspectorTest>>testInspectorClass (in category 'tests') ----- + testInspectorClass + "This is inspector is a variation of regular context inspectors and is used in debuggers. So, after calling #inspect: the inspector class will indeed change to the regular one." + + | previousInspectorClass | + self assert: self object inspectorClass ~~ self inspector class. + previousInspectorClass := self inspector class. + self inspector inspect: self object. + self deny: previousInspectorClass equals: self inspector class. + self assert: self object inspectorClass equals: self inspector class.! Item was added: + CollectionInspectorTest subclass: #DictionaryInspectorTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: DictionaryInspectorTest>>createObject (in category 'running') ----- + createObject + + ^ Dictionary withAll: { + 1 -> #discovery. + 7 -> #navel. + 11 -> #smith }! Item was added: + ----- Method: DictionaryInspectorTest>>createObjectWithTruncation (in category 'running') ----- + createObjectWithTruncation + + ^ (1 to: 150) + collect: [:number | number -> #genericApple] + as: Dictionary! Item was added: + ----- Method: DictionaryInspectorTest>>testAddElement (in category 'tests') ----- + testAddElement + "The user will add a new key to the dictionary, not a value behind that key. That value needs to be set separatedly." + + self deny: (self object includesKey: 9). + + self + during: [self inspector addElement] + type: '3 ** 2'. "9" + + self assert: (self object includesKey: 9). + + self assertFieldVisible: '9'. + self assertFieldSelected: '9'. + + self assertValuePaneShows: 'nil'. + self inValuePaneTypeAndAccept: '#ontario'. + self assertValuePaneShows: '#ontario'. + + self assert: #ontario equals: (self object at: 9).! Item was added: + ----- Method: DictionaryInspectorTest>>testFieldList (in category 'tests') ----- + testFieldList + "Check whether the most important fields are visible." + + #(self 'all inst vars' tally array) do: [:label | + self assertFieldVisible: label]. + + self object keysDo: [:key | self assertFieldVisible: key printString].! Item was added: + ----- Method: DictionaryInspectorTest>>testObjectChanged (in category 'tests') ----- + testObjectChanged + + "1) Add a new key, which adds a new field to the list of fields." + self denyFieldVisible: '9'. + self object at: 9 put: nil. + self denyFieldVisible: '9'. + self simulateStepping. + self assertFieldVisible: '9'. + + "2) Change the value behind the key, which changes the value-pane's contents." + self inspector selectFieldNamed: '9'. + self assertFieldSelected: '9'. + self assertValuePaneShows: 'nil'. + self object at: 9 put: #ontario. + self assertValuePaneShows: 'nil'. + self simulateStepping. + self assertValuePaneShows: '#ontario'.! Item was added: + ClassTestCase subclass: #InspectorTest + instanceVariableNames: 'inspector' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: InspectorTest class>>shouldInheritSelectors (in category 'testing') ----- + shouldInheritSelectors + + ^ true! Item was added: + ----- Method: InspectorTest>>assert:matches: (in category 'assertions - matching') ----- + assert: pattern matches: actual + + self + assert: [(actual isString or: [actual isText]) and: [pattern match: actual]] + description: [self comparingStringBetweenMatch: pattern and: actual]! Item was added: + ----- Method: InspectorTest>>assertFieldSelected: (in category 'assertions - ui') ----- + assertFieldSelected: fieldName + "Looking at the inspector's #fieldList, which contains the list of labels visible to the user, check whether that list contains fieldName, which is the label the user is looking for." + + self + assert: (self inspector selectionIndex + between: 1 + and: self inspector fieldList size); + assert: fieldName + matches: (self inspector fieldList at: self inspector selectionIndex) asString.! Item was added: + ----- Method: InspectorTest>>assertFieldVisible: (in category 'assertions - ui') ----- + assertFieldVisible: fieldNameOrPattern + + self assert: (self inspector fieldList anySatisfy: [:label | + label asString = fieldNameOrPattern + or: [fieldNameOrPattern match: label] ]).! Item was added: + ----- Method: InspectorTest>>assertMenuWorks (in category 'assertions') ----- + assertMenuWorks + + | aMenu | + aMenu := self fieldListMenu. + self + assert: aMenu items notEmpty; + assert: (aMenu items allSatisfy: [:item | item contents notEmpty]).! Item was added: + ----- Method: InspectorTest>>assertNoFieldSelected (in category 'assertions - ui') ----- + assertNoFieldSelected + + self assert: self inspector selectionIndex = 0.! Item was added: + ----- Method: InspectorTest>>assertValuePaneShows: (in category 'assertions - ui') ----- + assertValuePaneShows: contents + + self assert: contents matches: self inspector contents.! Item was added: + ----- Method: InspectorTest>>assertValuePaneWorks (in category 'assertions') ----- + assertValuePaneWorks + + ^ self denyValuePaneShows: '<*error*debug*>'! Item was added: + ----- Method: InspectorTest>>comparingStringBetweenMatch:and: (in category 'assertions - matching') ----- + comparingStringBetweenMatch: pattern and: actual + + ^ 'Pattern {1} is not matched by actual {2}' format: ( + {pattern. actual} collect: [:arg | arg printStringLimitedTo: 10])! Item was added: + ----- Method: InspectorTest>>createObject (in category 'running') ----- + createObject + + ^ InspectorTestObject new + apple: #discovery; + orange: #navel; + yourself! Item was added: + ----- Method: InspectorTest>>createObjectWithTruncation (in category 'running') ----- + createObjectWithTruncation + "Create an object that will surely trigger truncation of inspector fields when being inspected." + + ^ (InspectorTestObject new: 500) + apple: #discovery; + orange: #navel; + yourself! Item was added: + ----- Method: InspectorTest>>deny:matches: (in category 'assertions - matching') ----- + deny: pattern matches: actual + + self + deny: [(actual isString or: [actual isText]) and: [pattern match: actual]] + description: ['Actually matches {1}' format: {pattern}]! Item was added: + ----- Method: InspectorTest>>denyFieldSelected: (in category 'assertions - ui') ----- + denyFieldSelected: fieldName + + self deny: (self inspector fieldList at: self inspector selectionIndex) asString = fieldName.! Item was added: + ----- Method: InspectorTest>>denyFieldVisible: (in category 'assertions - ui') ----- + denyFieldVisible: fieldName + + self assert: (self inspector fieldList noneSatisfy: [:label | + label asString = fieldName]).! Item was added: + ----- Method: InspectorTest>>denyNoFieldSelected (in category 'assertions - ui') ----- + denyNoFieldSelected + + self assert: self inspector selectionIndex > 0.! Item was added: + ----- Method: InspectorTest>>denyValuePaneShows: (in category 'assertions - ui') ----- + denyValuePaneShows: contents + + self deny: contents matches: self inspector contents.! Item was added: + ----- Method: InspectorTest>>denyValuePaneWorks (in category 'assertions') ----- + denyValuePaneWorks + + ^ self assertValuePaneShows: '*error*debug*'! Item was added: + ----- Method: InspectorTest>>during:confirm: (in category 'support - ui') ----- + during: block confirm: boolean + "When evaluating the block, there will be a dialog showing up that requests the user to confirm something. Simulate that interaction here." + + block valueSupplyingAnswer: {'*'. boolean}.! Item was added: + ----- Method: InspectorTest>>during:type: (in category 'support - ui') ----- + during: block type: expression + "When evaluating the block, there will be a dialog showing up that requests the user to type something. Simulate that interaction here." + + block valueSupplyingAnswer: {'*'. expression}.! Item was added: + ----- Method: InspectorTest>>expectedFieldExpressionFailures (in category 'failures') ----- + expectedFieldExpressionFailures + "List all fields whose 'Get field expression' feature does not yet work." + + ^ #()! Item was added: + ----- Method: InspectorTest>>fieldListMenu (in category 'support') ----- + fieldListMenu + + ^ self inspector fieldListMenu: MenuMorph new! Item was added: + ----- Method: InspectorTest>>fieldTypeOfIndexedVariable (in category 'support') ----- + fieldTypeOfIndexedVariable + + ^ #indexed! Item was added: + ----- Method: InspectorTest>>inValuePaneTypeAndAccept: (in category 'support - ui') ----- + inValuePaneTypeAndAccept: aString + "The user types aString in the value pane and accepts those contents." + + self inspector contents: aString notifying: nil.! Item was added: + ----- Method: InspectorTest>>inspector (in category 'accessing') ----- + inspector + + ^ inspector! Item was added: + ----- Method: InspectorTest>>makeObjectInvalid (in category 'support - error') ----- + makeObjectInvalid + "Violate some contract so that the inspector cannot call #printString on some field anymore without getting an error." + + self object beInvalid.! Item was added: + ----- Method: InspectorTest>>object (in category 'accessing') ----- + object + + ^ self inspector object! Item was added: + ----- Method: InspectorTest>>selectInvalidField (in category 'support - error') ----- + selectInvalidField + + self inspector selectFieldNamed: 'self'.! Item was added: + ----- Method: InspectorTest>>setUp (in category 'running') ----- + setUp + + super setUp. + inspector := self targetClass on: self createObject.! Item was added: + ----- Method: InspectorTest>>shouldntRaiseWhileDebugging: (in category 'assertions') ----- + shouldntRaiseWhileDebugging: aBlock + + aBlock newProcess runUntil: [:ctxt | + self + shouldnt: [inspector inspect: ctxt receiver] + raise: Error, Warning, Halt. + false].! Item was added: + ----- Method: InspectorTest>>simulateStepping (in category 'support - ui') ----- + simulateStepping + + self inspector stepAt: 0 in: nil.! Item was added: + ----- Method: InspectorTest>>testCustomField (in category 'tests') ----- + testCustomField + + self + during: [self inspector addCustomField] + type: 'self fruits'. + + self assertFieldVisible: 'self fruits'. + self assertFieldSelected: 'self fruits'. + self assertValuePaneShows: '*discovery*navel*'.! Item was added: + ----- Method: InspectorTest>>testCustomFieldRemove (in category 'tests') ----- + testCustomFieldRemove + + self assert: 0 equals: self inspector customFields size. + self during: [self inspector addCustomField] type: 'self'. + self assert: 1 equals: self inspector customFields size. + + self assert: self inspector selectedField type = #custom. + self during: [self inspector removeSelection] confirm: true. + self assert: 0 equals: self inspector customFields size.! Item was added: + ----- Method: InspectorTest>>testDebugConstruction (in category 'tests') ----- + testDebugConstruction + + self shouldntRaiseWhileDebugging: [ + self createObject]! Item was added: + ----- Method: InspectorTest>>testExpressions (in category 'tests') ----- + testExpressions + "All fields should provide an evaluable expression to be evaluated on the inspected objects to retrieve that field's value. Try to test that by re-setting that expression as a getter and compare the resulting values." + + self inspector fields + reject: [:field | self expectedFieldExpressionFailures includes: field name asString] + thenDo: [:field | + | expression content | + (expression := self inspector expressionForField: field) ifNil: [self fail]. + content := field getValueFor: self inspector. + field setGetterFor: self inspector to: expression ifFail: [self fail]. + self assert: content equals: (field getValueFor: self inspector)].! Item was added: + ----- Method: InspectorTest>>testFieldList (in category 'tests') ----- + testFieldList + "Check whether the most important fields are visible." + + #(self 'all inst vars' apple orange) do: [:label | + self assertFieldVisible: label].! Item was added: + ----- Method: InspectorTest>>testFieldListError (in category 'tests - special') ----- + testFieldListError + "Choose an inspector that messes up field streaming. Check whether the field list shows still something informative." + + self class == InspectorTest ifFalse: [^ self "Pass the test automatically."]. + + inspector := InspectorTestInspector on: Object new. + + self assertFieldVisible: '<error>'. + inspector ensureSelectedField. + self assertFieldSelected: '<error>'. + self assertValuePaneShows: '*error*debug*'.! Item was added: + ----- Method: InspectorTest>>testFieldListMenu (in category 'tests') ----- + testFieldListMenu + "Select one field after another and check whether the menu can be invoked." + + self assertNoFieldSelected. + self assertMenuWorks. + + 1 to: self inspector fieldList size do: [:index | + self inspector selectionIndex: index. + self denyNoFieldSelected. + self assertMenuWorks]. + ! Item was added: + ----- Method: InspectorTest>>testFieldSelf (in category 'tests') ----- + testFieldSelf + "There should be at least one field pointing to the inspected object itself." + + self assert: (self inspector fields anySatisfy: [:field | field value == self object]).! Item was added: + ----- Method: InspectorTest>>testInspectorClass (in category 'tests') ----- + testInspectorClass + "Be sure to use the correct inspector for our object-under-inspection. If this test fails, #targetClass or #setUp might be wrong." + + | previousInspectorClass | + previousInspectorClass := self inspector class. + self inspector inspect: self object. + self assert: previousInspectorClass equals: self inspector class.! Item was added: + ----- Method: InspectorTest>>testObjectChanged (in category 'tests - special') ----- + testObjectChanged + + self class == InspectorTest ifFalse: [^ self "Pass the test automatically."]. + + self inspector selectFieldNamed: 'self'. + self denyValuePaneShows: '*ontario*'. + + self object apple: #ontario. + self denyValuePaneShows: '*ontario*'. + + self simulateStepping. + self assertValuePaneShows: '*ontario*'.! Item was added: + ----- Method: InspectorTest>>testTruncationEllipsis (in category 'tests - special') ----- + testTruncationEllipsis + "Even the most generic inspector supports truncation of indexed variables." + + | ellipsis | + (self class includesSelector: #createObjectWithTruncation) + ifFalse: [^ self "Run this test only if explicitely refined."]. + + self inspector object: self createObjectWithTruncation. + self assert: self inspector class = self targetClass. "No change." + + self assert: self inspector fields size >= self inspector truncationLimit. + self assertFieldVisible: '...'. + + self inspector selectFieldSuchThat: [:field | field type = #ellipsis]. + ellipsis := self inspector selectedField. + + self assert: '*...*' matches: ellipsis name. + self assertValuePaneShows: '*not shown*'. + + self inspector fields do: [:field | + "All visible elements are from that object." + self assert: (field type = #element) ==> [self inspector object includes: field value]].! Item was added: + ----- Method: InspectorTest>>testTruncationEllipsisMenu (in category 'tests - special') ----- + testTruncationEllipsisMenu + + (self class includesSelector: #createObjectWithTruncation) + ifFalse: [^ self "Run this test only if explicitely refined."]. + + self inspector object: self createObjectWithTruncation. + self inspector selectFieldSuchThat: [:field | field type = #ellipsis]. + self assertMenuWorks.! Item was added: + ----- Method: InspectorTest>>testTruncationTail (in category 'tests - special') ----- + testTruncationTail + + | ellipsisIndex firstElementIndex | + (self class includesSelector: #createObjectWithTruncation) + ifFalse: [^ self "Run this test only if explicitely refined."]. + + self inspector object: self createObjectWithTruncation. + + firstElementIndex := self inspector fields + findFirst: [:field | field type = self fieldTypeOfIndexedVariable]. + ellipsisIndex := self inspector fields + findFirst: [:field | field type = #ellipsis]. + + self + assert: self inspector truncationLimit + equals: ellipsisIndex - firstElementIndex + 1 + self inspector truncationTail; + assert: self inspector truncationTail + equals: self inspector fields size - ellipsisIndex.! Item was added: + ----- Method: InspectorTest>>testValuePane (in category 'tests') ----- + testValuePane + "Select one field after another and check whether the value pane shows non-error contents." + + self assertNoFieldSelected. + self assertValuePaneWorks. + + 1 to: self inspector fieldList size do: [:index | + self inspector selectionIndex: index. + self denyNoFieldSelected. + self assertValuePaneWorks].! Item was added: + ----- Method: InspectorTest>>testValuePaneError (in category 'tests') ----- + testValuePaneError + + self makeObjectInvalid. + self assertValuePaneWorks. + + self selectInvalidField. + self denyValuePaneWorks.! Item was added: + ----- Method: InspectorTest>>testValuePaneModify (in category 'tests') ----- + testValuePaneModify + + self inspector selectFieldNamed: #apple. + + self deny: #ontario equals: self object apple. + self assertValuePaneShows: '#discovery'. + + self inValuePaneTypeAndAccept: '#ontario'. + + self assert: #ontario equals: self object apple. + self assertValuePaneShows: '#ontario'.! Item was added: + Inspector variableSubclass: #InspectorTestInspector + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: InspectorTestInspector>>streamFieldsOn: (in category 'fields - streaming') ----- + streamFieldsOn: aStream + + self error.! Item was added: + Object variableSubclass: #InspectorTestObject + instanceVariableNames: 'apple orange' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: InspectorTestObject class>>newInvalid (in category 'instance creation') ----- + newInvalid + "Creates an instance that cannot #printOn: without raising an error." + + ^ self new + beInvalid; + yourself! Item was added: + ----- Method: InspectorTestObject>>apple (in category 'accessing') ----- + apple + + ^ apple! Item was added: + ----- Method: InspectorTestObject>>apple: (in category 'accessing') ----- + apple: aSymbol + + apple := aSymbol.! Item was added: + ----- Method: InspectorTestObject>>beInvalid (in category 'initialization') ----- + beInvalid + + self apple: 5.! Item was added: + ----- Method: InspectorTestObject>>fruits (in category 'accessing') ----- + fruits + + ^ {self apple. self orange} select: [:fruit | fruit notNil and: [fruit size > 0]]! Item was added: + ----- Method: InspectorTestObject>>orange (in category 'accessing') ----- + orange + + ^ orange! Item was added: + ----- Method: InspectorTestObject>>orange: (in category 'accessing') ----- + orange: aSymbol + + orange := aSymbol.! Item was added: + ----- Method: InspectorTestObject>>printOn: (in category 'printing') ----- + printOn: aStream + + aStream nextPutAll: 'Today''s offers: '. + self fruits do: [:fruit | aStream print: fruit].! Item was removed: - TestCase subclass: #OrderedCollectionInspectorTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ToolsTests-Inspector'! Item was removed: - ----- Method: OrderedCollectionInspectorTest>>testUninitialized (in category 'tests') ----- - 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.! Item was added: + CollectionInspectorTest subclass: #SetInspectorTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Inspector'! Item was added: + ----- Method: SetInspectorTest>>createObject (in category 'running') ----- + createObject + + ^ Set new + addAll: #(navel discovery smith boskoop); + yourself + ! Item was added: + ----- Method: SetInspectorTest>>createObjectWithTruncation (in category 'running') ----- + createObjectWithTruncation + + ^ (1 to: 150) asSet! Item was added: + ----- Method: SetInspectorTest>>makeObjectInvalid (in category 'support - error') ----- + makeObjectInvalid + + self object add: InspectorTestObject newInvalid. + self simulateStepping.! Item was added: + ----- Method: SetInspectorTest>>selectInvalidField (in category 'support - error') ----- + selectInvalidField + + self inspector selectFieldSuchThat: [:field | + field type = #element and: [field value class == InspectorTestObject]].! Item was added: + ----- Method: SetInspectorTest>>testAddElement (in category 'tests') ----- + testAddElement + "Like super implementation but not checking the field names since we cannot now the exact indices of a set's internal array." + + self deny: (self object includes: 42). + + self + during: [self inspector addElement] + type: '6 * 7'. "42" + + self assert: (self object includes: 42). + self assertValuePaneShows: '42'.! Item was added: + ----- Method: SetInspectorTest>>testFieldList (in category 'tests') ----- + testFieldList + + #(self 'all inst vars') do: [:label | self assertFieldVisible: label]. + + self object do: [:element | self assert: ( + self inspector fields anySatisfy: [:field | + field type =#element and: [field value == element]] )]! Item was added: + ----- Method: SetInspectorTest>>testNil (in category 'tests') ----- + testNil + "Check proper use of a set's enclosed elements." + + self deny: (self object includes: nil). + self deny: (self inspector fields anySatisfy: [:field | field value isNil]). + + self object add: nil. + self simulateStepping. + + self assert: (self inspector fields anySatisfy: [:field | field value isNil]).! Item was changed: + SetInspectorTest subclass: #WeakSetInspectorTest - TestCase subclass: #WeakSetInspectorTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolsTests-Inspector'! Item was added: + ----- Method: WeakSetInspectorTest>>createObject (in category 'running') ----- + createObject + + | weakSet | + weakSet := WeakSet withAll: super createObject. + Smalltalk garbageCollect. + ^ weakSet! Item was added: + ----- Method: WeakSetInspectorTest>>testDebugConstruction (in category 'tests') ----- + testDebugConstruction + "Ignore."! Item was changed: ----- Method: WeakSetInspectorTest>>testSymbolTableM6812 (in category 'tests') ----- testSymbolTableM6812 + "This test is related to http://bugs.squeak.org/view.php?id=6812. Check whether field selection and garbage collection are somehow interfering." - "this test is related to http://bugs.squeak.org/view.php?id=6812" + | getRandomSymbol symbols priorContents currentContents currentIndex | + self object removeAll. - | aWeakSet anInspector fieldSize | - aWeakSet := (Symbol classPool at: #SymbolTable). - anInspector := aWeakSet inspectorClass inspect: aWeakSet. + getRandomSymbol := [ + | token | + token := (1 to: 10) collect: [:ea | ($a to: $z) atRandom] as: String. + (Symbol lookup: token) ifNil: [token asSymbol] ifNotNil: [nil]]. + + symbols := OrderedCollection new. + 10 timesRepeat: [ + getRandomSymbol value ifNotNil: [:symbol | symbols add: symbol]]. + + self object addAll: symbols. - fieldSize := anInspector fieldList size. Smalltalk garbageCollect. + self assert: symbols size equals: self object size. + self assert: symbols notEmpty. + + 1 to: symbols size do: [:round | + currentIndex := 1. + symbols removeLast. + + [(currentIndex := currentIndex + 1) <= self inspector fieldList size] + whileTrue: [ + self inspector selectionIndex: currentIndex. + self assert: priorContents ~= (currentContents := self inspector contents). + priorContents := currentContents. + + Smalltalk garbageCollect. "Removes symbol from weak set" + self simulateStepping. "Removes field from weak-set inspector"]]. + + self assert: symbols isEmpty. + self assert: self object isEmpty.! - self assert: fieldSize = anInspector fieldList size. - !

1 0

The Trunk: ToolBuilder-Morphic-mt.258.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.258.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.258 Author: mt Time: 27 April 2020, 10:21:31.53034 am UUID: 56af8f04-9f4c-b843-afe5-e9ed08d06dc8 Ancestors: ToolBuilder-Morphic-mt.257 Complements Tools-mt.965. Inspector refactoring. See: http://forum.world.st/Please-try-out-Inspector-Refactoring-tp5114974.html =============== Diff against ToolBuilder-Morphic-mt.257 =============== Item was added: + ----- Method: Morph>>inspectorClass (in category '*ToolBuilder-Morphic') ----- + inspectorClass + + ^ MorphInspector! Item was added: + Inspector subclass: #MorphInspector + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolBuilder-Morphic-Tools'! + + !MorphInspector commentStamp: 'mt 4/22/2020 08:13' prior: 0! + I am an inspector for morphs. In addition to field values I display properties of the morph, and add additional selections to the field item menu.! Item was added: + ----- Method: MorphInspector>>addFieldItemsTo: (in category 'menu - construction') ----- + addFieldItemsTo: aMenu + + super addFieldItemsTo: aMenu. + + self isMorphSelected ifFalse: [^ self]. + + aMenu addLine. + + aMenu addTranslatedList: #( + ('open screenshot in hand' openScreenshotInHand) + ('open screenshot in world' openScreenshotInWorld)).! Item was added: + ----- Method: MorphInspector>>fieldExtent (in category 'fields') ----- + fieldExtent + + ^ (self newFieldForType: #misc key: #extent) + name: 'extent' translated; emphasizeName; + valueGetter: [:morph | morph extent]; + valueSetter: [:morph :newExtent | morph extent: newExtent]; + yourself! Item was added: + ----- Method: MorphInspector>>isMorphSelected (in category 'morphs') ----- + isMorphSelected + + ^ [self selectionOrObject isMorph] ifError: [false]! Item was added: + ----- Method: MorphInspector>>openScreenshotInHand (in category 'menu - commands') ----- + openScreenshotInHand + + ^ self selectedMorph imageForm asMorph openInHand! Item was added: + ----- Method: MorphInspector>>openScreenshotInWorld (in category 'menu - commands') ----- + openScreenshotInWorld + + ^ self selectedMorph imageForm asMorph openInWorld! Item was added: + ----- Method: MorphInspector>>selectedMorph (in category 'morphs') ----- + selectedMorph + + ^ self selectionOrObject! Item was added: + ----- Method: MorphInspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- + streamBaseFieldsOn: aStream + + super streamBaseFieldsOn: aStream. + aStream nextPut: self fieldExtent.! Item was added: + ----- Method: MorphInspector>>streamInstanceVariablesOn: (in category 'fields - streaming') ----- + streamInstanceVariablesOn: aStream + + super streamInstanceVariablesOn: aStream. + self streamPropertiesOn: aStream.! Item was added: + ----- Method: MorphInspector>>streamPropertiesOn: (in category 'fields - streaming') ----- + streamPropertiesOn: aStream + "Prepend all properties with # (hash) so that users can distinguish them from regular instance variables. Trigger both #layoutChanged and #changed to be sure that any value changes yield the expected visual updates. Note that this is required because we invade the morph's privacy by exposing its extension object this way; normal updates are handled only through the morph's public interface. For example, compare Morph >> #visible: with MorphExtension >> #visible:." + + | extension field | + (extension := self object extension) ifNil: [^ self]. + + extension sortedPropertyNames do: [:property | + (extension respondsTo: property) + ifTrue: [field := (self newFieldForType: #property key: property) + name: property printString; + valueGetter: [:morph | morph extension perform: property]; + valueSetter: [:morph :value | + morph extension perform: property asSimpleSetter with: value. + morph layoutChanged; changed]; + yourself] + ifFalse: [field := (self newFieldForType: #property key: property) + name: property printString; + valueGetter: [:morph | morph extension valueOfProperty: property]; + valueSetter: [:morph :value | + morph extension setProperty: property toValue: value. + morph layoutChanged; changed]; + yourself]. + + aStream nextPut: field].!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages April 2020