Squeak-dev February 2024

squeak-dev@lists.squeakfoundation.org

32 participants
107 discussions

The Trunk: Kernel-ct.1420.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1420.mcz ==================== Summary ==================== Name: Kernel-ct.1420 Author: ct Time: 10 November 2021, 1:47:10.350242 am UUID: 8f2e7a27-2c7b-534a-9c78-a90c968e45c5 Ancestors: Kernel-eem.1418 Aligns the error code for primitive 118 during simulation with what the VM returns. See KernelTests-ct.409/#testPrimitive118/{6. 'not a primitive'. {7}},{6. 9. 'not an array'}. =============== Diff against Kernel-eem.1418 =============== Item was changed: ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^Context sender: self receiver: thisReceiver method: methodArg arguments: args]. primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: + [^self class primitiveFailTokenFor: -3]. - [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]!

1 0

The Trunk: Kernel-ct.1455.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1455.mcz ==================== Summary ==================== Name: Kernel-ct.1455 Author: ct Time: 2 April 2022, 6:03:46.669052 pm UUID: d86c9223-8db7-e541-96bd-cde0c9b7fb92 Ancestors: Kernel-ul.1454 Proposal: Adds basic support for #acceptsLoggingOfCompilation to class comments by allowing strings in BasicClassOrganizer.classComment. With this change, installing updates in a read-only image becomes more feasible. Please review. =============== Diff against Kernel-ul.1454 =============== Item was changed: ----- Method: BasicClassOrganizer>>classComment (in category 'accessing') ----- classComment classComment ifNil: [^ '']. + (classComment isString + or: [classComment isText]) + ifTrue: [^ classComment]. + ^ classComment text + ifNil: ['']! - ^ classComment text ifNil: ['']! Item was changed: ----- Method: BasicClassOrganizer>>classComment:stamp: (in category 'accessing') ----- classComment: aString stamp: aStamp + "Store the comment, aString, associated with the object that refers to the receiver. PRIVATE!! Clients should use aClass classComment: instead." - "Store the comment, aString, associated with the object that refers to the receiver." self commentStamp: aStamp. (aString isKindOf: RemoteString) ifTrue: [classComment := aString] ifFalse: [(aString == nil or: [aString size = 0]) ifTrue: [classComment := nil] ifFalse: + [classComment := aString]] - [self error: 'use aClass classComment:'. - classComment := RemoteString newString: aString onFileNumber: 2]] "Later add priorSource and date and initials?"! Item was changed: ----- Method: BasicClassOrganizer>>commentRemoteStr (in category 'accessing') ----- commentRemoteStr + ^ (classComment isKindOf: RemoteString) + ifTrue: [classComment]! - ^ classComment! Item was changed: ----- Method: BasicClassOrganizer>>fileOutCommentOn:moveSource:toFile: (in category 'fileIn/Out') ----- fileOutCommentOn: aFileStream moveSource: moveSource toFile: fileIndex "Copy the class comment to aFileStream. If moveSource is true (as in compressChanges or compressSources, then update classComment to point to the new file." | fileComment | + self hasNoComment ifTrue: [^ self]. + + aFileStream cr. + fileComment := RemoteString + newString: self classComment + onFileNumber: fileIndex + toFile: aFileStream. + moveSource ifTrue: [classComment := fileComment].! - classComment ifNotNil: - [aFileStream cr. - fileComment := RemoteString newString: classComment text - onFileNumber: fileIndex toFile: aFileStream. - moveSource ifTrue: [classComment := fileComment]]! Item was changed: ----- Method: BasicClassOrganizer>>moveChangedCommentToFile:numbered: (in category 'fileIn/Out') ----- moveChangedCommentToFile: aFileStream numbered: fileIndex "If the comment is in the changes file, then move it to a new file." + (self commentRemoteStr ~~ nil and: [classComment sourceFileNumber > 1]) ifTrue: - (classComment ~~ nil and: [classComment sourceFileNumber > 1]) ifTrue: [self fileOutCommentOn: aFileStream moveSource: true toFile: fileIndex]! Item was changed: ----- Method: ClassDescription>>classComment:stamp: (in category 'fileIn/Out') ----- classComment: aString stamp: aStamp "Store the comment, aString or Text or RemoteString, associated with the class we are organizing. Empty string gets stored only if had a non-empty one before." - | ptr header file oldCommentRemoteStr | (aString isKindOf: RemoteString) ifTrue: [SystemChangeNotifier uniqueInstance classCommented: self. ^ self organization classComment: aString stamp: aStamp]. + self acceptsLoggingOfCompilation + ifTrue: + [| ptr header file oldCommentRemoteStr | + oldCommentRemoteStr := self organization commentRemoteStr. + (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: + ["never had a class comment, no need to write empty string out" + ^ self organization classComment: nil]. + + ptr := oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer]. + SourceFiles ifNotNil: [(file := SourceFiles at: 2) ifNotNil: + [file setToEnd; cr; nextPut: $!!. "directly" + "Should be saying (file command: ''H3'') for HTML, but ignoring it here" + header := String streamContents: [:strm | strm nextPutAll: self name; + nextPutAll: ' commentStamp: '. + aStamp storeOn: strm. + strm nextPutAll: ' prior: '; nextPutAll: ptr printString]. + file nextChunkPut: header]]. + self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp. + file ifNotNil: [ InMidstOfFileinNotification signal ifFalse: [ file flush ] ]] + ifFalse: + [self organization classComment: aString stamp: aStamp]. + + SystemChangeNotifier uniqueInstance classCommented: self.! - oldCommentRemoteStr := self organization commentRemoteStr. - (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ self organization classComment: nil]. - "never had a class comment, no need to write empty string out" - - ptr := oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer]. - SourceFiles ifNotNil: [(file := SourceFiles at: 2) ifNotNil: - [file setToEnd; cr; nextPut: $!!. "directly" - "Should be saying (file command: 'H3') for HTML, but ignoring it here" - header := String streamContents: [:strm | strm nextPutAll: self name; - nextPutAll: ' commentStamp: '. - aStamp storeOn: strm. - strm nextPutAll: ' prior: '; nextPutAll: ptr printString]. - file nextChunkPut: header]]. - self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp. - file ifNotNil: [ InMidstOfFileinNotification signal ifFalse: [ file flush ] ]. - SystemChangeNotifier uniqueInstance classCommented: self. - !

