[squeak-dev] The Trunk: Kernel-nice.1314.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Mar 8 23:11:59 UTC 2020


Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.1314.mcz

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

Name: Kernel-nice.1314
Author: nice
Time: 9 March 2020, 12:11:55.571842 am
UUID: e657e32e-7763-49bc-9dec-035556544077
Ancestors: Kernel-nice.1313

Random changes retained by 5.3 release.

- use #substrings or #lines when simpler than #subStrings:
- protect top Context when we want to #findSimilarSender
 (I had one such case in Debugger, but forgot which one)
- deprecate Integer>>destinationBuffer: this might belong to a package, but not to Kernel obviously.
- Fix SmallInteger>>digitsAsFloat fallback code, super only deals with magnitude, not sign

=============== Diff against Kernel-nice.1313 ===============

Item was changed:
  ----- Method: ClassBuilder>>superclass:ephemeronSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
  superclass: aClass
  	ephemeronSubclass: t instanceVariableNames: f 
  	classVariableNames: d poolDictionaries: s category: cat
  	"This is the standard initialization message for creating a new class as a 
  	subclass of an existing class (the receiver) in which the subclass is to 
  	have ephemeron semantics, i.e. where the object will be queued for
  	finalization when the key (first) inst var is not reachable other than through
  	the other fields of ephemerons with unreachable keys."
  	| env |
  	aClass isPointers ifFalse:
  		[^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
+ 	aClass instSize + f substrings size < 2 ifTrue:
+ 		[^self error: 'cannot make an ephemeron class with less than two named instance variables'].
- 	aClass instSize + (f subStrings: ' 	\' withCRs) size < 2 ifTrue:
- 		[^self error: 'cannot make an ephemeron class with less than two named instance varaibles'].
  	env := CurrentEnvironment signal ifNil: [aClass environment].
  	^self 
  		name: t
  		inEnvironment: env
  		subclassOf: aClass
  		type: #ephemeron
  		instanceVariableNames: f
  		classVariableNames: d
  		poolDictionaries: s
  		category: cat!

Item was changed:
  ----- Method: ClassDescription>>chooseVarThenDo: (in category 'instance variables') -----
  chooseVarThenDo: aBlock 
  	"Put up a menu of all the instance variables in the receiver, and when
  the user chooses one, evaluate aBlock with the chosen variable as its
  parameter."
  	| lines labelStream allVars index |
  	(self allInstVarNames size + self theNonMetaClass allClassVarNames size) = 0 ifTrue: [ ^ self inform: 'There are no variables.' ].
  	allVars := OrderedCollection new.
  	lines := OrderedCollection new.
  	labelStream := WriteStream on: (String new: 200).
  	self withAllSuperclasses reverseDo:
  		[ : class | | vars |
  		vars := class instVarNames , class theNonMetaClass classVarNames.
  		vars do:
  			[ : var | labelStream
  				 nextPutAll: var ;
  				 cr.
  			allVars add: var ].
  		vars isEmpty ifFalse: [ lines add: allVars size ] ].
  	labelStream skip: -1.
  	"cut last CR"
  	(lines size > 0 and: [ lines last = allVars size ]) ifTrue: [ lines removeLast ].
  	"dispense with inelegant line beneath last item"
  	index := UIManager default
+ 		chooseFrom: (labelStream contents lines)
- 		chooseFrom: (labelStream contents subStrings: {Character cr})
  		lines: lines
  		title: 'Variables in ' , self name.
  	index = 0 ifTrue: [ ^ self ].
  	aBlock value: (allVars at: index)!

Item was changed:
  ----- Method: Context>>findSimilarSender (in category 'query') -----
  findSimilarSender
  	"Return the closest sender with the same method, return nil if none found"
  
  	| meth |
  	meth := self method.
+ 	self sender ifNil: [^nil].
  	^ self sender findContextSuchThat: [:c | c method == meth]!

Item was removed:
- ----- Method: Integer>>destinationBuffer: (in category 'printing') -----
- destinationBuffer:digitLength
-   digitLength <= 1
- 		ifTrue: [self]
- 		ifFalse: [LargePositiveInteger new: digitLength].!

Item was changed:
  ----- Method: SmallInteger>>digitsAsFloat (in category 'private') -----
  digitsAsFloat
  	"private - let the primitive take care to answer the nearest float"
  	<primitive: 40>
+ 	^super digitsAsFloat * self sign!
- 	^super digitsAsFloat!



More information about the Squeak-dev mailing list