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!
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])!
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!
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!