[Pkg] The Trunk: Tools-fbs.461.mcz

commits at source.squeak.org commits at source.squeak.org
Mon May 6 20:50:41 UTC 2013


Frank Shearar uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-fbs.461.mcz

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

Name: Tools-fbs.461
Author: fbs
Time: 30 April 2013, 9:46:27.007 am
UUID: 6b338c44-87ea-4b4a-9059-833bcd2545ed
Ancestors: Tools-fbs.460

Clean up the "JIT development" flow. On hitting the "create" button in response to a MessageNotUnderstood, NotYetImplemented or SubclassResponsibility,
* a MNU prompts the user for a class and category, pushes a stub method onto the call stack and debugs it;
* a NYI debugs the context with the #notYetImplemented/#shouldBeImplemented;
* a SR prompts the user for a class (between and including the receiver class and the superclass whose method has the #subclassResponsibility), categorises the new method the same as the superclass's, pushes a stub onto the call stack and debugs that stub.

In all cases, resumption lets methods _return_ values down the stack.

=============== Diff against Tools-fbs.460 ===============

Item was added:
+ ----- Method: Debugger>>askForSuperclassOf:upTo:toImplement:ifCancel: (in category 'private') -----
+ askForSuperclassOf: aClass upTo: superclass toImplement: aSelector ifCancel: cancelBlock
+ 	| classes chosenClassIndex |
+ 	classes := aClass withAllSuperclasses reject: [:cls | aClass isKindOf: cls].
+ 	chosenClassIndex := UIManager default 
+ 		chooseFrom: (classes collect: [:c | c name])
+ 		title: 'Define #', aSelector, ' in which class?'.
+ 	chosenClassIndex = 0 ifTrue: [^ cancelBlock value].
+ 	^ classes at: chosenClassIndex!

Item was changed:
  ----- Method: Debugger>>buildNotifierWith:label:message: (in category 'toolbuilder') -----
  buildNotifierWith: builder label: label message: messageString
  	| windowSpec listSpec textSpec panelSpec quads |
  	windowSpec := builder pluggableWindowSpec new.
  	windowSpec model: self.
  	windowSpec extent: 450 @ 156. "nice and wide to show plenty of the error msg"
  	windowSpec label: label.
  	windowSpec children: OrderedCollection new.
  
  	panelSpec := builder pluggablePanelSpec new.
  	panelSpec children: OrderedCollection new.
  	quads := self preDebugButtonQuads.
+ 	(self interruptedContext selector == #doesNotUnderstand:) ifTrue: [
- 	(#(#notYetImplemented #shouldBeImplemented #doesNotUnderstand:) includes: self interruptedContext selector) ifTrue: [
  		quads := quads copyWith: 
  			{ 'Create'. #createMethod. #magenta. 'create the missing method' }
  	].
+ 	(#(#notYetImplemented #shouldBeImplemented) includes: self interruptedContext selector) ifTrue: [
+ 		quads := quads copyWith: 
+ 			{ 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' }
+ 	].
  	(self interruptedContext selector == #subclassResponsibility) ifTrue: [
  		quads := quads copyWith: 
  			{ 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' }
  	].
  	quads do:[:spec| | buttonSpec |
  		buttonSpec := builder pluggableButtonSpec new.
  		buttonSpec model: self.
  		buttonSpec label: spec first.
  		buttonSpec action: spec second.
  		buttonSpec help: spec fourth.
  		buttonSpec frame: self preDebugButtonQuadFrame. 
  		panelSpec children add: buttonSpec.
  	].
  	panelSpec layout: #horizontal. "buttons"
  	panelSpec frame: self preDebugButtonQuadFrame.
  	windowSpec children add: panelSpec.
  
  	Preferences eToyFriendly | messageString notNil ifFalse:[
  		listSpec := builder pluggableListSpec new.
  		listSpec 
  			model: self;
  			list: #contextStackList; 
  			getIndex: #contextStackIndex; 
  			setIndex: #debugAt:; 
  			frame: self contextStackFrame.
  		windowSpec children add: listSpec.
  	] ifTrue:[
  		message := messageString.
  		textSpec := builder pluggableTextSpec new.
  		textSpec 
  			model: self;
  			getText: #preDebugMessageString; 
  			setText: nil; 
  			selection: nil; 
  			menu: #debugProceedMenu:;
  			frame: self contextStackFrame.
  		windowSpec children add: textSpec.
  	].
  
  	^windowSpec!

Item was changed:
  ----- Method: Debugger>>contents:notifying: (in category 'accessing') -----
  contents: aText notifying: aController
  	"The retrieved information has changed and its source must now be updated.
  	 In this case, the retrieved information is the method of the selected context."
  	| result selector classOfMethod category h ctxt newMethod |
  	contextStackIndex = 0 ifTrue:
  		[^false].
  	self selectedContext isExecutingBlock ifTrue:
  		[h := self selectedContext activeHome.
  		 h ifNil:
  			[self inform: 'Method for block not found on stack, can''t edit and continue'.
  			 ^false].
  		 (self confirm: 'I will have to revert to the method from\which this block originated.  Is that OK?' withCRs) ifFalse:
  			[^false].
  		self resetContext: h changeContents: false.
  		"N.B. Only reset the contents if the compilation succeeds.  If contents are reset
  		 when compilation fails both compiler error message and modifications are lost."
  		(result := self contents: aText notifying: aController) ifTrue:
  			[self contentsChanged].
  		^result].
  
  	classOfMethod := self selectedClass.
  	category := self selectedMessageCategoryName.
  	selector := self selectedClass newParser parseSelector: aText.
  	(selector == self selectedMessageName
  	 or: [(self selectedMessageName beginsWith: 'DoIt')
  		and: [selector numArgs = self selectedMessageName numArgs]]) ifFalse:
  		[self inform: 'can''t change selector'.
  		 ^false].
  	selector := classOfMethod
  				compile: aText
  				classified: category
  				notifying: aController.
  	selector ifNil: [^false]. "compile cancelled"
  	contents := aText.
  	newMethod := classOfMethod compiledMethodAt: selector.
  	newMethod isQuick ifTrue:
  		[self down.
  		 self selectedContext jump: (self selectedContext previousPc - self selectedContext pc)].
  	ctxt := interruptedProcess popTo: self selectedContext.
  	ctxt == self selectedContext
  		ifFalse:
  			[self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs]
  		ifTrue:
  			[newMethod isQuick ifFalse:
  				[interruptedProcess
  					restartTopWith: newMethod;
  				 	stepToSendOrReturn].
  			contextVariablesInspector object: nil].
  	self resetContext: ctxt.
  	Smalltalk isMorphic ifTrue:
  		[World
  			addAlarm: #changed:
  			withArguments: #(contentsSelection)
  			for: self
  			at: (Time millisecondClockValue + 200)].
  	^true!

Item was added:
+ ----- Method: Debugger>>createImplementingMethod (in category 'private') -----
+ createImplementingMethod
+ 	"Should only be called when this Debugger was created in response to a
+ 	NotYetImplemented exception. All we need to do is pop the signalling context off the stack and open the #notYetImplemented method."
+ 	| signallingContext |
+ 	signallingContext := self selectedContext sender.
+ 	"Pop the signalling context off the stack"
+ 	self resetContext: signallingContext.
+ 	self debug.!

Item was changed:
  ----- Method: Debugger>>createMethod (in category 'private') -----
  createMethod
  	"Should only be called when this Debugger was created in response to a
  	MessageNotUnderstood exception. Create a stub for the method that was
  	missing and proceed into it."
  	
  	| msg chosenClass |
  	msg := self contextStackTop exceptionMessage.
  	chosenClass := self
  		askForSuperclassOf: self contextStackTop receiver class
  		toImplement: msg selector
  		ifCancel: [^self].
+ 	self implementMissingMethod: msg inClass: chosenClass.!
- 	self implement: msg inClass: chosenClass.!

Item was changed:
  ----- Method: Debugger>>createOverridingMethod (in category 'private') -----
  createOverridingMethod
  	"Should only be called when this Debugger was created in response to a
+ 	SubclassResponsibility exception. Create a stub for the method that needs
+ 	overriding and proceed into it. Let the user only select a class in the
+ 	inheritance chain between the actual class and the class declaring the
+ 	subclassResponsibility."
+ 	| chosenClass msg category |
- 	SubclassResponsibility exception. Create a stub for the method that was
- 	missing and proceed into it."
- 	| msg |
  	msg := self contextStackTop exceptionMessage.
+ 	chosenClass := self
+ 		askForSuperclassOf: self contextStackTop receiver class
+ 		upTo: self contextStackTop sender method methodClass
+ 		toImplement: msg selector
+ 		ifCancel: [^self].
+ 	"Use the same category as the marker method."
+ 	category := self contextStackTop sender selectorCategory.
+ 	self implementOverridingMethod: msg inClass: chosenClass inCategory: category.!
- 	self implement: msg inClass: self contextStackTop receiver class inCategory: self contextStackTop selectorCategory.!

Item was removed:
- ----- Method: Debugger>>implement:inClass: (in category 'context stack menu') -----
- implement: aMessage inClass: aClass
- 	^ self
- 		implement: aMessage
- 		inClass: aClass
- 		inCategory: (self askForCategoryIn: aClass default: 'as yet unclassified').!

Item was removed:
- ----- Method: Debugger>>implement:inClass:inCategory: (in category 'context stack menu') -----
- implement: aMessage inClass: aClass inCategory: aSymbol
- 	aClass
- 		compile: aMessage createStubMethod
- 		classified: aSymbol.
- 	self setContentsToForceRefetch.
- 	self selectedContext privRefreshWith: (aClass lookupSelector: aMessage selector).
- 	aMessage numArgs > 0 ifTrue:
- 		[aMessage arguments withIndexDo:
- 			[:arg :index|
- 			self selectedContext tempAt: index put: arg]].
- 
- 	"Snip out of the call stack the context that raised the debugger. - the #notYetImplemented send, for example."
- 	self selectedContext privSender: self selectedContext sender sender.
- 	self resetContext: self selectedContext.
- 	self debug.!

Item was added:
+ ----- Method: Debugger>>implementMissingMethod:inClass: (in category 'context stack menu') -----
+ implementMissingMethod: aMessage inClass: aClass
+ 	^ self
+ 		implementMissingMethod: aMessage
+ 		inClass: aClass
+ 		inCategory: (self askForCategoryIn: aClass default: 'as yet unclassified').!

Item was added:
+ ----- Method: Debugger>>implementMissingMethod:inClass:inCategory: (in category 'context stack menu') -----
+ implementMissingMethod: aMessage inClass: aClass inCategory: aSymbol
+ 	"Create a stub implementation of the missing message and sew it onto the top of the stack, ensuring the context's arguments are set correctly. Debug the new context."
+ 	self pushStubMethodOnStack: aMessage inClass: aClass inCategory: aSymbol.
+ 
+ 	"Cut out the sender context. This is the context that signalled the MessageNotUnderstood."
+ 	self selectedContext privSender: self selectedContext sender.
+ 	self resetContext: self selectedContext.
+ 	self debug.!

Item was added:
+ ----- Method: Debugger>>implementOverridingMethod:inClass:inCategory: (in category 'context stack menu') -----
+ implementOverridingMethod: aMessage inClass: aClass inCategory: aSymbol
+ 	"Create a stub implementation of the overriding message and sew it onto the top of the stack, ensuring the context's arguments are set correctly. Debug the new context."
+ 	self pushStubMethodOnStack: aMessage inClass: aClass inCategory: aSymbol.
+ 
+ 	"Cut out the sender context. This is the context that signalled the SubclassResponsibility."
+ 	self selectedContext privSender: self selectedContext sender sender.
+ 	self resetContext: self selectedContext.
+ 	self debug.!

Item was changed:
  ----- Method: Debugger>>populateImplementInMenu: (in category 'context stack menu') -----
  populateImplementInMenu: aMenu
  
  	| msg |
  	msg := self selectedContext at: 1.
  	self selectedContext receiver class withAllSuperclasses do:
  		[:each |
+ 		aMenu add: each name target: self selector: #implementMissingMethod:inClass: argumentList: (Array with: msg with: each)].
- 		aMenu add: each name target: self selector: #implement:inClass: argumentList: (Array with: msg with: each)].
  	^ aMenu
  
  !

Item was added:
+ ----- Method: Debugger>>pushStubMethodOnStack:inClass:inCategory: (in category 'private') -----
+ pushStubMethodOnStack: aMessage inClass: aClass inCategory: aSymbol
+ 	"Create a stub implementation of the message and sew it onto the top of the stack, ensuring the context's arguments are set correctly."
+ 	aClass
+ 		compile: aMessage createStubMethod
+ 		classified: aSymbol.
+ 	self setContentsToForceRefetch.
+ 	self selectedContext privRefreshWith: (aClass lookupSelector: aMessage selector).
+ 	aMessage numArgs > 0 ifTrue:
+ 		[aMessage arguments withIndexDo:
+ 			[:arg :index|
+ 			self selectedContext tempAt: index put: arg]].!

Item was added:
+ ----- Method: PreDebugWindow>>createImplementingMethod (in category '*Tools-Debugger') -----
+ createImplementingMethod
+ 	model createImplementingMethod.!

Item was added:
+ ----- Method: PreDebugWindow>>createMethod (in category '*Tools-Debugger') -----
+ createMethod
+ 	model createMethod!

Item was added:
+ ----- Method: PreDebugWindow>>createOverridingMethod (in category '*Tools-Debugger') -----
+ createOverridingMethod
+ 	model createOverridingMethod!



More information about the Packages mailing list