Packages February 2023

packages@lists.squeakfoundation.org

1 participants
79 discussions

The Trunk: Morphic-mt.2091.mcz
by commits＠source.squeak.org 22 Feb '23

22 Feb '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2091.mcz ==================== Summary ==================== Name: Morphic-mt.2091 Author: mt Time: 22 February 2023, 4:45:02.96655 pm UUID: 2d5c67db-4fbf-1e47-9d70-7854a92de154 Ancestors: Morphic-mt.2090 Minor fixes in tree items. Well, #children does now actually work but is not used at the moment. Just like #isFilterMatch. Both are currently documentation-only... =============== Diff against Morphic-mt.2090 =============== Item was changed: ----- Method: IndentingListItemMorph>>children (in category 'accessing') ----- children ^ Array streamContents: [:stream | + self childrenDo: [:each | stream nextPut: each]]! - self childrenDo: [:each | stream add: each]]! Item was changed: ----- Method: IndentingListItemMorph>>collapse (in category 'container protocol') ----- collapse self isExpanded ifFalse: [^ self]. self isExpanded: false. firstChild ifNotNil: [:collapsingNode | | toDelete | toDelete := OrderedCollection new. collapsingNode withSiblingsDo: [:aNode | aNode recursiveAddTo: toDelete]. + container noteRemovalOfAll: toDelete. + firstChild := nil]. - container noteRemovalOfAll: toDelete]. self changed.! Item was changed: ----- Method: IndentingListItemMorph>>drawFilterOn:in: (in category 'drawing') ----- drawFilterOn: aCanvas in: drawBounds "Draw filter matches if any. Based on LazyListMorph >> #displayFilterOn:for:in:font:." | fillStyle fillHeight leading columnOffsets o cw | filterOffsets ifEmpty: [^ self]. fillHeight := font lineGridForMorphs. fillStyle := container filterColor isColor ifTrue: [SolidFillStyle color: container filterColor] ifFalse: [container filterColor]. fillStyle isGradientFill ifTrue: [ fillStyle origin: drawBounds topLeft. fillStyle direction: 0@ fillHeight]. leading := font lineGapSliceForMorphs. columnOffsets := (container columns isNil or: [container columns size = 1]) ifTrue: [ o := drawBounds left. icon ifNotNil: [o := o + icon width + 2 px]. { o }] ifFalse: [ (0 to: container columns size - 1) collect: [ :column | column = 0 ifTrue: [o := drawBounds left] ifFalse: [ cw := self widthOfColumn: column. column = 1 ifTrue: [ "Reduce width by indentation present in first column only" cw := cw - (drawBounds left - self left) + self hMargin]. column + 1 = self class iconColumnIndex ifTrue: [ icon ifNotNil: [o := o + icon width + 2 px]]. o := o + cw + 5 px]] ]. filterOffsets do: [:offset | | highlightRectangle | highlightRectangle := (((columnOffsets at: offset third) + offset first first) @ drawBounds top corner: ((columnOffsets at: offset third) + offset first last) @ (drawBounds top + fillHeight)). aCanvas + frameAndFillRoundRect: (highlightRectangle outsetBy: 1 px @ 0) - frameAndFillRoundRect: (highlightRectangle outsetBy: 1@0) radius: 3 px fillStyle: fillStyle borderWidth: 1 px borderColor: fillStyle asColor twiceDarker. aCanvas drawString: offset second in: (highlightRectangle origin + (0 @ leading) corner: highlightRectangle corner) font: font color: container filterTextColor].! Item was changed: ----- Method: IndentingListItemMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | tRect sRect | self backgroundColor ifNotNil: [:c | aCanvas fillRectangle: self innerBounds color: c]. tRect := self toggleRectangle. self drawToggleOn: aCanvas in: tRect. sRect := bounds withLeft: tRect right + self hMargin. + sRect := sRect top: sRect top + self fontToUse lineGapSliceForMorphs. - sRect := sRect top: sRect top + sRect bottom - self fontToUse height // 2. (container columns isNil or: [(contents asString indexOf: Character tab) = 0]) ifTrue: [self drawLabelOn: aCanvas in: sRect] ifFalse: [self drawLabelInColumnsOn: aCanvas in: sRect]. self drawFilterOn: aCanvas in: (bounds withLeft: tRect right + self hMargin).!

