[squeak-dev] The Inbox: Tools-ct.1109.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Jan 16 19:03:37 UTC 2022


A new version of Tools was added to project The Inbox:
http://source.squeak.org/inbox/Tools-ct.1109.mcz

==================== Summary ====================

Name: Tools-ct.1109
Author: ct
Time: 16 January 2022, 8:03:35.398688 pm
UUID: 26e3269f-4166-1c40-a341-1381f419f324
Ancestors: Tools-mt.1106

Protects the debugger from debugging the active process. Renames #interruptedProcessIsActive into #interruptedProcessIsReady which checks Process >> #isSuspended and deprecates the former. Before doing a step, check the test selector. If a debugger has been closed while doing a step (i.e., while debugging itself), exit the outer step rather than raising an error. Periodically update the stepping button's enablement with regard to #interruptedProcessIsReady and #interruptedProcessShouldResume.

For the motivating story, see: http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-January/218368.html.

I'm not really sure how much effort is justified for such an edge case. In particular, I am not convinced whether periodical updates via #stepIn: are worth it. Looking forward to your opinions!

=============== Diff against Tools-mt.1106 ===============

Item was changed:
  ----- Method: Debugger>>customButtonSpecs (in category 'initialize') -----
  customButtonSpecs
  	"Answer an array of elements of the form wording, selector, help-message, that characterize the custom button row of a debugger."
  
  	| list |
  	list := #(('Proceed'	proceed				'Close the debugger and proceed.'	interruptedProcessShouldResume)
  		('Restart'		restart				'Reset this context to its start.')
+ 		('Into'			stepInto				'step Into message sends'	interruptedProcessIsReady)
+ 		('Over'			stepOver				'step Over message sends'	interruptedProcessIsReady)
+ 		('Through'		stepThrough		'step into a block'			interruptedProcessIsReady)
- 		('Into'			stepInto				'step Into message sends'	interruptedProcessIsActive)
- 		('Over'			stepOver				'step Over message sends'	interruptedProcessIsActive)
- 		('Through'		stepThrough		'step into a block'			interruptedProcessIsActive)
  		('Full Stack'		showFullStack			'show full stack')
  		('Where'		showWhere				'select current pc range')
  		('Tally It'			tally				'evaluate current selection and measure the time')).
  	(Preferences restartAlsoProceeds and: [self interruptedProcessShouldResume]) ifTrue:
  		[list := list collect: [:each |
  			each second == #restart
  				ifTrue: [each copy
  						at: 1 put: 'Proceed Here';
  						at: 3 put: 'Proceed from the beginning of this context.';
  						yourself]
  				ifFalse: [each second == #proceed
  					ifTrue: [each copy
  							at: 1 put: 'Proceed Top';
  							at: 3 put: 'Proceed from the current top context.';
  							yourself]
  					ifFalse: [each]]]].
  	^ list!

Item was changed:
  ----- Method: Debugger>>doStep (in category 'context stack menu') -----
  doStep
  	"Send the selected message in the accessed method, and regain control 
  	after the invoked method returns."
  	
  	| currentContext newContext |
  	self okToChange ifFalse: [^ self].
+ 	self interruptedProcessIsReady ifFalse: [^ self].
  	self checkContextSelection.
  	currentContext := self selectedContext.
  	newContext := self handleLabelUpdatesIn: [interruptedProcess completeStep: currentContext]
  						whenExecuting: currentContext.
+ 	interruptedProcess ifNil: [^ self].
  	newContext == currentContext ifTrue:
  		[newContext := interruptedProcess stepToSendOrReturn].
  	self contextStackIndex > 1
  		ifTrue: [self resetContext: newContext]
  		ifFalse:
  			[newContext == currentContext
  				ifTrue: [self changed: #contentsSelection.
  						self updateInspectors]
+ 				ifFalse: [self resetContext: newContext]].!
- 				ifFalse: [self resetContext: newContext]].
- !