1 0

The Trunk: Kernel-ct.1450.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1450.mcz ==================== Summary ==================== Name: Kernel-ct.1450 Author: ct Time: 25 March 2022, 12:03:45.256465 am UUID: 484c3944-1ae9-fa4b-888c-bacd59152bc5 Ancestors: Kernel-nice.1447 Updates comment in TimedOut. =============== Diff against Kernel-nice.1447 =============== Item was changed: Notification subclass: #TimedOut instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'! + !TimedOut commentStamp: 'ct 3/25/2022 00:01' prior: 0! + I am signalled by BlockClosure>>#valueWithin:onTimeout: if the receiving block takes too long to execute. - !TimedOut commentStamp: 'brp 10/21/2004 17:47' prior: 0! - I am signalled by #duration:timeoutDo: if the receiving block takes too long to execute. - I am signalled by a watchdog process spawned by #duration:timeoutDo: and caught in the same method. - I am not intended to be used elsewhere.!

1 0

The Trunk: Kernel-ct.1408.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1408.mcz ==================== Summary ==================== Name: Kernel-ct.1408 Author: ct Time: 17 July 2021, 8:21:02.006197 pm UUID: 0b59b2d7-2dfe-6640-bc29-63e35699bc53 Ancestors: Kernel-mt.1406 Proposal: Show nested exception in the description of BrokenPromise. =============== Diff against Kernel-mt.1406 =============== Item was changed: + ----- Method: BrokenPromise>>defaultAction (in category 'priv handling') ----- - ----- Method: BrokenPromise>>defaultAction (in category 'as yet unclassified') ----- defaultAction self messageText: 'Promise was rejected'. ^super defaultAction! Item was added: + ----- Method: BrokenPromise>>description (in category 'accessing') ----- + description + + ^ String streamContents: [:stream | + stream nextPutAll: super description. + self exception ifNotNil: [:ex | + stream + nextPutAll: ': '; + nextPutAll: ex description]]! Item was added: + ----- Method: BrokenPromise>>exception (in category 'accessing') ----- + exception + + ^ promise ifNotNil: [promise error]! Item was changed: + ----- Method: BrokenPromise>>isResumable (in category 'priv handling') ----- - ----- Method: BrokenPromise>>isResumable (in category 'as yet unclassified') ----- isResumable ^ true! Item was changed: + ----- Method: BrokenPromise>>promise (in category 'accessing') ----- - ----- Method: BrokenPromise>>promise (in category 'as yet unclassified') ----- promise ^ promise! Item was changed: + ----- Method: BrokenPromise>>promise: (in category 'accessing') ----- - ----- Method: BrokenPromise>>promise: (in category 'as yet unclassified') ----- promise: aPromise promise := aPromise!