1 0

The Trunk: Morphic-mt.2090.mcz
by commits＠source.squeak.org 22 Feb '23

22 Feb '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2090.mcz ==================== Summary ==================== Name: Morphic-mt.2090 Author: mt Time: 22 February 2023, 4:38:27.47455 pm UUID: bb357426-f611-f640-852b-988bd0cdb664 Ancestors: Morphic-mt.2089 Use correct code browser when dropping a class onto the world. Note that "SystemBrowser" is an AppRegistry like ToolSet. "Browser" is in this regard an implementation detail. =============== Diff against Morphic-mt.2089 =============== Item was changed: ----- Method: PasteUpMorph>>dropSourceCode:event: (in category 'event handling') ----- dropSourceCode: anObject event: evt (anObject isMethodReference and: [anObject isValid]) ifTrue: [^ self dropSourceCode: anObject compiledMethod event: evt]. (anObject isClassReference and: [anObject isValid]) ifTrue: [^ self dropSourceCode: anObject actualClass event: evt]. (anObject isBehavior or: [anObject isCompiledMethod]) ifTrue: [ | tool window | tool := anObject isBehavior + ifTrue: [SystemBrowser default new - ifTrue: [Browser new setClass: anObject] ifFalse: [CodeHolder new setClass: anObject methodClass selector: anObject selector]. window := ToolBuilder open: tool. window center: evt position. window bounds: (window bounds translatedToBeWithin: self bounds)]. anObject isString ifTrue: [anObject edit].!

1 0

The Trunk: Morphic-mt.2089.mcz
by commits＠source.squeak.org 22 Feb '23

22 Feb '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2089.mcz ==================== Summary ==================== Name: Morphic-mt.2089 Author: mt Time: 22 February 2023, 4:35:56.19355 pm UUID: 4c37a955-4f22-4e42-84a2-9c051554c713 Ancestors: Morphic-mt.2088 Fixes conversion from paragraph to text (incl. hard line-breaks), which had a bug for trailing-CR lines. =============== Diff against Morphic-mt.2088 =============== Item was changed: ----- Method: NewParagraph>>asTextWithLineBreaks (in category 'converting') ----- asTextWithLineBreaks "Answer a text that has all soft line breaks converted to hard line breaks. Add the current style's default font as a text attribute only if a) the style is not the default and b) the first character has no other font set. See Text >> #asTextMorph." | result | result := Text streamContents: [:s | lines do: [:textLine | + textLine last >= textLine first "ignore extra trailing-CR line" ifTrue: [ + | lastChar lastIndex break | + lastChar := text at: textLine last. + (break := CharacterSet separators includes: lastChar) + ifTrue: [lastIndex := textLine last - 1] + ifFalse: [lastIndex := textLine last]. + "1) Copy text line, which may be due to a soft line break" + s nextPutAll: (text copyFrom: textLine first to: lastIndex). + "2) Add a hard line break." + break ifTrue: [s nextPutAll: (String cr asText + addAllAttributes: (text attributesAt: textLine last); + yourself)]]]]. - | lastChar lastIndex break | - lastChar := text at: textLine last. - (break := CharacterSet separators includes: lastChar) - ifTrue: [lastIndex := textLine last - 1] - ifFalse: [lastIndex := textLine last]. - "1) Copy text line, which may be due to a soft line break" - s nextPutAll: (text copyFrom: textLine first to: lastIndex). - "2) Add a hard line break." - break ifTrue: [s nextPutAll: (String cr asText - addAllAttributes: (text attributesAt: textLine last); - yourself)]]]. ((text fontAt: 1 withDefault: nil) isNil and: [ textStyle defaultFamilyName ~= TextStyle default defaultFamilyName]) ifTrue: [result addAttribute: (TextFontReference toFont: textStyle defaultFont)]. ^ result!

1 0

The Trunk: Chronology-Core-mt.82.mcz
by commits＠source.squeak.org 22 Feb '23

22 Feb '23

