[Pkg] The Trunk: ST80-mt.240.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Sep 24 15:22:23 UTC 2019 

Marcel Taeumel uploaded a new version of ST80 to project The Trunk:
http://source.squeak.org/trunk/ST80-mt.240.mcz

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

Name: ST80-mt.240
Author: mt
Time: 24 September 2019, 5:22:22.23186 pm
UUID: 74240c49-e09f-8846-b6d7-8fccdb9dab9e
Ancestors: ST80-mt.239

Complements Tools-mt.893:
- fixes "debug it" for code expressions in workspaces
- adds some warnings for usability
- adds support for proceeding non-ui processes (e.g. "[self halt. 3+4] fork") to keep the UI responsive
- no need for MVCToolBuilder >> #openDebugger: anymore.
- adds detection of recursive errors like Morphic has

=============== Diff against ST80-mt.239 ===============

Item was changed:
  ----- Method: MVCDebugger class>>openInterrupt:onProcess: (in category 'opening') -----
  openInterrupt: aString onProcess: interruptedProcess
  	"Open a notifier in response to an interrupt. An interrupt occurs when the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other systems) or when the low-space watcher detects that memory is low."
  	
+ 	| debugger message |
- 	| debugger |
  	<primitive: 19> "Simulation guard"
+ 
+ 	Project current world inActiveControllerProcess
+ 		ifTrue: [^ self notify: 'You cannot interrupt from within the active controller process. Use a helper process instead.\\This interrupt request will be aborted.' withCRs translated].
+ 
  	debugger := self new.
  	debugger
  		process: interruptedProcess
+ 		controller: (Project current world activeControllerProcess == interruptedProcess
+ 						ifTrue: [Project current world activeController])
- 		controller: (ScheduledControllers inActiveControllerProcess == interruptedProcess
- 						ifTrue: [ScheduledControllers activeController])
  		context: interruptedProcess suspendedContext.
  	debugger externalInterrupt: true.
  