1 0

The Trunk: Kernel-ct.1356.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1356.mcz ==================== Summary ==================== Name: Kernel-ct.1356 Author: ct Time: 28 October 2020, 9:05:21.976652 pm UUID: 27e8ca85-1191-5b4b-aa8c-92b65e01af50 Ancestors: Kernel-eem.1354 Fixes and refactors ClassBuilder cleanupAndCheckClassHierarchy which was broken due to a missing #informUserDuring: implementation. Also adds progress bars during the operation. =============== Diff against Kernel-eem.1354 =============== Item was changed: ----- Method: ClassBuilder class>>checkClassHierarchyConsistency (in category 'cleanup obsolete classes') ----- checkClassHierarchyConsistency "Check the consistency of the class hierarchy. The class hierarchy is consistent if the following two logical equivalences hold for classes A and B: - B is obsolete and 'B superclass' yields A <--> 'A obsoleteSubclasses' contains B - B is not obsolete and 'B superclass' yields A <--> 'A subclasses' contains B" + + Transcript cr; show: 'Start checking the class hierarchy...'. + Smalltalk garbageCollect. + + Metaclass allInstances + do: [:meta | + meta allInstances do: [:each | self checkClassHierarchyConsistencyFor: each]. + self checkClassHierarchyConsistencyFor: meta] + displayingProgress: 'Validating class hierarchy' translated. + + Transcript show: 'OK'.! - self informUserDuring:[:bar| - self checkClassHierarchyConsistency: bar. - ].! Item was removed: - ----- Method: ClassBuilder class>>checkClassHierarchyConsistency: (in category 'cleanup obsolete classes') ----- - checkClassHierarchyConsistency: informer - "Check the consistency of the class hierarchy. The class hierarchy is consistent if the following - two logical equivalences hold for classes A and B: - - B is obsolete and 'B superclass' yields A <--> 'A obsoleteSubclasses' contains B - - B is not obsolete and 'B superclass' yields A <--> 'A subclasses' contains B" - | classes | - Transcript cr; show: 'Start checking the class hierarchy...'. - Smalltalk garbageCollect. - classes := Metaclass allInstances. - classes keysAndValuesDo: [:index :meta | - informer value:'Validating class hierarchy ', (index * 100 // classes size) printString,'%'. - meta allInstances do: [:each | self checkClassHierarchyConsistencyFor: each]. - self checkClassHierarchyConsistencyFor: meta. - ]. - Transcript show: 'OK'.! Item was changed: ----- Method: ClassBuilder class>>cleanupAndCheckClassHierarchy (in category 'cleanup obsolete classes') ----- cleanupAndCheckClassHierarchy "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary. Afterwards it checks whether the hierarchy is really consistent." + + Project uiManager informUser: 'Cleaning up class hierarchy...' translated during: [ + Transcript cr; show: '*** Before cleaning up ***'. + self countReallyObsoleteClassesAndMetaclasses. + self cleanupClassHierarchy. + self checkClassHierarchyConsistency. + Transcript cr; cr; show: '*** After cleaning up ***'. + self countReallyObsoleteClassesAndMetaclasses].! - self informUserDuring:[:bar| - self cleanupAndCheckClassHierarchy: bar. - ]. - ! Item was removed: - ----- Method: ClassBuilder class>>cleanupAndCheckClassHierarchy: (in category 'cleanup obsolete classes') ----- - cleanupAndCheckClassHierarchy: informer - "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary. - Afterwards it checks whether the hierarchy is really consistent." - - Transcript cr; show: '*** Before cleaning up ***'. - self countReallyObsoleteClassesAndMetaclasses. - self cleanupClassHierarchy: informer. - self checkClassHierarchyConsistency: informer. - Transcript cr; cr; show: '*** After cleaning up ***'. - self countReallyObsoleteClassesAndMetaclasses.! Item was changed: ----- Method: ClassBuilder class>>cleanupClassHierarchy (in category 'cleanup obsolete classes') ----- cleanupClassHierarchy "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary." + + Transcript cr; show: 'Start fixing the class hierarchy and cleaning up...'. + Smalltalk garbageCollect. + + Metaclass allInstances + do: [:meta | + "Check classes before metaclasses (because Metaclass>>isObsolete checks whether the related class is obsolete)" + meta allInstances do: [:each | self cleanupClassHierarchyFor: each]. + self cleanupClassHierarchyFor: meta] + displayingProgress: 'Fixing class hierarchy' translated. + + Transcript show: 'DONE'.! - self informUserDuring:[:bar| - self cleanupClassHierarchy: bar. - ].! Item was removed: - ----- Method: ClassBuilder class>>cleanupClassHierarchy: (in category 'cleanup obsolete classes') ----- - cleanupClassHierarchy: informer - "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary." - | classes | - Transcript cr; show: 'Start fixing the class hierarchy and cleaning up...'. - Smalltalk garbageCollect. - classes := Metaclass allInstances. - classes keysAndValuesDo: [:index :meta | - informer value:'Fixing class hierarchy ', (index * 100 // classes size) printString,'%'. - "Check classes before metaclasses (because Metaclass>>isObsolete - checks whether the related class is obsolete)" - meta allInstances do: [:each | self cleanupClassHierarchyFor: each]. - self cleanupClassHierarchyFor: meta. - ]. - Transcript show: 'DONE'.!