Marcel Taeumel uploaded a new version of Chronology-Core to project The Trunk: http://source.squeak.org/trunk/Chronology-Core-mt.82.mcz ==================== Summary ==================== Name: Chronology-Core-mt.82 Author: mt Time: 22 February 2023, 11:07:44.140727 am UUID: 1ae56377-f602-c54e-a75d-1662dc4bfb1c Ancestors: Chronology-Core-dtl.81 Fixes high-res-clock preference and reset ticks-per-ms estimate on system startup. =============== Diff against Chronology-Core-dtl.81 =============== Item was changed: ----- Method: Time class>>startUp: (in category 'system startup') ----- startUp: resuming resuming ifTrue: [ + LastClockTick := 0. + HighResClockTicksPerMillisecond := 0 ]! - LastClockTick := 0 ]! Item was added: + ----- Method: Time class>>useHighResClockForTiming: (in category 'preferences') ----- + useHighResClockForTiming: booleanOrNil + + UseHighResClockForTiming := booleanOrNil.!

1 0

The Treated Inbox: Kernel-nice.1407.mcz
by commits＠source.squeak.org 21 Feb '23

21 Feb '23

Nicolas Cellier uploaded a new version of Kernel to project The Treated Inbox: http://source.squeak.org/treated/Kernel-nice.1407.mcz ==================== Summary ==================== Name: Kernel-nice.1407 Author: nice Time: 13 May 2021, 3:34:15.142602 pm UUID: c4b8ae2c-02a9-415b-bcf3-6628b8f9f8e7 Ancestors: Kernel-jar.1406 When simulating (for example via the debugger) correctly unwind the simulation machinery #ensure: block inserted by #runUntilErrorOrReturnFrom: Simulating #aboutToReturn:through: did jump to first unwind context. But this first unwind context was determined BEFORE the simulation #ensure: has been inserted. This had the effect of skipping the simulation machinery protection, and did result in a BlockCannotReturn (cannotReturn:) error... This did prevent the debugger to correctly debug a protected block with non local return like this: [^2] ensure: [Transcript cr; show: 'done']. Kudos to Jaromir for finding this! =============== Diff against Kernel-jar.1406 =============== Item was changed: ----- Method: Context>>return:from: (in category 'instruction decoding') ----- return: value from: aSender "For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self" | newTop | aSender isDead ifTrue: [^self send: #cannotReturn: to: self with: {value}]. newTop := aSender sender. (self findNextUnwindContextUpTo: newTop) ifNotNil: [:unwindProtectCtxt| + ^self send: #simulatedAboutToReturn:through: to: self with: {value. unwindProtectCtxt}]. - ^self send: #aboutToReturn:through: to: self with: {value. unwindProtectCtxt}]. self releaseTo: newTop. newTop ifNotNil: [newTop push: value]. ^newTop! Item was added: + ----- Method: Context>>simulatedAboutToReturn:through: (in category 'private') ----- + simulatedAboutToReturn: result through: firstUnwindContext + "This is the simulated version of #aboutToReturn:through: + Since the simulation machinery inserts its own ensure: block, we must unwind it first. + See #runUntilErrorOrReturnFrom:" + + self methodReturnContext + return: result + through: ((thisContext findNextUnwindContextUpTo: firstUnwindContext) ifNil: [firstUnwindContext])!

1 0

The Trunk: Tools-jar.1189.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-jar.1189.mcz ==================== Summary ==================== Name: Tools-jar.1189 Author: jar Time: 31 January 2023, 6:13:22.676927 pm UUID: 70af9ca9-39c5-3944-a8dc-84124e321288 Ancestors: Tools-mt.1188 fix a bug when doing stepInto; this fix makes the three methods #stepInto, #stepOver and #stepThrough consistent. Sending an example in a separate message. =============== Diff against Tools-mt.1188 =============== Item was changed: ----- Method: Debugger>>send (in category 'context stack menu') ----- send "Send the selected message in the accessed method, and take control in the method invoked to allow further step or send." + | newContext currentContext | self okToChange ifFalse: [^ self]. self interruptedProcessIsReady ifFalse: [^ self shouldNotStep]. self checkContextSelection. + currentContext := self selectedContext. + self handleLabelUpdatesIn: + [interruptedProcess step: currentContext] + whenExecuting: currentContext. - interruptedProcess step: self selectedContext. interruptedProcess ifNil: [^ self shouldNotStep]. + newContext := interruptedProcess stepToSendOrReturn. + self updateProcess. + self contextStackIndex > 1 + ifTrue: [self resetContext: newContext] + ifFalse: + [newContext == currentContext + ifTrue: [self changed: #contentsSelection. + self updateInspectors] + ifFalse: [self resetContext: newContext]]! - self resetContext: interruptedProcess stepToSendOrReturn.!