+ 	((aString includesSubstring: 'Space') and: [aString includesSubstring: 'low'])
+ 		ifTrue: [
+ 			"Space is low!! See SmalltalkImage >> #lowSpaceWatcher."
+ 			message := self lowSpaceChoices.
+ 			Preferences logDebuggerStackToFile ifTrue: [
+ 				Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log']]
+ 		ifFalse: [	
+ 			Preferences logDebuggerStackToFile ifTrue: [
+ 				Smalltalk logSqueakError: aString inContext: debugger interruptedContext]].
- 	Preferences logDebuggerStackToFile ifTrue:
- 		[(aString includesSubstring: 'Space') & (aString includesSubstring: 'low')
- 			ifTrue: [Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log']
- 			"logging disabled for 4.3 release, see
- 				http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html"
- 			"ifFalse: [Smalltalk logSqueakError: aString inContext: debugger interruptedContext]"].
  
+ 	debugger
+ 		openNotifierNoSuspendContents: message label: aString;
+ 		yourself.
+ 	
+ 	"Since we are in a helper process, #openNoTerminate WILL NOT activate the debugger's controller."
+ 	Project current world searchForActiveController.
- 	Preferences eToyFriendly ifTrue: [Project current world stopRunningAll].
- 	^debugger
- 		openNotifierContents: nil label: aString;
- 		yourself
  !

Item was changed:
  ----- Method: MVCDebugger class>>openOn:context:label:contents:fullView: (in category 'opening') -----
+ openOn: process context: context label: title contents: contentsStringOrNil fullView: full
- openOn: process context: context label: title contents: contentsStringOrNil fullView: bool
  	"Open a notifier in response to an error, halt, or notify. A notifier view just shows a short view of the sender stack and provides a menu that lets the user open a full debugger."
  
+ 	ErrorRecursionGuard critical: [
+ 		
+ 		| debugger |
+ 		ErrorRecursion ifTrue: [
+ 			"self assert: process == Project current uiProcess -- DOCUMENTATION ONLY"
+ 			self clearErrorRecursion.
+ 			^ Project current handleFatalDrawingError: title].
+ 
+ 		[ErrorRecursion not & Preferences logDebuggerStackToFile
+ 			ifTrue: [Smalltalk logSqueakError: title inContext: context]]
+ 				on: Error
+ 				do: [:ex | ex return: nil].
+ 		
+ 		self setErrorRecursion.
+ 			
+ 		self informExistingDebugger: context label: title.
+ 			
+ 		debugger := self new
+ 			process: process
+ 			controller: (Project current world activeControllerProcess == process
+ 							ifTrue: [Project current world activeController])
+ 			context: context.
+ 
+ 		full
+ 			ifTrue: [debugger openFullNoSuspendLabel: title]
+ 			ifFalse: [debugger openNotifierNoSuspendContents: contentsStringOrNil label: title].
+ 	
+ 		"Try drawing the debugger tool at least once to avoid freeze."
+ 		Project current restoreDisplay.
+ 		
+ 		self clearErrorRecursion].
+ 	
+ 	process suspend.!
- 	| controller debugger |
- 	controller := ScheduledControllers activeControllerProcess == process
- 				ifTrue: [ScheduledControllers activeController].
- 	[Preferences logDebuggerStackToFile
- 		ifTrue: [Smalltalk logSqueakError: title inContext: context]] on: Error do: [:ex | ex return: nil].
- 	[debugger := self new
- 				process: process
- 				controller: controller
- 				context: context.
- 	bool
- 		ifTrue: [debugger openFullNoSuspendLabel: title]
- 		ifFalse: [debugger openNotifierContents: contentsStringOrNil label: title].
- 	] on: Error do: [:ex |
- 			self primitiveError: 'Original error: ' , title asString , '.
- 			Debugger error: ' , ([ex description]
- 							on: Error
- 							do: ['a ' , ex class printString]) , ':'].
- 	process suspend!

Item was changed:
  ----- Method: MVCDebugger class>>openOnMethod:forReceiver:inContext: (in category 'opening') -----
  openOnMethod: aCompiledMethod forReceiver: anObject inContext: aContextOrNil
  
+ 	| guineaPig debugger context inActiveControllerProcess |
+ 	inActiveControllerProcess := ScheduledControllers inActiveControllerProcess.
+ 	
- 	| guineaPig debugger debuggerWindow context |
  	guineaPig :=
  		[aCompiledMethod
  			valueWithReceiver: anObject
  			 arguments: (aContextOrNil ifNil: [ #() ] ifNotNil: [ { aContextOrNil } ]).
+ 		 guineaPig := nil. "Spot the return from aCompiledMethod. See below."
+ 		
+ 		"If we proceed in the debugger, make sure to keep the system responsive."
+ 		"ScheduledControllers searchForActiveController"] newProcess.
- 		 guineaPig := nil "spot the return from aCompiledMethod"] newProcess.
  	context := guineaPig suspendedContext.
+ 	
  	debugger := self new
  		process: guineaPig
+ 		controller: nil "None because the guinea pig does *not* relate to the active controller."
- 		controller: (ScheduledControllers inActiveControllerProcess ifTrue:
- 						[ScheduledControllers activeController])
  		context: context.
+ 	debugger initializeFull. "To make #send work. See below."
+ 	
- 	debuggerWindow := debugger openFullNoSuspendLabel: 'Debug it'.
  	"Now step into the expression.  But if it is quick (is implemented as a primtiive, e.g. `0')
  	 it will return immediately back to the block that is sent newProcess above.  Guard
  	 against that with the check for home being thisContext."
  	[debugger interruptedContext method == aCompiledMethod]
+ 		whileFalse: [
+ 			(guineaPig isNil and: [debugger interruptedContext home == thisContext])
+ 				ifTrue: [^ Project uiManager inform: 'Nothing to debug; expression is optimized.'].
+ 			debugger send].
+ 	
+ 	debugger openFullNoSuspendLabel: 'Debug it'.
+ 	inActiveControllerProcess ifTrue: [Processor terminateActive].!
- 		whileFalse:
- 			[(guineaPig isNil
- 			  and: [debugger interruptedContext home == thisContext]) ifTrue:
- 				[debuggerWindow controller closeAndUnschedule.
- 				 UIManager default inform: 'Nothing to debug; expression is optimized'.
- 				 ^self].
- 			debugger send]!

Item was added:
+ ----- Method: MVCDebugger>>abandon: (in category 'initialize') -----
+ abandon: aTopView 
+ 
+ 	aTopView controller closeAndUnscheduleNoTerminate.!

Item was added:
+ ----- Method: MVCDebugger>>openFullFromNotifier: (in category 'initialize') -----
+ openFullFromNotifier: notifierView
+ 	"Create, schedule and answer a full debugger with the given label. Do not terminate the current active process."
+ 
+ 	| fullView |
+ 	super openFullFromNotifier: notifierView.
+ 		
+ 	fullView := ToolBuilder default build: self.
+ 	fullView label: notifierView label. "Keep the label."
+ 	fullView controller openNoTerminate.
+ 	
+ 	notifierView controller closeAndUnscheduleNoTerminate.
+ 	Processor terminateActive.!

Item was added:
+ ----- Method: MVCDebugger>>openFullNoSuspendLabel: (in category 'initialize') -----
+ openFullNoSuspendLabel: aString
+ 	"Create, schedule and answer a full debugger with the given label. Do not terminate the current active process."
+ 
+ 	| fullView |
+ 	super openFullNoSuspendLabel: aString.
+ 		
+ 	fullView := ToolBuilder default build: self.
+ 	fullView label: aString.
+ 	fullView controller openNoTerminate.
+ 	
+ 	^ fullView!

Item was added:
+ ----- Method: MVCDebugger>>openNotifierNoSuspendContents:label: (in category 'initialize') -----
+ openNotifierNoSuspendContents: msgString label: label
+ 
+ 	| builder spec view |
+ 	super openNotifierNoSuspendContents: msgString label: label.
+ 	
+ 	builder := ToolBuilder default.
+ 	spec := self buildNotifierWith: builder label: label message: msgString.
+ 	
+ 	view := builder build: spec.
+ 	view controller openNoTerminate.
+ 
+ 	^ view!

Item was changed:
  ----- Method: MVCDebugger>>resumeProcess: (in category 'private') -----
  resumeProcess: aTopView 
  
+ 	| hasActiveController |
  	aTopView erase.
+ 	savedCursor ifNotNil: [Cursor currentCursor: savedCursor].
+ 	
+ 	hasActiveController := interruptedProcess isTerminated not and: [interruptedController notNil].
+ 	
- 	savedCursor
- 		ifNotNil: [Cursor currentCursor: savedCursor].
  	interruptedProcess isTerminated ifFalse: [
  		ScheduledControllers activeControllerNoTerminate: interruptedController andProcess: interruptedProcess].
+ 
+ 	Smalltalk installLowSpaceWatcher. "restart low space handler"
+ 
- 	"if old process was terminated, just terminate current one"
  	interruptedProcess := nil. "Before delete, so release doesn't terminate it"
  	aTopView controller closeAndUnscheduleNoErase.
+ 	
+ 	hasActiveController
+ 		ifTrue: [Processor terminateActive]
+ 		ifFalse: [Project current world searchForActiveController].!
- 	Smalltalk installLowSpaceWatcher. "restart low space handler"
- 	Processor terminateActive
- !

Item was changed:
  ----- Method: MVCProject>>interruptName:preemptedProcess: (in category 'scheduling & debugging') -----
  interruptName: labelString preemptedProcess: theInterruptedProcess
  	"Create a Notifier on the interrupted process with the given label. Make the Notifier the active controller."
+ 	
+ 	world inActiveControllerProcess ifTrue: [
+ 		^ self inform: 'You cannot interrupt from within the UI process.\Use a helper process instead.' withCRs translated].
  
- 	theInterruptedProcess suspend.
- 
  	(world activeController ~~ nil and: [world activeController ~~ world screenController]) ifTrue: [
  		theInterruptedProcess == self uiProcess
  			ifTrue: [
  				"Carefully de-emphasis the current window."
  				world activeController view topView deEmphasizeForDebugger]
  			ifFalse: [
  				world activeController controlTerminate]].
  
+ 	theInterruptedProcess suspend.
+ 	self interruptCleanUpFor: theInterruptedProcess.
+ 
- 	"This will just scheduleNoTerminate the newly built controller"
  	ToolSet
  		debugInterruptedProcess: theInterruptedProcess
+ 		label: labelString.!
- 		label: labelString.
- 
- 	world searchForActiveController.!

Item was changed:
  ----- Method: StandardSystemController>>closeAndUnscheduleNoErase (in category 'scheduling') -----
  closeAndUnscheduleNoErase
  	"Remove the scheduled view from the collection of scheduled views. Set 
+ 	its status to closed but do not erase and do not terminate. For debuggers."
- 	its status to closed but do not erase."
  
  	status := #closed.
  	ScheduledControllers unschedule: self.
  	view release.!

Item was changed:
  ----- Method: StandardSystemController>>closeAndUnscheduleNoTerminate (in category 'scheduling') -----
  closeAndUnscheduleNoTerminate
+ 	"Erase the receiver's view and remove it from the collection of scheduled views, but do not terminate the current process. Useful for clean-up scripts."
- 	"Erase the receiver's view and remove it from the collection of scheduled views, but do not terminate the current process."
  
  	status := #closed.
  	ScheduledControllers unschedule: self.	
  	view erase.
  	view release.
  !

More information about the Packages mailing list