1 0

The Trunk: Kernel-ct.1555.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1555.mcz ==================== Summary ==================== Name: Kernel-ct.1555 Author: ct Time: 25 February 2024, 7:56:23.908593 pm UUID: 45f6b27d-e825-c34b-a540-5c173c78c951 Ancestors: Kernel-ct.1554, Kernel-ct.1356, Kernel-ct.1408, Kernel-ct.1450, Kernel-ct.1455 Merge commit. Kernel-ct.1301: Documents the small but essential difference between #sendTo: and #sentTo:. Kernel-ct.1356: Fixes and refactors ClassBuilder cleanupAndCheckClassHierarchy which was broken due to a missing #informUserDuring: implementation. Also adds progress bars during the operation. Kernel-ct.1408: Proposal: Show nested exception in the description of BrokenPromise. Revision: Honor the fact that Promise errors are not necessarily exceptions. Reuse #messageText rather than overriding #description. Kernel-ct.1450: Updates comment in TimedOut. Kernel-ct.1455: Adds basic support for #acceptsLoggingOfCompilation to class comments by allowing strings in BasicClassOrganizer classComment. =============== Diff against Kernel-ct.1554 =============== Item was changed: ----- Method: BasicClassOrganizer>>classComment (in category 'accessing') ----- classComment classComment ifNil: [^ '']. + (classComment isString + or: [classComment isText]) + ifTrue: [^ classComment]. + ^ classComment text + ifNil: ['']! - ^ classComment text ifNil: ['']! Item was changed: ----- Method: BasicClassOrganizer>>classComment:stamp: (in category 'accessing') ----- classComment: aString stamp: aStamp + "Store the comment, aString, associated with the object that refers to the receiver. PRIVATE!! Clients should use aClass classComment: instead." - "Store the comment, aString, associated with the object that refers to the receiver." self commentStamp: aStamp. (aString isKindOf: RemoteString) ifTrue: [classComment := aString] ifFalse: [(aString == nil or: [aString size = 0]) ifTrue: [classComment := nil] ifFalse: + [classComment := aString]] - [self error: 'use aClass classComment:'. - classComment := RemoteString newString: aString onFileNumber: 2]] "Later add priorSource and date and initials?"! Item was changed: ----- Method: BasicClassOrganizer>>commentRemoteStr (in category 'accessing') ----- commentRemoteStr + ^ (classComment isKindOf: RemoteString) + ifTrue: [classComment]! - ^ classComment! Item was changed: ----- Method: BasicClassOrganizer>>fileOutCommentOn:moveSource:toFile: (in category 'fileIn/Out') ----- fileOutCommentOn: aFileStream moveSource: moveSource toFile: fileIndex "Copy the class comment to aFileStream. If moveSource is true (as in compressChanges or compressSources, then update classComment to point to the new file." | fileComment | + self hasNoComment ifTrue: [^ self]. + + aFileStream cr. + fileComment := RemoteString + newString: self classComment + onFileNumber: fileIndex + toFile: aFileStream. + moveSource ifTrue: [classComment := fileComment].! - classComment ifNotNil: - [aFileStream cr. - fileComment := RemoteString newString: classComment text - onFileNumber: fileIndex toFile: aFileStream. - moveSource ifTrue: [classComment := fileComment]]! Item was changed: ----- Method: BasicClassOrganizer>>moveChangedCommentToFile:numbered: (in category 'fileIn/Out') ----- moveChangedCommentToFile: aFileStream numbered: fileIndex "If the comment is in the changes file, then move it to a new file." + (self commentRemoteStr ~~ nil and: [classComment sourceFileNumber > 1]) ifTrue: - (classComment ~~ nil and: [classComment sourceFileNumber > 1]) ifTrue: [self fileOutCommentOn: aFileStream moveSource: true toFile: fileIndex]! Item was added: + ----- Method: BrokenPromise>>error (in category 'accessing') ----- + error + + ^ promise ifNotNil: [promise error]! Item was added: + ----- Method: BrokenPromise>>messageText (in category 'accessing') ----- + messageText + + ^ messageText ifNil: + [self error ifNotNil: [:error | + error asString]]! Item was changed: ----- Method: ClassBuilder class>>checkClassHierarchyConsistency (in category 'cleanup obsolete classes') ----- checkClassHierarchyConsistency "Check the consistency of the class hierarchy. The class hierarchy is consistent if the following two logical equivalences hold for classes A and B: - B is obsolete and 'B superclass' yields A <--> 'A obsoleteSubclasses' contains B - B is not obsolete and 'B superclass' yields A <--> 'A subclasses' contains B" + + Transcript cr; show: 'Start checking the class hierarchy...'. + Smalltalk garbageCollect. + + Metaclass allInstances + do: [:meta | + meta allInstances do: [:each | self checkClassHierarchyConsistencyFor: each]. + self checkClassHierarchyConsistencyFor: meta] + displayingProgress: 'Validating class hierarchy' translated. + + Transcript show: 'OK'.! - self informUserDuring:[:bar| - self checkClassHierarchyConsistency: bar. - ].! Item was removed: - ----- Method: ClassBuilder class>>checkClassHierarchyConsistency: (in category 'cleanup obsolete classes') ----- - checkClassHierarchyConsistency: informer - "Check the consistency of the class hierarchy. The class hierarchy is consistent if the following - two logical equivalences hold for classes A and B: - - B is obsolete and 'B superclass' yields A <--> 'A obsoleteSubclasses' contains B - - B is not obsolete and 'B superclass' yields A <--> 'A subclasses' contains B" - | classes | - Transcript cr; show: 'Start checking the class hierarchy...'. - Smalltalk garbageCollect. - classes := Metaclass allInstances. - classes keysAndValuesDo: [:index :meta | - informer value:'Validating class hierarchy ', (index * 100 // classes size) printString,'%'. - meta allInstances do: [:each | self checkClassHierarchyConsistencyFor: each]. - self checkClassHierarchyConsistencyFor: meta. - ]. - Transcript show: 'OK'.! Item was changed: ----- Method: ClassBuilder class>>cleanupAndCheckClassHierarchy (in category 'cleanup obsolete classes') ----- cleanupAndCheckClassHierarchy "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary. Afterwards it checks whether the hierarchy is really consistent." + + Project uiManager informUser: 'Cleaning up class hierarchy...' translated during: [ + Transcript cr; show: '*** Before cleaning up ***'. + self countReallyObsoleteClassesAndMetaclasses. + self cleanupClassHierarchy. + self checkClassHierarchyConsistency. + Transcript cr; cr; show: '*** After cleaning up ***'. + self countReallyObsoleteClassesAndMetaclasses].! - self informUserDuring:[:bar| - self cleanupAndCheckClassHierarchy: bar. - ]. - ! Item was removed: - ----- Method: ClassBuilder class>>cleanupAndCheckClassHierarchy: (in category 'cleanup obsolete classes') ----- - cleanupAndCheckClassHierarchy: informer - "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary. - Afterwards it checks whether the hierarchy is really consistent." - - Transcript cr; show: '*** Before cleaning up ***'. - self countReallyObsoleteClassesAndMetaclasses. - self cleanupClassHierarchy: informer. - self checkClassHierarchyConsistency: informer. - Transcript cr; cr; show: '*** After cleaning up ***'. - self countReallyObsoleteClassesAndMetaclasses.! Item was changed: ----- Method: ClassBuilder class>>cleanupClassHierarchy (in category 'cleanup obsolete classes') ----- cleanupClassHierarchy "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary." + + Transcript cr; show: 'Start fixing the class hierarchy and cleaning up...'. + Smalltalk garbageCollect. + + Metaclass allInstances + do: [:meta | + "Check classes before metaclasses (because Metaclass>>isObsolete checks whether the related class is obsolete)" + meta allInstances do: [:each | self cleanupClassHierarchyFor: each]. + self cleanupClassHierarchyFor: meta] + displayingProgress: 'Fixing class hierarchy' translated. + + Transcript show: 'DONE'.! - self informUserDuring:[:bar| - self cleanupClassHierarchy: bar. - ].! Item was removed: - ----- Method: ClassBuilder class>>cleanupClassHierarchy: (in category 'cleanup obsolete classes') ----- - cleanupClassHierarchy: informer - "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary." - | classes | - Transcript cr; show: 'Start fixing the class hierarchy and cleaning up...'. - Smalltalk garbageCollect. - classes := Metaclass allInstances. - classes keysAndValuesDo: [:index :meta | - informer value:'Fixing class hierarchy ', (index * 100 // classes size) printString,'%'. - "Check classes before metaclasses (because Metaclass>>isObsolete - checks whether the related class is obsolete)" - meta allInstances do: [:each | self cleanupClassHierarchyFor: each]. - self cleanupClassHierarchyFor: meta. - ]. - Transcript show: 'DONE'.! Item was changed: ----- Method: ClassDescription>>classComment:stamp: (in category 'fileIn/Out') ----- classComment: aString stamp: aStamp "Store the comment, aString or Text or RemoteString, associated with the class we are organizing. Empty string gets stored only if had a non-empty one before." - | ptr header file oldCommentRemoteStr | (aString isKindOf: RemoteString) ifTrue: [SystemChangeNotifier uniqueInstance classCommented: self. ^ self organization classComment: aString stamp: aStamp]. + self acceptsLoggingOfCompilation + ifTrue: + [| ptr header file oldCommentRemoteStr | + oldCommentRemoteStr := self organization commentRemoteStr. + (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: + ["never had a class comment, no need to write empty string out" + ^ self organization classComment: nil]. + + ptr := oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer]. + SourceFiles ifNotNil: [(file := SourceFiles at: 2) ifNotNil: + [file setToEnd; cr; nextPut: $!!. "directly" + "Should be saying (file command: ''H3'') for HTML, but ignoring it here" + header := String streamContents: [:strm | strm nextPutAll: self name; + nextPutAll: ' commentStamp: '. + aStamp storeOn: strm. + strm nextPutAll: ' prior: '; nextPutAll: ptr printString]. + file nextChunkPut: header]]. + self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp. + file ifNotNil: [ InMidstOfFileinNotification signal ifFalse: [ file flush ] ]] + ifFalse: + [self organization classComment: aString stamp: aStamp]. + + SystemChangeNotifier uniqueInstance classCommented: self.! - oldCommentRemoteStr := self organization commentRemoteStr. - (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ self organization classComment: nil]. - "never had a class comment, no need to write empty string out" - - ptr := oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer]. - SourceFiles ifNotNil: [(file := SourceFiles at: 2) ifNotNil: - [file setToEnd; cr; nextPut: $!!. "directly" - "Should be saying (file command: 'H3') for HTML, but ignoring it here" - header := String streamContents: [:strm | strm nextPutAll: self name; - nextPutAll: ' commentStamp: '. - aStamp storeOn: strm. - strm nextPutAll: ' prior: '; nextPutAll: ptr printString]. - file nextChunkPut: header]]. - self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp. - file ifNotNil: [ InMidstOfFileinNotification signal ifFalse: [ file flush ] ]. - SystemChangeNotifier uniqueInstance classCommented: self. - ! Item was changed: ----- Method: Message>>sendTo: (in category 'sending') ----- + sendTo: receiverObject + "Answer the result of sending this message to receiverObject" - sendTo: receiver - "answer the result of sending this message to receiver" + ^ receiverObject perform: selector withArguments: args! - ^ receiver perform: selector withArguments: args! Item was changed: ----- Method: Message>>sentTo: (in category 'sending') ----- + sentTo: receiverObject + "Answer the result of sending this message to receiver. Kind of private!! To send the message to a different receiver (for example, via #doesNotUnderstand:), use #sendTo: instead." - sentTo: receiver - "answer the result of sending this message to receiver" + ^ lookupClass == nil + ifTrue: [receiverObject perform: selector withArguments: args] + ifFalse: [receiverObject perform: selector withArguments: args inSuperclass: lookupClass]! - lookupClass == nil - ifTrue: [^ receiver perform: selector withArguments: args] - ifFalse: [^ receiver perform: selector withArguments: args inSuperclass: lookupClass]! Item was changed: Notification subclass: #TimedOut instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'! + !TimedOut commentStamp: 'ct 3/25/2022 00:01' prior: 0! + I am signalled by BlockClosure>>#valueWithin:onTimeout: if the receiving block takes too long to execute. - !TimedOut commentStamp: 'brp 10/21/2004 17:47' prior: 0! - I am signalled by #duration:timeoutDo: if the receiving block takes too long to execute. - I am signalled by a watchdog process spawned by #duration:timeoutDo: and caught in the same method. - I am not intended to be used elsewhere.!

