A new version of PromisesTests was added to project The Inbox:
http://source.squeak.org/inbox/PromisesTests-rww.10.mcz

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

Name: PromisesTests-rww.10
Author: rww
Time: 4 October 2020, 12:01:59.781672 pm
UUID: 380cc875-64e7-41a3-ad9e-93cb54eeb338
Ancestors: PromisesTests-rww.9

calls includesKey:

==================== Snapshot ====================

SystemOrganization addCategory: #PromisesTests!

----- Method: Promise>>isFulfilled (in category '*promisestests') -----
isFulfilled

	^ state == #fulfilled.!

----- Method: Promise>>isResolved (in category '*promisestests') -----
isResolved

	^ self isFulfilled or: [self isRejected]!

----- Method: Promise>>rejectWith: (in category '*promisestests') -----
rejectWith: anObject
	"Reject this promise."
	| exception |
	mutex critical: [
		exception := (anObject isKindOf: Exception)
			ifTrue: [anObject]
			ifFalse: [BrokenPromiseValue value: anObject].
		(state == #pending) 
			ifTrue: [ | worklist |
				error := exception.
				state := #rejected.
				worklist := rejecters.
				resolvers := #().
				rejecters := #().
				worklist do: [:r | self evaluateRejecter: r]]
			ifFalse: [PromiseAlreadyResolved new signal]]!

----- Method: Promise>>resolveWith: (in category '*promisestests') -----
resolveWith: arg
	"Resolve this promise. If arg is itself a Promise, make this promise depend upon it,
	as detailed in the Promises/A+ spec:
		https://promisesaplus.com/#the-promise-resolution-procedure"

	arg isPromise
		ifTrue: [
			arg whenResolved: [:v | self resolveWith: v].
			arg whenRejected: [:e | self rejectWith: e]]
		ifFalse: [
			mutex critical: [
				(arg isKindOf: Error)
					ifTrue: [^ self rejectWith: arg].
				(state == #pending) 
					ifTrue: [ | worklist |
						value := arg.
						state := #fulfilled.
						worklist := resolvers.
						resolvers := #().
						rejecters := #().
						worklist do: [:r | self evaluateResolver: r]]
					ifFalse: [PromiseAlreadyResolved new signal]]]!

----- Method: Promise>>wait (in category '*promisestests') -----
wait
	"Wait unconditionally for this promise to become fulfilled or rejected."
	| sema |
	sema := Semaphore new.
	self whenResolved:[sema signal].
	self whenRejected:[sema signal].
	sema wait.
	^ self isFulfilled
		ifTrue: [ value ]
		ifFalse: [ self isRejected
			ifTrue: [ self error signal ]
			ifFalse: [ self ]]!

----- Method: Promise>>waitTimeoutMSecs: (in category '*promisestests') -----
waitTimeoutMSecs: msecs
	"Wait for at most the given number of milliseconds for this promise to settle.
	Answer true if it is resolved, false otherwise. False can therefore mean EITHER 'timeout' OR 'rejected'."
	| sema delay |
	sema := Semaphore new.
	self whenResolved: [sema signal].
	self whenRejected: [sema signal].
	delay := Delay timeoutSemaphore: sema afterMSecs: msecs.
	[sema wait] ensure: [delay unschedule].
	^ self isFulfilled
		ifTrue: [ value ]
		ifFalse: [ self isRejected
			ifTrue: [ self error signal ]
			ifFalse: [ self ]]!

----- Method: PromiseTest>>privateTestNilErrBlockPropagationResolvedReactorEvaluated (in category '*promisestests') -----
privateTestNilErrBlockPropagationResolvedReactorEvaluated

	"https://promisesaplus.com section 2.2.7.4"
	| p q |
	p := Promise new.
	q := p then: [:v | self error: 'Shouldn''t call resolvedBlock'] ifRejected: nil.
	p rejectWith: 1.
	self should: [q waitTimeoutMSecs: 1] raise: Error.
	self assert: p isRejected.
	self assert: q isRejected.
	self assert: p error class equals: BrokenPromiseValue.
	self assert: q error class equals: Error.
	self assert: p error value equals: 1.
!

----- Method: PromiseTest>>privateTestNilErrBlockPropagationResolvedReactorNotEvaluated (in category '*promisestests') -----
privateTestNilErrBlockPropagationResolvedReactorNotEvaluated

	"https://promisesaplus.com section 2.2.7.4"
	| p q |
	p := Promise new.
	q := p then: [:v | self error: 'Shouldn''t call resolvedBlock'] ifRejected: nil.
	p rejectWith: 1.
	self should: [q waitTimeoutMSecs: 1] raise: Error.
	self assert: p isRejected.
	self assert: q isRejected.
	self assert: p error class equals: BrokenPromiseValue.
	self assert: q error class equals: BrokenPromiseValue.
	self assert: p error value equals: 1.
	self assert: q error value equals: 1.!

----- Method: PromiseTest>>testAnErrorInOnRejectedRejectsPromise (in category '*promisestests') -----
testAnErrorInOnRejectedRejectsPromise
	"https://promisesaplus.com section 2.2.7.2"
	| p q error |
	p := Promise new.
	q := p ifRejected: [:e | (error := KeyNotFound new) signal].
	p rejectWith: 1.
	self should: [q waitTimeoutMSecs: 1] raise: KeyNotFound.
	self assert: p isRejected description: 'Original Promise not rejected'.
	self assert: q isRejected description: 'Broken Promise not rejected'.
	self assert: p error class = BrokenPromiseValue.
	self assert: q error class = KeyNotFound.
	self assert: p error value == 1.
	self assert: q error == error.!

----- Method: PromiseTest>>testAnErrorInThenRejectsPromise (in category '*promisestests') -----
testAnErrorInThenRejectsPromise
	"https://promisesaplus.com section 2.2.7.2"
	| p q error |
	p := Promise new.
	q := p then: [:v | (error := KeyNotFound new) signal].
	p resolveWith: 1.
	self should: [q waitTimeoutMSecs: 1] raise: KeyNotFound.
	self deny: p isRejected description: 'Original Promise rejected'.
	self assert: q isRejected description: 'Broken Promise not rejected'.
	self assert: p value = 1.
	self assert: q error == error.!

----- Method: PromiseTest>>testCannotRejectFulfilledPromise (in category '*promisestests') -----
testCannotRejectFulfilledPromise
	| p |
	p := Promise unit: 1.
	self should: [p rejectWith: Error new] raise: PromiseAlreadyResolved.
	self assert: p isResolved.
	self assert: 1 equals: p value.
!

----- Method: PromiseTest>>testCannotResolveaRejectedPromise (in category '*promisestests') -----
testCannotResolveaRejectedPromise
	| p e |
	p := Promise new.
	e := Error new.
	p rejectWith: e.
	self should: [p resolveWith: 1] raise: PromiseAlreadyResolved.
	self assert: p isRejected.
	self assert: p error == e.
!

----- Method: PromiseTest>>testChainedResolvers (in category '*promisestests') -----
testChainedResolvers
	| promise1 promise2 result |
	promise1 := Promise new.
	promise2 := Promise new.
	promise1 whenResolved: [:bool | promise2 resolveWith: bool not].
	promise2 whenResolved: [:bool | result := bool].
	promise1 resolveWith: false.
	promise2 waitTimeoutMSecs: 10.
	self should: [result].!

----- Method: PromiseTest>>testCollapsesChainsOfPromises (in category '*promisestests') -----
testCollapsesChainsOfPromises
	"The monadic bind operator has signature (m a -> (a -> m b) -> m b): that is, in our setting,
	the block given to `then:` is expected to return a *Promise* of a value, not a value directly.
	It is convenient to accept non-promise values and automatically lift them into the monad,
	but we must also ensure we treat the case where a `then:`-block yields a Promise correctly."
	| p q r |
	p := Promise new.
	q := p then: [:v | Promise unit: v * 2].
	r := q then: [:v | Promise unit: v + 1].
	p resolveWith: 4.
	q waitTimeoutMSecs: 1.
	r waitTimeoutMSecs: 1.
	self assert: 4 * 2 equals: q value.
	self assert: (4 * 2 + 1) equals: r value.!

----- Method: PromiseTest>>testFirstResolutionWins (in category '*promisestests') -----
testFirstResolutionWins
	| p |
	p := Promise new.
	p resolveWith: 1.
	self should: [p resolveWith: 2] raise: PromiseAlreadyResolved.
	self assert: p isResolved.
	self assert: p value == 1.
!

----- Method: PromiseTest>>testMultipleResolvers (in category '*promisestests') -----
testMultipleResolvers

	| promise sum |
	sum := 0.
	promise := Promise new.
	5 timesRepeat: [
		promise whenResolved: [:val | sum := sum + val].
	].
	promise resolveWith: 5.
	(Delay forMilliseconds: 3) wait.
	self should: [sum = 25].!

----- Method: PromiseTest>>testNilErrBlockPropagation (in category '*promisestests') -----
testNilErrBlockPropagation

	"https://promisesaplus.com section 2.2.7.4"
	(Smalltalk includesKey: #PriorityVat)
		ifTrue: [self privateTestNilErrBlockPropagationResolvedReactorEvaluated]
		ifFalse: [self privateTestNilErrBlockPropagationResolvedReactorNotEvaluated].!

----- Method: PromiseTest>>testNilResolvedBlockPropagation (in category '*promisestests') -----
testNilResolvedBlockPropagation

	"https://promisesaplus.com section 2.2.7.3"
	| p q |
	p := Promise new.
	q := p then: nil ifRejected: [:e | self error: 'Shouldn''t call errBlock'].
	p resolveWith: 1.
	q waitTimeoutMSecs: 1..
	self assert: p isResolved.
	self assert: q isResolved.
	self assert: p value equals: 1.
	self assert: q value equals: 1.!

----- Method: PromiseTest>>testRejectWithInvokesErrorHandlers (in category '*promisestests') -----
testRejectWithInvokesErrorHandlers
	| p error returnedError |
	returnedError := nil.
	error := KeyNotFound new.
	p := Promise ifRejected: [:e | returnedError := e].
	p rejectWith: error.
	(Delay forMilliseconds: 1) wait.
	self assert: returnedError notNil description: 'Error block did not run.'.
	self assert: error equals: returnedError description: 'Error not passed into block'.
	self assert: error equals: p error description: 'Promise didn''t store error'.!

----- Method: PromiseTest>>testSingleResolver (in category '*promisestests') -----
testSingleResolver

	| promise sum |
	sum := 0.
	promise := Promise new.
	promise whenResolved: [:val | sum := sum + val].
	promise resolveWith: 5.
	(Delay forMilliseconds: 1) wait.
	self assert: 5 equals: sum.
	!

----- Method: PromiseTest>>testThenPermitsChainingOfPromises (in category '*promisestests') -----
testThenPermitsChainingOfPromises
	| p q r |
	p := Promise new.
	q := p then: [:v | v * 2].
	r := q then: [:v | v + 1].
	p resolveWith: 4.
	q waitTimeoutMSecs: 1.
	r waitTimeoutMSecs: 1.
	self assert: 4 * 2 equals: q value.
	self assert: (4 * 2 + 1) equals: r value.!

----- Method: PromiseTest>>testTimeout (in category '*promisestests') -----
testTimeout
	| promise |
	promise := Promise new.
	self should: [(promise waitTimeoutMSecs: 1) isPromise].
	self shouldnt: [promise isResolved].
	self shouldnt: [promise isRejected].
	promise resolveWith: 45.
	self should: [(promise waitTimeoutMSecs: 1) == 45].
	self should: [promise isResolved].
	self shouldnt: [promise isRejected].!

----- Method: PromiseTest>>testTimeoutRejected (in category '*promisestests') -----
testTimeoutRejected
	| promise |
	promise := Promise new.
	self should: [(promise waitTimeoutMSecs: 1) isPromise].
	self shouldnt: [promise isFulfilled].
	self shouldnt: [promise isResolved].
	self shouldnt: [promise isRejected].
	promise rejectWith: 45.
	self should: [promise waitTimeoutMSecs: 1] raise: BrokenPromiseValue.
	self shouldnt: [promise isFulfilled].
	self should: [promise isResolved].
	self should: [promise isRejected].!

----- Method: PromiseTest>>testUnitReturnsaPromise (in category '*promisestests') -----
testUnitReturnsaPromise
	| p |
	p := Promise unit: 1.
	self assert: p isResolved.!

----- Method: PromiseTest>>testWaitForRejection (in category '*promisestests') -----
testWaitForRejection
	| p |
	p := Promise new.
	[ (Delay forMilliseconds: 1) wait. p rejectWith: Error new ] fork.
	self should: [ p wait ] raise: Error.
!

----- Method: PromiseTest>>testWaitForResolution (in category '*promisestests') -----
testWaitForResolution
	| p |
	p := Promise new.
	[ (Delay forMilliseconds: 1) wait. p resolveWith: #ok ] fork.
	p waitTimeoutMSecs: 3.
	self assert: [ p wait = #ok ]!

----- Method: PromiseTest>>testWaitRejectionYieldsCorrectBrokenPromise (in category '*promisestests') -----
testWaitRejectionYieldsCorrectBrokenPromise
	| p error |
	p := Promise new.
	[ (Delay forMilliseconds: 1) wait. p rejectWith: (error := Error new) ] fork.
	self should: [p wait] raise: Error.
	[ p wait ] on: Error do: [ :bp | ^ self assert: [ bp == error ] ].
	self fail: 'Should not reach this point'!

----- Method: PromiseTest>>testifRejectedRunsBlockIfPromiseFails (in category '*promisestests') -----
testifRejectedRunsBlockIfPromiseFails
	"https://promisesaplus.com section 2.2.7.1"
	| p q error |
	error := nil.
	p := Promise new.
	q := p ifRejected: [:e | error := e "N.B. returns a value, does not signal an Exception"].
	p rejectWith: KeyNotFound new.
	self should: [q waitTimeoutMSecs: 1] raise: KeyNotFound.
	self assert: q isResolved.
	self assert: q isRejected.
	self assert: KeyNotFound equals: error class.
	self assert: q error == error.!

Error subclass: #BrokenPromiseValue
	instanceVariableNames: 'value'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PromisesTests'!

----- Method: BrokenPromiseValue class>>value: (in category 'instance creation') -----
value: obj

	^ self new
		value: obj;
		yourself!

----- Method: BrokenPromiseValue>>defaultAction (in category 'handling') -----
defaultAction

	self messageText: 'Promise was rejected with value: ', value.
	^super defaultAction!

----- Method: BrokenPromiseValue>>isResumable (in category 'handling') -----
isResumable

	^ true!

----- Method: BrokenPromiseValue>>value (in category 'accessing') -----
value

	^ value.!

----- Method: BrokenPromiseValue>>value: (in category 'accessing') -----
value: anObject

	value := anObject.!

Error subclass: #PromiseAlreadyResolved
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PromisesTests'!