The Trunk: ToolsTests-mt.95.mcz

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.
- !