1 0

Re: Squeak Oversight Board Election 2024
by LawsonEnglish 25 Feb '24

25 Feb '24

Did you get this, merik?

1 0

The Inbox: Kernel-ct.1342.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-ct.1342.mcz ==================== Summary ==================== Name: Kernel-ct.1342 Author: ct Time: 25 September 2020, 6:32:44.665274 pm UUID: 037ef8ee-228f-914b-8d1e-b05cac84772b Ancestors: Kernel-eem.1341 Add ordinal suffix logic to Integer Example: (1 to: 30) collect: [:ea | ea withOrdinalSuffix] =============== Diff against Kernel-eem.1341 =============== Item was added: + ----- Method: Integer>>ordinalSuffix (in category 'printing') ----- + ordinalSuffix + "Answer a string containing the ordinal suffix of the receiver, e.g. 'th' for 4, or 'rd' for 23." + + self \\ 100 // 10 = 1 ifFalse: [ + self \\ 10 + caseOf: { + [1] -> [^ 'st']. + [2] -> [^ 'nd']. + [3] -> [^ 'rd'] } + otherwise: []]. + ^ 'th'! Item was added: + ----- Method: Integer>>printWithOrdinalSuffixOn: (in category 'printing') ----- + printWithOrdinalSuffixOn: aStream + + aStream + print: self; + nextPutAll: self ordinalSuffix.! Item was added: + ----- Method: Integer>>withOrdinalSuffix (in category 'printing') ----- + withOrdinalSuffix + + ^ String streamContents: [:stream | + self printWithOrdinalSuffixOn: stream]!

