[squeak-dev] The Trunk: ToolsTests-mt.95.mczcommits at source.squeak.org commits at source.squeak.orgMon Apr 27 08:22:00 UTC 2020
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. - !
More information about the Squeak-dev mailing list |