1 0

The Trunk: KernelTests-jar.443.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-jar.443.mcz ==================== Summary ==================== Name: KernelTests-jar.443 Author: jar Time: 30 January 2023, 5:33:22.893677 pm UUID: 4f815d5d-a166-d141-8fca-d9d0d57f0b93 Ancestors: KernelTests-tpr.441 Complement Kernel-jar.1498 =============== Diff against KernelTests-tpr.441 =============== Item was removed: - ----- Method: MutexTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ #(testUnwindMutexBlockedInCritical)! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWait2 (in category 'tests') ----- + testMutexAfterCriticalWait2 + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [lock critical: [beenHere := true]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty]. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitCf (in category 'tests') ----- + testMutexAfterCriticalWaitCf + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [lock critical: [beenHere := true]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate]. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitInEnsure (in category 'tests') ----- + testMutexAfterCriticalWaitInEnsure + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p | + lock := Mutex new. + p := [[] ensure: [lock critical: []]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty]. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate. + self deny: lock isOwned. + self assert: lock isEmpty! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitInEnsure2 (in category 'tests') ----- + testMutexAfterCriticalWaitInEnsure2 + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [[] ensure: [lock critical: [beenHere := true]]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty]. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self assert: beenHere! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitInEnsureCf (in category 'tests') ----- + testMutexAfterCriticalWaitInEnsureCf + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [[] ensure: [lock critical: [beenHere := true]]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate]. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCritical (in category 'tests') ----- + testMutexBlockedInCritical + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait | + lock := Mutex new. + sock := Semaphore new. + proc := [lock critical: [sock wait]] fork. + wait := [lock critical: []] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCritical2 (in category 'tests') ----- + testMutexBlockedInCritical2 + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [lock critical: [sock wait]] fork. + wait := [lock critical: [beenHere := true]. beenHereToo := true] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + self deny: beenHere. + self deny: beenHereToo. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCriticalInEnsure (in category 'tests') ----- + testMutexBlockedInCriticalInEnsure + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait | + lock := Mutex new. + sock := Semaphore new. + proc := [lock critical: [sock wait]] fork. + wait := [[] ensure: [lock critical: []]] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCriticalInEnsure2 (in category 'tests') ----- + testMutexBlockedInCriticalInEnsure2 + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [lock critical: [sock wait]] fork. + wait := [[] ensure: [lock critical: [beenHere := true]. beenHereToo := true]] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + self deny: beenHere. + self assert: beenHereToo. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexInCriticalWait2 (in category 'tests') ----- + testMutexInCriticalWait2 + "This tests whether a process that has got past the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unowned." + | lock sock proc beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [lock critical: [sock wait. beenHere := true]. beenHereToo := true] fork. + Processor yield. + self assert: proc suspendingList == sock. + proc terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere. + self deny: beenHereToo! Item was added: + ----- Method: MutexTest>>testMutexInCriticalWaitInEnsure (in category 'tests') ----- + testMutexInCriticalWaitInEnsure + "This tests whether a process that has got past the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unowned." + | lock sock proc | + lock := Mutex new. + sock := Semaphore new. + proc := [[] ensure: [lock critical: [sock wait]]] fork. + Processor yield. + self assert: proc suspendingList == sock. + proc terminate. + self deny: lock isOwned. + self assert: lock isEmpty! Item was added: + ----- Method: MutexTest>>testMutexInCriticalWaitInEnsure2 (in category 'tests') ----- + testMutexInCriticalWaitInEnsure2 + "This tests whether a process that has got past the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unowned." + | lock sock proc beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [[] ensure: [lock critical: [sock wait. beenHere := true]. beenHereToo := true]] fork. + Processor yield. + self assert: proc suspendingList == sock. + proc terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self assert: beenHere. + self assert: beenHereToo! Item was removed: - ----- Method: MutexTest>>testUnwindMutexBlockedInCritical (in category 'tests') ----- - testUnwindMutexBlockedInCritical "self run: #testMutexBlockedInCritical" - "This tests whether a mutex that is inside the primitiveEnterCriticalSection in Mutex>>critical: - leaves it unchanged." - | lock sock proc wait | - lock := Mutex new. - sock := Semaphore new. - proc := [lock critical: [sock wait]] fork. - wait := [[] ensure: [lock critical: []]] fork. - Processor yield. - self assert: proc suspendingList == sock. - self assert: wait suspendingList == lock. - self deny: lock isEmpty. - self assert: lock isOwned. - wait terminate. - Processor yield. - self assert: wait isTerminated. - self assert: proc suspendingList == sock. - self assert: wait suspendingList == nil. - self assert: lock isEmpty. - self assert: lock isOwned - ! Item was removed: - ----- Method: ProcessTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ #(testTerminateTerminatingProcess testResumeTerminatingProcess)! Item was changed: ----- Method: ProcessTest>>testResumeTerminatingProcess (in category 'tests') ----- testResumeTerminatingProcess + "An attempt to resume a terminating process in the middle of preparing its suspended context should raise an error; + one possible solution is to nil the suspended context of the terminating process while executing the vulnerable code" + + "Note: another solution could be to run the vulnerable part of the code in #terminate using #valueUnpreemptively; + currently, however, #valueUnpreemptively is affected by the #priority: bug described here: + http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217473…" - "An attempt to resume a terminating process should probably raise an error; - leave this test as an expected failure for the moment." + | terminatee terminator unwound | + unwound := false. + terminatee := [[Processor activeProcess suspend] ensure: [unwound := unwound not]] newProcess. + terminatee priority: Processor activePriority + 1. + terminatee resume. - | terminatee terminator resumed | - terminatee := [semaphore critical:[]. resumed := true] fork. - Processor yield. terminator := [terminatee terminate] newProcess. + terminator priority: Processor activePriority + 1. + self assert: terminatee isSuspended. - self assert: terminatee suspendingList == semaphore. self assert: terminator isSuspended. "run terminator and stop inside #terminate" + [terminator suspendedContext selectorToSendOrSelf == #bottomContext] whileFalse: [terminator step]. + self assert: terminatee suspendedContext isNil. + self deny: unwound. - terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:]. self assert: terminator isSuspended. + "resuming the terminatee process should causes the VM to raise an error while its suspended context is nil" - "resume the terminatee process and and check if the VM raises an error; - an error is expected because terminatee's suspendedContext equals nil" self should: [terminatee resume] raise: Error. + self assert: terminatee suspendedContext isNil. + self deny: unwound. + self assert: terminator isSuspended. + "now let the terminator finish its interrupted termination of the terminatee process" - "now let the terminator finish terminating the terminatee process" terminator resume. - Processor yield. - self assert: resumed isNil. self assert: terminatee isTerminated. + self assert: unwound. self assert: terminator isTerminated! Item was changed: ----- Method: ProcessTest>>testTerminateTerminatingProcess (in category 'tests') ----- testTerminateTerminatingProcess + "An attempt to terminate a terminating process in the middle of preparing its suspended context should do nothing; + one possible solution is to nil the suspended context of the terminating process while executing the vulnerable code." + + "Note: another solution could be to run the vulnerable part of the code in #terminate using #valueUnpreemptively; + currently, however, #valueUnpreemptively is affected by the #priority: bug described here: + http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217473…" - "An attempt to terminate a terminating process should probably raise an error; - leave this test as an expected failure for the moment." + | terminatee terminator unwound | + unwound := false. + terminatee := [[Processor activeProcess suspend] ensure: [unwound := unwound not]] newProcess. + terminatee priority: Processor activePriority + 1. + terminatee resume. - | terminatee terminator resumed | - terminatee := [semaphore critical:[]. resumed := true] fork. - Processor yield. terminator := [terminatee terminate] newProcess. + terminator priority: Processor activePriority + 1. + self assert: terminatee isSuspended. - self assert: terminatee suspendingList == semaphore. self assert: terminator isSuspended. "run terminator and stop inside #terminate" + [terminator suspendedContext selectorToSendOrSelf == #bottomContext] whileFalse: [terminator step]. + self assert: terminatee suspendedContext isNil. + self deny: unwound. - terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:]. self assert: terminator isSuspended. + "terminating the terminatee process again should make no difference while its suspended context is nil" + terminatee terminate. + self assert: terminatee suspendedContext isNil. + self deny: unwound. + self assert: terminator isSuspended. + "now let the terminator finish its interrupted termination of the terminatee process" - "terminate the terminatee process again and let the termination finish; - an error is expected because #terminate detected multiple termination" - self should: [terminatee terminate] raise: Error. - "now let the terminator finish terminating the terminatee process" terminator resume. - Processor yield. - self assert: resumed isNil. self assert: terminatee isTerminated. + self assert: unwound. self assert: terminator isTerminated! Item was added: + ----- Method: ProcessTest>>testTerminateTerminatingProcessBeforeUnwindTo (in category 'tests') ----- + testTerminateTerminatingProcessBeforeUnwindTo + "Terminating a terminatee process after the terminator process restarted the terminatee + process should unwind the terminatee process and let the terminator process terminate." + + | terminator terminatee unwound | + unwound := false. + terminatee := [[Semaphore new wait] ensure: [unwound := true]] fork. + Processor yield. + terminator := [terminatee terminate] newProcess. + self assert: terminatee isBlocked. + self assert: terminator isSuspended. + terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #resume]. + "terminator steps until terminatee's unwind context is set" + terminator suspendedContext nextInstruction. "skip terminatee resume instruction" + terminator resume. "and run until parked at wait" + "terminatee is inside its helper stack, about to call #unwindTo:" + self assert: terminatee isSuspended. + terminatee terminate. + self assert: terminatee isTerminated. + self assert: unwound. + Processor yield. + self assert: terminator isTerminated! Item was removed: - ----- Method: SemaphoreTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ #(testUnwindSemaInCriticalWait)! Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWait2 (in category 'tests') ----- + testSemaAfterCriticalWait2 + "This tests whether a process that has just left the wait in Semaphore>>critical: + leaves it with signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [s critical: [beenHere := true]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse: [(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + p terminate. + self assert: 1 equals: s excessSignals. + self deny: beenHere! Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWaitInEnsure (in category 'tests') ----- + testSemaAfterCriticalWaitInEnsure + "This tests whether a process that has just left the wait in Semaphore>>critical: + leaves it with signaling the associated semaphore." + | s p | + s := Semaphore new. + p := [[] ensure: [s critical:[]]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse: [(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + p terminate. + self assert: 1 equals: s excessSignals! Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWaitInEnsure2 (in category 'tests') ----- + testSemaAfterCriticalWaitInEnsure2 + "This tests whether a process that has just left the wait in Semaphore>>critical: + leaves it with signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [[] ensure: [s critical: [beenHere := true]]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse: [(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + p terminate. + self assert: 1 equals: s excessSignals. + self assert: beenHere! Item was added: + ----- Method: SemaphoreTest>>testSemaInCriticalWait2 (in category 'tests') ----- + testSemaInCriticalWait2 + "This tests whether a process that has entered the wait in Semaphore>>critical: + leaves it without signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [s critical: [beenHere := true]] fork. + Processor yield. + self assert: s equals: p suspendingList. + p terminate. + self assert: 0 equals: s excessSignals. + self deny: beenHere! Item was added: + ----- Method: SemaphoreTest>>testSemaInCriticalWaitInEnsure (in category 'tests') ----- + testSemaInCriticalWaitInEnsure + "This tests whether a process that has entered the wait in Semaphore>>critical: + leaves it without signaling the associated semaphore." + | s p | + s := Semaphore new. + p := [[] ensure: [s critical: []]] fork. + Processor yield. + self assert: s equals: p suspendingList. + p terminate. + self assert: 0 equals: s excessSignals! Item was added: + ----- Method: SemaphoreTest>>testSemaInCriticalWaitInEnsure2 (in category 'tests') ----- + testSemaInCriticalWaitInEnsure2 + "This tests whether a process that has entered the wait in Semaphore>>critical: + leaves it without signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [[] ensure: [s critical: [beenHere := true]]] fork. + Processor yield. + self assert: s equals: p suspendingList. + p terminate. + self assert: 0 equals: s excessSignals. + self deny: beenHere! Item was removed: - ----- Method: SemaphoreTest>>testUnwindSemaInCriticalWait (in category 'tests') ----- - testUnwindSemaInCriticalWait "self run: #testSemaInCriticalWait" - "This tests whether a semaphore that has entered the wait in Semaphore>>critical: - leaves it without signaling the associated semaphore." - | s p | - s := Semaphore new. - p := [[] ensure: [s critical:[]]] fork. - Processor yield. - self assert:(p suspendingList == s). - p terminate. - self assert: 0 equals: s excessSignals!