5 5

The Trunk: JSON-cmm.61.mcz
by commits＠source.squeak.org 24 Feb '24

24 Feb '24

Chris Muller uploaded a new version of JSON to project The Trunk: http://source.squeak.org/trunk/JSON-cmm.61.mcz ==================== Summary ==================== Name: JSON-cmm.61 Author: cmm Time: 18 February 2024, 6:01:50.22946 pm UUID: 9f100ce1-3d3c-4ea2-b975-4821175b41ba Ancestors: JSON-ct.58 Path access and enumeration for JSON objects. =============== Diff against JSON-ct.58 =============== Item was added: + ----- Method: Collection>>atPath: (in category '*json') ----- + atPath: anArray + "Assume I'm a set of nested HashedCollections and/or SequenceableCollections. Answer the object at the path of indices and/or keys identified in anArray." + ^ self + atPath: anArray + ifLost: [ : last | self error: 'path lost after' , last asString ]! Item was added: + ----- Method: Collection>>atPath:ifLost: (in category '*json') ----- + atPath: anArray ifLost: aBlock + "Assume I'm a set of nested HashedCollections and/or SequenceableCollections. Answer the object at the path of indices and/or keys identified in anArray. If the full path specified by anArray isn't present, cull aBlock with the last element present along the path." + | last | + ^ (self + path: anArray + do: [ : elem : node | last := node ]) + ifNil: [ aBlock cull: last ] + ifNotNil: [ last ]! Item was added: + ----- Method: Collection>>path:do: (in category '*json') ----- + path: anArray do: aBlock + "Assume I'm a set of nested HashedCollections and/or SequenceableCollections. Value aBlock with each object along the path of indices and/or keys identified in anArray. If a path element isn't found, stop, and return nil, otherwise, return self." + anArray + inject: self + into: + [ : dictOrArray : pathElem | dictOrArray + at: pathElem + ifPresent: [ : node | aBlock value: pathElem value: node ] + ifAbsent: [ ^ nil ] ]. + ^ self!