Item was changed:
  ----- Method: Debugger>>doStepUntil: (in category 'context stack menu') -----
  doStepUntil: condition
  	"Step until the given condition evaluates to other than false, reporting an error it if does not evaluate to true.
  	
  	If shift is pressed when the expression is supplied, don't update the UI. If shift is pressed while stepping, stop stepping. Using a user interrupt to break out would be more natural but Squeak currently doesn't provide a UserInterrupt exception. It should do."
  	
  	| currentContext newContext value lastUpdate updateUI breakOnShift |
  	self okToChange ifFalse: [^ self].
+ 	self interruptedProcessIsReady ifFalse: [^ self].
  	self checkContextSelection.
  	currentContext := newContext := self selectedContext.
  	lastUpdate := Time millisecondClockValue.
  	updateUI := breakOnShift := Sensor shiftPressed not.
  	
  	Cursor execute showWhile: [[
  		newContext == currentContext
  			and: [currentContext willReturn not
  			and: [(value := condition value) == false]] ] whileTrue: [
  	
  				self
  					handleLabelUpdatesIn: [newContext := interruptedProcess completeStep: currentContext]
  					whenExecuting: currentContext.
+ 				interruptedProcess ifNil: [^ self].
  				newContext == currentContext ifTrue: [
  					newContext := interruptedProcess stepToSendOrReturn.
  					self resetContext: newContext changeContents: false].
  	
  				Time millisecondClockValue - lastUpdate > 250 "ms" ifTrue: [
  					updateUI ifTrue: [
  						self changed: #contentsSelection.
  						Project current world displayWorldSafely].
  					breakOnShift 
  						ifTrue: [Sensor shiftPressed ifTrue: [
  							self changed: #contentsSelection.
  							self updateInspectors.
  							^self]]
  						ifFalse: [Sensor shiftPressed ifFalse: [breakOnShift := true]].
  					 lastUpdate := Time millisecondClockValue] ]].
  	
  	self contextStackIndex > 1
  		ifTrue: [self resetContext: newContext]
  		ifFalse:
  			[newContext == currentContext
  				ifTrue: [self changed: #contentsSelection; updateInspectors]
  				ifFalse: [self resetContext: newContext]].
  			
+ 	^ value!
- 	^ value
- !

Item was changed:
  ----- Method: Debugger>>interruptedProcessIsActive (in category 'testing') -----
  interruptedProcessIsActive
+ 	self deprecated.
  	^interruptedProcess isTerminated not!

Item was added:
+ ----- Method: Debugger>>interruptedProcessIsReady (in category 'testing') -----
+ interruptedProcessIsReady
+ 
+ 	^ interruptedProcess notNil
+ 		and: [interruptedProcess isSuspended "do not debug the active process"]
+ 		and: [interruptedProcess isTerminated not]!

Item was changed:
  ----- Method: Debugger>>interruptedProcessShouldResume (in category 'testing') -----
  interruptedProcessShouldResume
+ 
+ 	^ self interruptedProcessIsReady and: [interruptedProcess shouldResumeFromDebugger]!
- 	^ interruptedProcess shouldResumeFromDebugger!

Item was changed:
  ----- Method: Debugger>>removeMessage (in category 'context stack menu') -----
  removeMessage
  	
  	| oldContext method cleanIndex  |
  	self okToChange ifFalse: [^ false].
  	contextStackIndex isZero ifTrue: [^ false].
  	
  	oldContext := self selectedContext.
  	method := oldContext method.
  	cleanIndex := self findCleanHomeBelow: method.
  	contextStack at: cleanIndex ifAbsent: [
  		self inform: 'Sender of method not found on stack, can''t remove message'.
  		^ false].
+ 	self interruptedProcessIsReady ifFalse: [^ self].
  	(self confirm: 'I will have to revert to the sender of this message.  Is that OK?')
  		ifFalse: [^ false].
  	
  	super removeMessage ifFalse: [^ false].
  	self
  		contextStackIndex: cleanIndex oldContextWas: oldContext;
  		tryRestartFrom: self selectedContext.
  	
  	^ true!

Item was changed:
  ----- Method: Debugger>>resetContext:changeContents: (in category 'private') -----
  resetContext: aContext changeContents: aBoolean
  	"Used when a new context becomes top-of-stack, for instance when the
  	method of the selected context is re-compiled, or the simulator steps or
  	returns to a new method. There is room for much optimization here, first
  	to save recomputing the whole stack list (and text), and secondly to avoid
  	recomposing all that text (by editing the paragraph instead of recreating it)."
  
  	| oldContext |
  	oldContext := self selectedContext.
  	self newStack: (aContext ifNil: [oldContext]) contextStack.
+ 	self changed: #contextStackList; changed: #interruptedProcessIsReady.
- 	self changed: #contextStackList; changed: #interruptedProcessIsActive.
  	self contextStackIndex: 1 oldContextWas: oldContext.
  	aBoolean ifTrue: [self contentsChanged].
  !

Item was changed:
  ----- Method: Debugger>>restart (in category 'context stack menu') -----
  restart
  	"Proceed from the initial state of the currently selected context. The 
  	argument is a controller on a view of the receiver. That view is closed."
  	"Closing now depends on a preference #restartAlsoProceeds - hmm 9/7/2001 16:46"
  
  	| unwindError |
  	self okToChange ifFalse: [^ self].
+ 	interruptedProcess isSuspended ifFalse: [^ self].
  	self checkContextSelection.
  	unwindError := self tryRestartFrom: self selectedContext.
  	((Preferences restartAlsoProceeds
  		and: [unwindError not])
  		and: [self interruptedProcessShouldResume])
  			ifTrue: [self proceed].!

Item was changed:
  ----- Method: Debugger>>send (in category 'context stack menu') -----
  send
  	"Send the selected message in the accessed method, and take control in 
  	the method invoked to allow further step or send."
  
  	self okToChange ifFalse: [^ self].
+ 	self interruptedProcessIsReady ifFalse: [^ self].
  	self checkContextSelection.
  	interruptedProcess step: self selectedContext.
+ 	interruptedProcess ifNil: [^ self].
+ 	self resetContext: interruptedProcess stepToSendOrReturn.!
- 	self resetContext: interruptedProcess stepToSendOrReturn.
- !

Item was added:
+ ----- Method: Debugger>>stepIn: (in category 'self-updating') -----
+ stepIn: aSystemWindow
+ 
+ 	self changed: #interruptedProcessShouldResume.
+ 	self changed: #interruptedProcessIsReady.!

Item was changed:
  ----- Method: Debugger>>stepIntoBlock (in category 'context stack menu') -----
  stepIntoBlock
  	"Send messages until you return to the present method context.
  	 Used to step into a block in the method."
  
  	| currentContext newContext |
  	self okToChange ifFalse: [^ self].
+ 	self interruptedProcessIsReady ifFalse: [^ self].
  	self checkContextSelection.
  	currentContext := self selectedContext.
  	self handleLabelUpdatesIn:
  			[interruptedProcess stepToHome: currentContext]
  		whenExecuting: self selectedContext.
+ 	interruptedProcess ifNil: [^ self].
  	newContext := interruptedProcess stepToSendOrReturn.
  	self contextStackIndex > 1
  		ifTrue: [self resetContext: newContext]
  		ifFalse:
  			[newContext == currentContext
  				ifTrue: [self changed: #contentsSelection.
  						self updateInspectors]
  				ifFalse: [self resetContext: newContext]].!

Item was added:
+ ----- Method: Debugger>>stepTimeIn: (in category 'self-updating') -----
+ stepTimeIn: aSystemWindow
+ 
+ 	^ 100 "milliseconds"!

Item was added:
+ ----- Method: Debugger>>updateListsAndCodeIn: (in category 'self-updating') -----
+ updateListsAndCodeIn: aWindow
+ 	"Do nothing."!

Item was changed:
  ----- Method: Debugger>>wantsStepsIn: (in category 'self-updating') -----
  wantsStepsIn: aWindow
  
+ 	^ true!
- 	^ false!



More information about the Squeak-dev mailing list