1 0

The Trunk: KernelTests-jar.442.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-jar.442.mcz ==================== Summary ==================== Name: KernelTests-jar.442 Author: jar Time: 26 January 2023, 10:37:59.494205 pm UUID: d69aa3b9-4497-6840-935d-1be1ea5f6b80 Ancestors: KernelTests-tpr.441 add setUp and tearDown methods to MonitorTest class to prevent tests from leaving unterminated (blocked on a semaphore) processes behind =============== Diff against KernelTests-tpr.441 =============== Item was changed: TestCase subclass: #MonitorTest + instanceVariableNames: 'semaphore' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'KernelTests-Processes'! Item was added: + ----- Method: MonitorTest>>setUp (in category 'as yet unclassified') ----- + setUp + + super setUp. + semaphore := Semaphore new.! Item was added: + ----- Method: MonitorTest>>tearDown (in category 'as yet unclassified') ----- + tearDown + "Release all processes still waiting at the semaphore or in the active priority queue." + + Processor yield. + [semaphore isEmpty] whileFalse: [semaphore signal]. + + super tearDown.! Item was changed: ----- Method: MonitorTest>>testCheckOwnerProcess (in category 'tests') ----- testCheckOwnerProcess self should: [Monitor new checkOwnerProcess] raise: Error. self shouldnt: [| m | m := Monitor new. m critical: [m checkOwnerProcess]] raise: Error. self should: [| s m | m := Monitor new. + [m critical: [s := #in. semaphore wait]] fork. - [m critical: [s := #in. Semaphore new wait]] fork. Processor yield. self assert: #in equals: s. m checkOwnerProcess] raise: Error! Item was changed: ----- Method: MonitorTest>>testCriticalIfLocked (in category 'tests') ----- testCriticalIfLocked | m s | m := Monitor new. self assert: #unlocked == (m critical: [#unlocked] ifLocked: [#locked]). + [m critical: [s := #in. semaphore wait]] fork. - [m critical: [s := #in. Semaphore new wait]] fork. Processor yield. self assert: #in equals: s. self assert: #locked equals: (m critical: [#unlocked] ifLocked: [#locked])!