4 5

Review Request: stepThroughDeadHome.1.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 24 Feb '24

24 Feb '24

=============== Summary =============== Change Set: stepThroughDeadHome Date: 24 February 2024 Author: Christoph Thiede Patches Process>>#stepToHome: so that stepping through a bottom context that is not a home context works as expected. Revises Kernel-ct.1384. =============== Diff =============== Context>>hasHome: {testing} · ct 10/21/2023 20:35 + hasHome: aContext + + self == aContext ifTrue: [^ true]. + closureOrNil ifNil: [^ false]. + ^ closureOrNil outerContext hasHome: aContext Context>>livingHome {accessing} · ct 10/21/2023 20:36 + livingHome + + self isDead ifTrue: [^ nil]. + closureOrNil ifNil: [^ self]. + ^ closureOrNil outerContext livingHome ifNil: [self] Process>>stepToHome: {changing suspended state} · ct 2/24/2024 21:54 (changed) stepToHome: aContext "Resume self until the home of top context is aContext. Top context may be a block context. Catch any UnhandledErrors that are created while stepping, answering the relevant signalerContext if so. Note that this will cause weird effects if using through to step through UnhandledError code, but as the doctor ordered, don't do that; use over or into instead." - + ^Processor activeProcess evaluate: [| home anError | - home := aContext home. + home := aContext livingHome. "aContext home may legitimally be dead, e.g. doing the followig separately from a workspace: + + p := Process forContext: ([[] ensure: []] asContext) priority: 40. + p debug." [suspendedContext := suspendedContext step. - home == suspendedContext home or: [home isDead]] whileFalse: + home isDead or: [suspendedContext isDead or: [suspendedContext hasHome: home]]] whileFalse: [(suspendedContext selector == #signalForException: and: [(suspendedContext receiver isBehavior and: [ suspendedContext receiver includesBehavior: UnhandledError]) and: [anError := suspendedContext tempAt: 1. ((suspendedContext objectClass: anError) includesBehavior: Exception) and: [anError canSearchForSignalerContext]]]) ifTrue: [anError signalerContext ifNotNil: [:unhandledErrorSignalerContext| [unhandledErrorSignalerContext == suspendedContext] whileFalse: [self completeStep: suspendedContext]. "Give a debugger a chance to update its title to reflect the new exception" Notification new tag: {unhandledErrorSignalerContext. anError}; signal. ^unhandledErrorSignalerContext]]]. suspendedContext] onBehalfOf: self --- Sent from Squeak Inbox Talk ["stepThroughDeadHome.1.cs"]

1 0

← Newer
1
2
3
4
5
6
7
8
...
11
Older →