[BUG][FIX] ChangeSorter>>fileOutClass

Yoshiki Ohshima ohshima at is.titech.ac.jp
Fri Jul 21 08:44:22 UTC 2000


  Hi,

  The 'file out' item in the class list menu of the change
sorter doesn't work because #fileOutClass is missing from
ChangeSorter.

  Attached is possible fix for this problem.

  Regards,

  -- Yoshiki
-------------- next part --------------
'From Squeak2.9alpha of 13 June 2000 [latest update: #2447] on 21 July 2000 at 5:26:47 pm'!

!ChangeSorter methodsFor: 'class list' stamp: 'yo 7/13/2000 23:20'!
fileOutClass

	| file slips nameToUse class |
	currentClassName ifNil: [^self].
	myChangeSet checkForConversionMethods.
	
	nameToUse _ Preferences changeSetVersionNumbers
		ifTrue:
			[FileDirectory default nextNameFor: (myChangeSet name, '-', currentClassName)  extension: 'cs']
		ifFalse:
			[((myChangeSet name, '-', myChangeSet currentClassName), FileDirectory dot, Utilities dateTimeSuffix, 
				FileDirectory dot, 'cs') asFileName].
	class _ Smalltalk at: currentClassName ifAbsent: [].
	class ifNil: [^self].
	Cursor write showWhile:
		[file _ FileStream newFileNamed: nameToUse.
		file header; timeStamp.
		myChangeSet fileOutChangesFor: class on: file.
		file trailer; close].

	Preferences suppressCheckForSlips ifTrue: [^ self].

	slips _ myChangeSet checkForSlipsFor: class.
	(slips size > 0 and: [self confirm: 'Methods in this fileOut have halts
or references to the Transcript
or other ''slips'' in them.
Would you like to browse them?'])
		ifTrue: [Smalltalk browseMessageList: slips
							name: 'Possible slips in ', myChangeSet name]	! !


!ChangeSet methodsFor: 'fileIn/Out' stamp: 'yo 7/13/2000 23:21'!
checkForSlipsFor: aClass
	"Return a collection of method refs with possible debugging code in them."
	| slips method |
	slips _ OrderedCollection new.
		(self methodChangesAtClass: aClass name) associationsDo: 
				[:mAssoc | (#(remove addedThenRemoved) includes: mAssoc value) ifFalse:
					[method _ aClass compiledMethodAt: mAssoc key ifAbsent: [nil].
					method ifNotNil:
						[method hasReportableSlip
							ifTrue: [slips add: aClass name , ' ' , mAssoc key]]]].
	^ slips! !



More information about the Squeak-dev mailing list