1 0

The Trunk: Kernel-jar.1503.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-jar.1503.mcz ==================== Summary ==================== Name: Kernel-jar.1503 Author: jar Time: 15 February 2023, 5:20:15.299287 pm UUID: 63fd8775-0f3d-7f49-93f3-a116e9fbb3d5 Ancestors: Kernel-eem.1498 remove unwind code duplication and fix the "stepOver bug" (Cannot #stepOver '^2' in example '[^2] ensure: []') See http://lists.squeakfoundation.org/pipermail/squeak-dev/2023-February/223443… for detailed explanation =============== Diff against Kernel-eem.1498 =============== Item was changed: ----- Method: Context>>restart (in category 'controlling') ----- restart "Unwind thisContext to self and resume from beginning. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" + ^self resumeEvaluating: [self privRefresh]! - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: nil to: self]. - self privRefresh. - ctxt := thisContext. - [ ctxt := ctxt findNextUnwindContextUpTo: self. - ctxt isNil - ] whileFalse: [ - (ctxt tempAt: 2) ifNil:[ - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ]. - thisContext terminateTo: self. - self jump. - ! Item was changed: ----- Method: Context>>resume:through: (in category 'controlling') ----- resume: value through: firstUnwindCtxt "Unwind thisContext to self and resume with value as result of last send. Execute any unwind blocks while unwinding. ASSUMES self is a sender of thisContext." + ^self resumeEvaluating: [value] through: firstUnwindCtxt! - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: value to: self]. - ctxt := firstUnwindCtxt. - [ctxt isNil] whileFalse: - [(ctxt tempAt: 2) ifNil: - [ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ctxt := ctxt findNextUnwindContextUpTo: self]. - thisContext terminateTo: self. - ^value - ! Item was changed: ----- Method: Context>>resumeEvaluating: (in category 'controlling') ----- resumeEvaluating: aBlock "Unwind thisContext to self and resume with value as result of last send. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" + ^self resumeEvaluating: aBlock through: nil! - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: aBlock value to: self]. - ctxt := thisContext. - [ ctxt := ctxt findNextUnwindContextUpTo: self. - ctxt isNil - ] whileFalse: [ - (ctxt tempAt: 2) ifNil:[ - "(tempAt: 2) refers to complete temporary in ensure: and ifCurtailed: - or any other method marked with <primitive: 198>" - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ]. - thisContext terminateTo: self. - ^ aBlock value - ! Item was added: + ----- Method: Context>>resumeEvaluating:through: (in category 'controlling') ----- + resumeEvaluating: aBlock through: firstUnwindCtxtOrNil + "Unwind thisContext to self and resume with value as result of last send. + Execute unwind blocks when unwinding. + ASSUMES self is a sender of thisContext." + + self isDead ifTrue: [self cannotReturn: aBlock value to: self]. + (firstUnwindCtxtOrNil ifNil: thisContext) unwindTo: self safely: false. + thisContext terminateTo: self. + ^aBlock value! Item was changed: ----- Method: Context>>return:from: (in category 'instruction decoding') ----- return: value from: aSender "For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self" | newTop | aSender isDead ifTrue: [^self send: #cannotReturn: to: self with: {value}]. newTop := aSender sender. (self findNextUnwindContextUpTo: newTop) ifNotNil: + "Send #aboutToReturn:through: with nil as the second argument to avoid this bug: + Cannot #stepOver '^2' in example '[^2] ensure: []'. - [:unwindProtectCtxt| - self flag: #knownBug. "Cannot #stepOver '^2' in example '[^2] ensure: []'. See http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-June/220975.html" + [^self send: #aboutToReturn:through: to: self with: {value. nil}]. - ^self send: #aboutToReturn:through: to: self with: {value. unwindProtectCtxt}]. self releaseTo: newTop. newTop ifNotNil: [newTop push: value]. ^newTop!

1 0

The Trunk: Kernel-jar.1502.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-jar.1502.mcz ==================== Summary ==================== Name: Kernel-jar.1502 Author: jar Time: 15 February 2023, 4:58:07.875244 pm UUID: 14e0c30b-c6a4-7a4f-b869-3cc2e605eef6 Ancestors: Kernel-eem.1498 make Context #methodReturnContexts a synonym of #home; make BlockClosure and FullBlockClosure #homeMethod synonyms of #method (current code makes it rather difficult to realize #homeMethod and #method are actually synonymous) =============== Diff against Kernel-eem.1498 =============== Item was changed: ----- Method: BlockClosure>>homeMethod (in category 'accessing') ----- homeMethod + "Answer the home method associated with the receiver. + This is polymorphic with BlockClosure, CompiledCode, Context etc." + + ^self method! - ^outerContext method! Item was removed: - ----- Method: CompiledBlock>>homeMethod (in category 'accessing') ----- - homeMethod - "answer the compiled method that I am installed in, or nil if none." - ^self outerCode homeMethod! Item was changed: ----- Method: CompiledCode>>homeMethod (in category 'accessing') ----- homeMethod + "Answer the home method associated with the receiver. + This is polymorphic with BlockClosure, CompiledCode, Context etc." - "Answer the home method associated with the receiver." + ^self method! - ^self subclassResponsibility! Item was removed: - ----- Method: CompiledMethod>>homeMethod (in category 'accessing') ----- - homeMethod - "Answer the home method associated with the receiver. - This is polymorphic with closure, CompiledBlock, Context etc" - - ^self! Item was changed: ----- Method: Context>>homeMethod (in category 'accessing') ----- homeMethod "Answer the home method associated with the receiver. + This is polymorphic with BlockClosure, CompiledCode, Context etc." + + ^self method! - This is polymorphic with BlockClosure, CompiledCode, etc" - ^method homeMethod! Item was changed: ----- Method: Context>>methodReturnContext (in category 'accessing') ----- methodReturnContext "Answer the context from which an ^-return should return from." + ^self home! - closureOrNil == nil ifTrue: - [^self]. - ^closureOrNil outerContext methodReturnContext! Item was removed: - ----- Method: FullBlockClosure>>homeMethod (in category 'accessing') ----- - homeMethod - ^startpcOrMethod homeMethod!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages February 2023