'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 15 October 2004 at 2:21:24 pm'! "Change Set: HaltIf-md Date: 15 October 2004 Author: Marcus Denker This changeset provides easy conditional halts. You can do: self haltIf: expr. or self haltIf: [expr] or self haltIf: #aSymbol. If a symbol is used as a parameter, #haltIf will search the callchain and halt if any method's selector equals the symbol. This is very useful when debugging code with extensive TestSuites: The programmer can very easily specify a conditional halt that only is taken when called from one specific test: self haltIf: #someTestThatWillCallThisMethod. Another cool thing is that this allows to add a halt in methods that are used by the System. e.g. a halt in OrderedCollection>>#add will crash the system, but with a haltIf #someMethod the System will keep on working (but somewhat slow). The halt is taken as soon as #add is called from #someMethod. "! !Object methodsFor: 'debugging' stamp: 'md 10/15/2004 13:57'! haltIf: condition "This is the typical message to use for inserting breakpoints during debugging. Param can be a block or expression, halt if true. If the condition is a selector, we look up in the callchain. Halt if any method's selector equals selector." | cntxt | condition isSymbol ifTrue:[ "only halt if a method with selector symbol is in callchain". cntxt := thisContext sender. [cntxt sender isNil] whileFalse: [ (cntxt selector = condition) ifTrue: [Halt signal]. cntxt := cntxt sender. ]. ^self. ]. condition value ifTrue:[Halt signal].! ! !ObjectTest methodsFor: 'private' stamp: 'md 10/15/2004 13:45'! a self b.! ! !ObjectTest methodsFor: 'private' stamp: 'md 10/15/2004 13:46'! a1 self b1.! ! !ObjectTest methodsFor: 'private' stamp: 'md 10/15/2004 13:45'! b self haltIf: #testHaltIf.! ! !ObjectTest methodsFor: 'private' stamp: 'md 10/15/2004 13:46'! b1 self haltIf: #testasdasdfHaltIf.! ! !ObjectTest methodsFor: 'testing - debugging' stamp: 'md 10/15/2004 13:46'! testHaltIf self should: [self haltIf: true] raise: Halt. self shouldnt: [self haltIf: false] raise: Halt. self should: [self haltIf: [true]] raise: Halt. self shouldnt: [self haltIf: [false]] raise: Halt. self should: [self haltIf: #testHaltIf.] raise: Halt. self shouldnt: [self haltIf: #teadfasdfltIf.] raise: Halt. self should: [self a] raise: Halt. self shouldnt: [self a1] raise: Halt.! ! !ObjectTest reorganize! ('private' a a1 b b1) ('testing - debugging' testAssert testHaltIf) ! !Object reorganize! ('*sunit-preload' sunitAddDependent: sunitChanged: sunitRemoveDependent:) ('*system-support' systemNavigation) ('*tools-browser' browse browseHierarchy) ('Breakpoint' break) ('accessing' addInstanceVarNamed:withValue: at: at:modify: at:put: basicAt: basicAt:put: basicSize bindWithTemp: doIfNotNil: ifNotNilDo: in: presenter readFromString: size yourself) ('associating' ->) ('binding' bindingOf:) ('casing' caseOf: caseOf:otherwise:) ('class membership' class inheritsFromAnyIn: isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass) ('comparing' = closeTo: hash hashMappedBy: identityHashMappedBy: identityHashPrintString literalEqual: ~=) ('converting' adaptToFloat:andSend: adaptToFraction:andSend: adaptToInteger:andSend: as: asActionSequence asActionSequenceTrappingErrors asDraggableMorph asOrderedCollection asString asStringOrText complexContents mustBeBoolean mustBeBooleanIn: printDirectlyToDisplay withoutListWrapper) ('copying' clone copy copyAddedStateFrom: copyFrom: copySameFrom: copyTwoLevel deepCopy initialDeepCopierSize postCopy shallowCopy veryDeepCopy veryDeepCopySibling veryDeepCopyUsing: veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:) ('creation' asMorph openAsMorph) ('dependents access' addDependent: breakDependents canDiscardEdits dependents evaluate:wheneverChangeIn: hasUnacceptedEdits myDependents myDependents: release removeDependent:) ('deprecated' beep: beepPrimitive) ('drag and drop' acceptDroppingMorph:event:inMorph: dragAnimationFor:transferMorph: dragPassengerFor:inMorph: dragTransferType dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:) ('debugging' assert: halt halt: haltIf:) ('error handling' caseError confirm: confirm:orCancel: deprecated: deprecated:block: deprecated:explanation: deprecatedExplanation: doesNotUnderstand: error: externalCallFailed handles: notify: notify:at: notifyWithLabel: primitiveFailed shouldBeImplemented shouldNotImplement subclassResponsibility tryToDefineVariableAccess:) ('evaluating' value valueWithArguments:) ('events-accessing' actionForEvent: actionForEvent:ifAbsent: actionMap actionSequenceForEvent: actionsDo: createActionMap hasActionForEvent: setActionSequence:forEvent: updateableActionMap) ('events-registering' when:evaluate: when:send:to: when:send:to:with: when:send:to:withArguments:) ('events-removing' releaseActionMap removeAction:forEvent: removeActionsForEvent: removeActionsSatisfying: removeActionsSatisfying:forEvent: removeActionsWithReceiver: removeActionsWithReceiver:forEvent:) ('events-triggering' triggerEvent: triggerEvent:ifNotHandled: triggerEvent:with: triggerEvent:with:ifNotHandled: triggerEvent:withArguments: triggerEvent:withArguments:ifNotHandled:) ('filter streaming' byteEncode: drawOnCanvas: elementSeparator encodePostscriptOn: flattenOnStream: fullDrawPostscriptOn: printOnStream: putOn: storeOnStream: writeOnFilterStream:) ('finalization' actAsExecutor executor finalizationRegistry finalize retryWithGC:until: toFinalizeSend:to:with:) ('flagging' isThisEverCalled isThisEverCalled: logEntry logExecution logExit) ('graph model') ('inspecting' basicInspect inspect inspectorClass) ('locales') ('macpal' codeStrippedOut: contentsChanged currentEvent currentHand currentVocabulary currentWorld flash ifKindOf:thenDo: instanceVariableValues isUniversalTiles objectRepresented playSoundNamed: refusesToAcceptCode scriptPerformer slotInfo) ('message handling' perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: withArgs:executeMethod:) ('objects from disk' comeFullyUpOnReload: convertToCurrentVersion:refStream: indexIfCompact objectForDataStream: readDataFrom:size: saveOnFile storeDataOn:) ('parts bin' descriptionForPartsBin) ('printing' fullPrintString isLiteral longPrintOn: longPrintOn:limitedTo:indent: longPrintString nominallyUnsent: printOn: printString printStringLimitedTo: propertyList reportableSize storeOn: storeString stringForReadout stringRepresentation) ('scripting' adaptedToWorld: contentsGetz: defaultFloatPrecisionFor: evaluateUnloggedForSelf: methodInterfacesForCategory:inVocabulary:limitClass: methodInterfacesForInstanceVariablesCategoryIn: methodInterfacesForScriptsCategoryIn: selfWrittenAsIll selfWrittenAsIm selfWrittenAsMe selfWrittenAsMy selfWrittenAsThis) ('scripts-kernel' universalTilesForGetterOf: universalTilesForInterface:) ('system primitives' asOop becomeForward: becomeForward:copyHash: className creationStamp instVarAt: instVarAt:put: instVarNamed: instVarNamed:put: oopString primitiveChangeClassTo: rootStubInImageSegment: someObject) ('testing' basicType beViewed costumes haltIfNil haveFullProtocolBrowsed haveFullProtocolBrowsedShowingSelector: isBehavior isBlock isBlockClosure isCollection isColor isColorForm isCompiledMethod isFloat isForm isFraction isHeap isInteger isInterval isMessageSend isMorph isMorphicEvent isMorphicModel isNumber isPoint isPseudoContext isStream isString isSymbol isSystemWindow isText isTransparent isVariableBinding isWebBrowser knownName name nameForViewer notNil openInstanceBrowserWithTiles renameTo: showDiffs stepAt:in: stepIn: stepTime stepTimeIn: vocabularyDemanded wantsDiffFeedback wantsSteps wantsStepsIn:) ('translation support' inline: var:declareC:) ('undo' capturedState commandHistory purgeAllCommands redoFromCapturedState: refineRedoTarget:selector:arguments:in: refineUndoTarget:selector:arguments:in: rememberCommand: rememberUndoableAction:named: undoFromCapturedState:) ('updating' changed changed: changed:with: handledListVerification noteSelectionIndex:for: okToChange update: update:with: updateListsAndCodeIn: windowIsClosing) ('user interface' addModelItemsToWindowMenu: addModelMenuItemsTo:forMorph:hand: asExplorerString beep defaultBackgroundColor defaultLabelForInspector eToyStreamedRepresentationNotifying: explore fullScreenSize hasContentsInExplorer inform: initialExtent inspectWithLabel: launchPartVia: launchPartVia:label: launchTileToRefer modelSleep modelWakeUp modelWakeUpIn: mouseUpBalk: newTileMorphRepresentative notYetImplemented windowActiveOnFirstClick windowReqNewLabel:) ('viewer' assureUniClass belongsToUniClass browseOwnClassSubProtocol categoriesForViewer: categoriesForVocabulary:limitClass: chooseNewNameForReference defaultLimitClassForVocabulary: defaultNameStemForInstances elementTypeFor:vocabulary: externalName graphicForViewerTab hasUserDefinedSlots infoFor:inViewer: initialTypeForSlotNamed: isPlayerLike methodInterfacesInPresentationOrderFrom:forCategory: newScriptorAround: offerViewerMenuFor:event: offerViewerMenuForEvt:morph: renameScript: tilePhrasesForCategory:inViewer: tilePhrasesForSelectorList:inViewer: tileToRefer uniqueInstanceVariableNameLike:excluding: uniqueNameForReference uniqueNameForReferenceFrom: uniqueNameForReferenceOrNil updateThresholdForGraphicInViewerTab usableMethodInterfacesIn:) ('world hacking' couldOpenInMorphic) ('private' errorImproperStore errorNonIntegerIndex errorNotIndexable errorSubscriptBounds: primitiveError: species storeAt:inTempFrame:) ('thumbnail') !