Smalltalk › Squeak › Squeak - Dev

The Inbox: PromisesLocal-rww.20.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

The Inbox: PromisesLocal-rww.20.mcz

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

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

Name: PromisesLocal-rww.20
Author: rww
Time: 4 October 2020, 10:43:29.453407 am
UUID: ff0cd0f9-170e-4cfb-b64a-47a1b0446903
Ancestors: PromisesLocal-rww.19

use eventual sending to handle nil blocks, both the #then: block and the #ifRejected: block

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

SystemOrganization addCategory: #PromisesLocal!
SystemOrganization addCategory: #'PromisesLocal-Testing'!

Object subclass: #AbstractEventual
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: AbstractEventual class>>broken: (in category 'promises') -----
broken: error
"self broken: Error new"

^ BrokenEventual new
exception: error;
yourself!

----- Method: AbstractEventual class>>isReference: (in category 'resolution') -----
isReference: object

^ object class includesBehavior: AbstractEventual
!

----- Method: AbstractEventual class>>promise (in category 'promises') -----
promise
"self promise"

^ self promiseInVat: self vat.
!

----- Method: AbstractEventual class>>promiseClass (in category 'promises') -----
promiseClass

^ Promise !

----- Method: AbstractEventual class>>promiseInVat: (in category 'promises') -----
promiseInVat: aVat
"self promise"

| promise buf |
buf := OrderedCollection new: 0.
promise := self promiseClass newOnBuffer: buf vat: aVat.
^ Association key: promise value: promise resolver

!

----- Method: AbstractEventual class>>refDescriptionString (in category 'accessing') -----
refDescriptionString

^ 'eventual'!

----- Method: AbstractEventual class>>resolution: (in category 'immediate') -----
resolution: obj

^ obj!

----- Method: AbstractEventual class>>resolverClass (in category 'promises') -----
resolverClass

^ LocalResolver !

----- Method: AbstractEventual class>>toReferenceContext: (in category 'resolution') -----
toReferenceContext: value

^ self toReferenceContext: value vat: self vat.
!

----- Method: AbstractEventual class>>toReferenceContext:vat: (in category 'resolution') -----
toReferenceContext: value vat: vat

(self isReference: value)
ifTrue: [^ value].
(value isKindOf: Exception)
ifTrue: [^ AbstractEventual broken: value]
ifFalse: [^ NearEventual newOn: value vat: vat.].
!

----- Method: AbstractEventual>>at: (in category 'overrides') -----
at: index

| pair |
pair := AbstractEventual promiseInVat: self vat.
self redirectEventualMessage: (EventualMessageSend
message: (Message selector: #at: argument: index)
resolver: pair value).
^ pair key
!

----- Method: AbstractEventual>>at:put: (in category 'overrides') -----
at: index put: value

| pair |
pair := AbstractEventual promiseInVat: self vat.
self redirectEventualMessage: (EventualMessageSend
message: (Message selector: #at:put: arguments: {index. value})
resolver: pair value).
^ pair key
!

----- Method: AbstractEventual>>becomeContext: (in category 'messaging') -----
becomeContext: context

self becomeForward: context.
!

----- Method: AbstractEventual>>doesNotUnderstand: (in category 'messaging') -----
doesNotUnderstand: aMessage

^ self redirectMessage: aMessage
!

----- Method: AbstractEventual>>eventual (in category 'accessing') -----
eventual

^ self!

----- Method: AbstractEventual>>eventualInVat: (in category 'accessing') -----
eventualInVat: aVat

^ self
!

----- Method: AbstractEventual>>isEventual (in category 'testing') -----
isEventual

^ true!

----- Method: AbstractEventual>>isFulfilled (in category 'testing') -----
isFulfilled

^ false!

----- Method: AbstractEventual>>isInteger (in category 'overrides') -----
isInteger

| pair |
pair := AbstractEventual promiseInVat: self vat.
self redirectEventualMessage: (EventualMessageSend
message: (Message selector: #isInteger)
resolver: pair value).
^ pair key
!

----- Method: AbstractEventual>>isLocal (in category 'testing') -----
isLocal

^ true!

----- Method: AbstractEventual>>isNear (in category 'testing') -----
isNear

^ true!

----- Method: AbstractEventual>>isPassByConstruction (in category 'testing') -----
isPassByConstruction

^ false!

----- Method: AbstractEventual>>isPassByProxy (in category 'testing') -----
isPassByProxy

^ true!

----- Method: AbstractEventual>>isRejected (in category 'testing') -----
isRejected

^ false!

----- Method: AbstractEventual>>isRemote (in category 'testing') -----
isRemote

^ false!

----- Method: AbstractEventual>>isResolved (in category 'testing') -----
isResolved

^ false!

----- Method: AbstractEventual>>mustBeBoolean (in category 'messaging') -----
mustBeBoolean

| context |
context := thisContext sender.
self resolution.
context skipBackBeforeJump.
^ true!

----- Method: AbstractEventual>>printOn: (in category 'printing') -----
printOn: stream

stream
nextPutAll: self class name;
nextPutAll: '::';
nextPutAll: self refDescriptionString;
nextPutAll: '('.
self vat printOn: stream.
stream nextPutAll: ')'.

!

----- Method: AbstractEventual>>redirectMessage: (in category 'messaging') -----
redirectMessage: aMessage

| pair |
pair := AbstractEventual promiseInVat: self vat.
self redirectEventualMessage: (EventualMessageSend message: aMessage resolver: pair value).
^ pair key

!

----- Method: AbstractEventual>>redirectMessageOneWay: (in category 'messaging') -----
redirectMessageOneWay: aMessage

self redirectEventualMessage: (EventualMessageSend message: aMessage).
^ nil
!

----- Method: AbstractEventual>>refDescriptionString (in category 'printing') -----
refDescriptionString

^ self class refDescriptionString
!

----- Method: AbstractEventual>>rejectWith: (in category 'Promise/A+ protocol') -----
rejectWith: reason

self subclassResponsibility!

----- Method: AbstractEventual>>resolution (in category 'accessing') -----
resolution

^ self!

----- Method: AbstractEventual>>resolveWith: (in category 'Promise/A+ protocol') -----
resolveWith: arg

self subclassResponsibility!

----- Method: AbstractEventual>>send: (in category 'eventual sending') -----
send: selector

| pair |
pair := AbstractEventual promiseInVat: self vat.
self redirectEventualMessage: (EventualMessageSend selector: selector resolver: pair value).
^ pair key
!

----- Method: AbstractEventual>>send:args: (in category 'eventual sending') -----
send: selector args: args

| pair |
pair := AbstractEventual promiseInVat: self vat.
self redirectEventualMessage: (EventualMessageSend selector: selector arguments: args resolver: pair value).
^ pair key
!

----- Method: AbstractEventual>>sendOneWay: (in category 'eventual sending') -----
sendOneWay: selector

self redirectEventualMessage: (EventualMessageSend selector: selector).
^ nil
!

----- Method: AbstractEventual>>sendOneWay:args: (in category 'eventual sending') -----
sendOneWay: selector args: args

self redirectEventualMessage: (EventualMessageSend selector: selector arguments: args).
^ nil
!

----- Method: AbstractEventual>>wait (in category 'waiting') -----
wait
"Wait unconditionally for this promise to become fulfilled or rejected."
PromiseWaiter waitTimeoutMSecs: 1000 onPromise: self.
^ self resolution.!

----- Method: AbstractEventual>>waitTimeoutMSecs: (in category 'waiting') -----
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'."

PromiseWaiter waitTimeoutMSecs: msecs onPromise: self.
^ self resolution.!

----- Method: AbstractEventual>>waitTimeoutSeconds: (in category 'waiting') -----
waitTimeoutSeconds: secs
"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'."

PromiseWaiter waitTimeoutSeconds: secs onPromise: self.
^ self resolution.!

AbstractEventual subclass: #BrokenEventual
instanceVariableNames: 'exception'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: BrokenEventual class>>refDescriptionString (in category 'accessing') -----
refDescriptionString

^ 'broken'
!

----- Method: BrokenEventual>>becomeContext: (in category 'messaging') -----
becomeContext: ref

^ self error: 'not switchable'!

----- Method: BrokenEventual>>doesNotUnderstand: (in category 'messaging') -----
doesNotUnderstand: aMessage

^ self exception signal!

----- Method: BrokenEventual>>error (in category 'accessing') -----
error

^ self exception!

----- Method: BrokenEventual>>exception (in category 'accessing') -----
exception

^exception!

----- Method: BrokenEventual>>exception: (in category 'accessing') -----
exception: anException

exception := anException!

----- Method: BrokenEventual>>isBroken (in category 'testing') -----
isBroken

^ true!

----- Method: BrokenEventual>>isRejected (in category 'testing') -----
isRejected

^ true!

----- Method: BrokenEventual>>isResolved (in category 'testing') -----
isResolved

^ true!

----- Method: BrokenEventual>>printOn: (in category 'printing') -----
printOn: stream

super printOn: stream.
stream
nextPutAll: '{';
nextPutAll: self exception description;
nextPutAll: '}'.
!

----- Method: BrokenEventual>>redirectEventualMessage: (in category 'messaging') -----
redirectEventualMessage: anEventualMessage

anEventualMessage receiver: exception.
self vat schedule: anEventualMessage.
!

----- Method: BrokenEventual>>rejectWith: (in category 'Promise/A+ protocol') -----
rejectWith: arg

PromiseAlreadyResolved new signal.
!

----- Method: BrokenEventual>>resolution (in category 'Promise/A+ protocol') -----
resolution

^ exception signal!

----- Method: BrokenEventual>>resolveWith: (in category 'Promise/A+ protocol') -----
resolveWith: arg

PromiseAlreadyResolved new signal.
!

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

^ exception!

AbstractEventual subclass: #NearEventual
instanceVariableNames: 'vat value'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: NearEventual class>>newOn: (in category 'instance creation') -----
newOn: anObject

^ self newOn: anObject vat: anObject vat.
!

----- Method: NearEventual class>>newOn:vat: (in category 'instance creation') -----
newOn: anObject vat: vat

^ self new
initializeOnTarget: anObject vat: vat;
yourself.
!

----- Method: NearEventual class>>refDescriptionString (in category 'accessing') -----
refDescriptionString

^ 'near'!

----- Method: NearEventual>>= (in category 'comparing') -----
= anObject
"Answer whether the receiver and the argument represent the same
object. If = is redefined in any subclass, consider also redefining the
message hash."

^anObject = value!

----- Method: NearEventual>>basicEquality: (in category 'comparing') -----
basicEquality: anObject
"Answer whether the receiver and the argument represent the same
object. If = is redefined in any subclass, consider also redefining the
message hash."

^value basicEquality: anObject!

----- Method: NearEventual>>becomeContext: (in category 'messaging') -----
becomeContext: context

!

----- Method: NearEventual>>hash (in category 'comparing') -----
hash

^value hash!

----- Method: NearEventual>>initializeOnTarget:vat: (in category 'initialization') -----
initializeOnTarget: anObject vat: aVat

value := anObject.
vat := aVat.
!

----- Method: NearEventual>>isFulfilled (in category 'testing') -----
isFulfilled

^ true!

----- Method: NearEventual>>isInteger (in category 'number protocol') -----
isInteger

^ value isInteger!

----- Method: NearEventual>>isPassByConstruction (in category 'serializing') -----
isPassByConstruction

^ value isPassByConstruction
!

----- Method: NearEventual>>isResolved (in category 'testing') -----
isResolved

^ true!

----- Method: NearEventual>>passByConstruction (in category 'serializing') -----
passByConstruction

self isPassByConstruction
ifTrue: [^ value]
ifFalse: [self error: 'not passByConstruction'].
!

----- Method: NearEventual>>printOn: (in category 'printing') -----
printOn: stream

stream nextPutAll: '{ '.
value printOn: stream.
stream nextPutAll: ' } >> '.
super printOn: stream.

!

----- Method: NearEventual>>redirectEventualMessage: (in category 'messaging') -----
redirectEventualMessage: anEventualMessage

anEventualMessage receiver: value.
self vat schedule: anEventualMessage.
!

----- Method: NearEventual>>rejectWith: (in category 'Promise/A+ protocol') -----
rejectWith: arg

PromiseAlreadyResolved new signal.
!

----- Method: NearEventual>>resolution (in category 'accessing') -----
resolution

^ value!

----- Method: NearEventual>>resolveWith: (in category 'Promise/A+ protocol') -----
resolveWith: arg

PromiseAlreadyResolved new signal.
!

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

^ value!

----- Method: NearEventual>>vat (in category 'accessing') -----
vat

^ vat!

----- Method: NearEventual>>wait (in category 'waiting') -----
wait

super waitTimeoutMSecs: 3.
super wait.
^ self resolution.!

----- Method: NearEventual>>waitTimeoutMSecs: (in category 'waiting') -----
waitTimeoutMSecs: msecs

super waitTimeoutMSecs: 3.
super waitTimeoutMSecs: msecs.
^ self resolution.!

----- Method: NearEventual>>waitTimeoutSeconds: (in category 'waiting') -----
waitTimeoutSeconds: secs

super waitTimeoutMSecs: 3.
super waitTimeoutSeconds: secs.
^ self resolution.!

AbstractEventual subclass: #Promise
instanceVariableNames: 'vat msgBuffer resolver'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

!Promise commentStamp: 'tonyg 1/31/2018 23:34' prior: 0!
I represent the result of an asynchronous message. Once the message is processed, I will be resolved to a value. I am typically instantiated by invocations of #futureSend:at:args: (and not by #futureDo:atArgs:).

See class-comment of FutureNode.

I also implement the Promises/A+ Javascript specification. This allows you to chain my instances to perform arbitrarily complex asynchronous tasks with error handling baked in.

A Promise may be in one of three possible states: #pending, #fulfilled or #rejected. A Promise may move from #pending -> #fulfilled (by way of the resolveWith: message), or from #pending -> #rejected (by way of rejectWith:). No other state changes may occur.

Once #fulfilled or #rejected, a Promise's value must not change. In keeping with the major Javascript Promise implementations' interpretations of this, calls to resolveWith: or rejectWith: when a Promise is in #fulfilled or #rejected state are simply ignored - an error is not signalled. (See test cases PromiseTest testFirstResolutionWins, testCannotRejectFulfilledPromise and testCannotResolveaRejectedPromise.)!

----- Method: Promise class>>ifRejected: (in category 'instance creation') -----
ifRejected: aBlock

^ self new
whenRejected: aBlock;
yourself.
!

----- Method: Promise class>>new (in category 'instance creation') -----
new

^ self newOnBuffer: (OrderedCollection new: 0) vat: self vat!

----- Method: Promise class>>newOnBuffer:vat: (in category 'instance creation') -----
newOnBuffer: buf vat: vat

^ self basicNew
initializeOnBuffer: buf vat: vat;
yourself!

----- Method: Promise class>>refDescriptionString (in category 'accessing') -----
refDescriptionString

^ 'promise'!

----- Method: Promise class>>unit: (in category 'instance creation') -----
unit: anObject

"Return a resolved Promise. #new is the other half of Promise's unit function; #new returns an unresolved Promise."
^ Promise new
resolveWith: anObject.!

----- Method: Promise>>error (in category 'accessing') -----
error

^ nil!

----- Method: Promise>>fulfillWith: (in category 'Promise/A+ protocol') -----
fulfillWith: aBlock

self fulfillWith: aBlock passErrors: (msgBuffer collect: [:e | e isRejector]) isEmpty!

----- Method: Promise>>fulfillWith:passErrors: (in category 'Promise/A+ protocol') -----
fulfillWith: aBlock passErrors: aBoolean
"Evaluate aBlock. If it signals an exception, reject this promise with the exception
as the argument; if it returns a value [or another Promise], resolve this promise
with the result.

If aBoolean is true, and an exception is signaled, it is passed out to the caller.
If aBoolean is false, signaled exceptions are considered handled after the promise
has been rejected."
[ self resolveWith: aBlock value ]
on: Exception
do: [ :ex |
(ex isKindOf: Halt)
ifTrue: [ex pass]
ifFalse: [
self rejectWith: ex.
aBoolean ifTrue: [ ex pass ] ]]!

----- Method: Promise>>ifRejected: (in category 'Promise/A+ protocol') -----
ifRejected: errBlock

^ errBlock
ifNil: [^ self whenBroken: [:e | e]]
ifNotNil: [:b | self whenBroken: errBlock].
!

----- Method: Promise>>initializeOnBuffer:vat: (in category 'initialization') -----
initializeOnBuffer: buf vat: aVat

super initialize.
msgBuffer := buf.
vat := aVat.
resolver := self resolverClass onRef: self buffer: buf.
!

----- Method: Promise>>isEventual (in category 'testing') -----
isEventual

^ true!

----- Method: Promise>>isNear (in category 'testing') -----
isNear

^ false!

----- Method: Promise>>isPromise (in category 'testing') -----
isPromise

^ true!

----- Method: Promise>>isRejected (in category 'testing') -----
isRejected

^ false!

----- Method: Promise>>printOn: (in category 'printing') -----
printOn: stream

stream
nextPutAll: 'a Promise<';
nextPutAll: self class name;
nextPutAll: '>::';
nextPutAll: self refDescriptionString;
nextPutAll: '('.
self vat printOn: stream.
stream nextPutAll: ')'.
!

----- Method: Promise>>redirectEventualMessage: (in category 'Promise/A+ protocol') -----
redirectEventualMessage: anEventualMessage

[msgBuffer addLast: anEventualMessage]
on: Exception
do: [:error | self redirectEventualMessage: anEventualMessage].
!

----- Method: Promise>>reject (in category 'Promise/A+ protocol') -----
reject

self rejectWith: nil!

----- Method: Promise>>rejectWith: (in category 'resolving') -----
rejectWith: reason

self resolver smash: reason.!

----- Method: Promise>>resolve (in category 'Promise/A+ protocol') -----
resolve

self resolveWith: nil!

----- Method: Promise>>resolveWith: (in category 'resolving') -----
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"

self resolver resolve: arg.
!

----- Method: Promise>>resolver (in category 'accessing') -----
resolver

^ resolver!

----- Method: Promise>>resolverClass (in category 'accessing') -----
resolverClass

^ self class resolverClass!

----- Method: Promise>>then: (in category 'Promise/A+ protocol') -----
then: resolvedBlock

resolvedBlock
ifNil: [^ self whenResolved: [:o | o]]
ifNotNil: [:b | ^ self whenResolved: resolvedBlock].!

----- Method: Promise>>then:ifRejected: (in category 'Promise/A+ protocol') -----
then: resolvedBlock ifRejected: errBlock
"Return a Promise that, if it resolves, runs the resolvedBlock. If resolution throws an Exception, it runs the errBlock."

| p |
p := self then: resolvedBlock.
self ifRejected: errBlock.
^ p.!

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

^ self!

----- Method: Promise>>vat (in category 'accessing') -----
vat

vat isNil
ifTrue: [vat := super vat].
^ vat!

----- Method: Promise>>vat: (in category 'accessing') -----
vat: aVat

vat := aVat!

----- Method: Promise>>whenMoreResolved: (in category 'when clause') -----
whenMoreResolved: reactor

"aBlock numArgs <= 1 ifFalse: [self error: 'Must be 0- or 1-argument block']."
self redirectMessageOneWay: (Message selector: #whenMoreResolved: argument: reactor).
!

Object subclass: #ELib
instanceVariableNames: ''
classVariableNames: 'ForkDebugger'
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: ELib class>>debugEventualException: (in category 'debugging') -----
debugEventualException: anException
"For convenience. Construct a helper process to debug an exception that occurred in the active process later on so that the active process can (try to) resume. Uses a temporary variable to access and copy the signaler context now before it gets GC'ed."

self forkDebugger ifTrue: [
| helperProcess |
helperProcess := (EventualProcess
forContext: anException signalerContext copyStack
priority: Processor activeProcess priority
onVat: Processor activeProcess vat)
shouldResumeFromDebugger: true;
yourself.

Project current addDeferredUIMessage: [
helperProcess
debugWithTitle: anException description
full: false] ].
!

----- Method: ELib class>>forkDebugger (in category 'preferences') -----
forkDebugger

<preference: 'Fork Debugger on Exception'
categoryList: #(promises)
description: 'If enabled, any exception thrown inside the event loop will have its stack copied and a debugger will open outside of the event loop'
type: #Boolean>
^ ForkDebugger ifNil: [false]!

----- Method: ELib class>>forkDebugger: (in category 'preferences') -----
forkDebugger: bool

ForkDebugger := bool.
!

----- Method: Object>>basicEquality: (in category '*promiseslocal') -----
basicEquality: anObject
"Answer whether the receiver and the argument represent the same
object. If = is redefined in any subclass, consider also redefining the
message hash."

^self == anObject!

----- Method: Object>>basicEquivalence: (in category '*promiseslocal') -----
basicEquivalence: anObject
"Primitive. Answer whether the receiver and the argument are the same
object (have the same object pointer). Do not redefine the message == in
any other class!! Essential. No Lookup. Do not override in any subclass.
See Object documentation whatIsAPrimitive."

<primitive: 110> "primitiveEquivalent"
self primitiveFailed!

----- Method: Object>>eventual (in category '*promiseslocal') -----
eventual

^ NearEventual newOn: self
!

----- Method: Object>>eventualInVat: (in category '*promiseslocal') -----
eventualInVat: aVat

^ NearEventual newOn: self vat: aVat
!

----- Method: Object>>whenBroken: (in category '*promiseslocal') -----
whenBroken: reactor

| pair |
pair := AbstractEventual promiseInVat: self vat.
self whenMoreResolved: (WhenBrokenReactor
onClosure: reactor
ref: self
resolver: pair value).
^ pair key
!

----- Method: Object>>whenBrokenOnly: (in category '*promiseslocal') -----
whenBrokenOnly: reactor

self whenMoreResolved: (WhenBrokenReactor
onClosure: reactor
ref: self
resolver: nil).
^ nil
!

----- Method: Object>>whenMoreResolved: (in category '*promiseslocal') -----
whenMoreResolved: reactor

(reactor isEventual and: [reactor isRemote])
ifTrue: [
reactor redirectMessageOneWay: (Message
selector: #value:
argument: self value)]
ifFalse: [reactor value: self value]
!

----- Method: Object>>whenRejected: (in category '*promiseslocal') -----
whenRejected: aBlock

^ self whenBroken: aBlock
!

----- Method: Object>>whenResolved: (in category '*promiseslocal') -----
whenResolved: reactor

| pair |
pair := AbstractEventual promiseInVat: self vat.
self whenMoreResolved: (WhenResolvedReactor
onClosure: reactor
ref: self
resolver: pair value).
^ pair key
!

----- Method: Object>>whenResolvedOnly: (in category '*promiseslocal') -----
whenResolvedOnly: reactor

self whenMoreResolved: (WhenResolvedReactor
onClosure: reactor
ref: self
resolver: nil).
^ nil!

Object subclass: #PriorityVat
instanceVariableNames: 'vatNick currentState normalQ immediateQ flashQ flashOverrideQ eventualProcess accessProtect readSynch'
classVariableNames: 'LocalVat'
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: PriorityVat class>>clearLocalVat (in category 'accessing') -----
clearLocalVat
"PriorityVat clearLocalVat"

^ LocalVat ifNotNil: [LocalVat stop. LocalVat := nil]
!

----- Method: PriorityVat class>>localVat (in category 'accessing') -----
localVat
"PriorityVat localVat"

^ LocalVat ifNil: [LocalVat := self newWithNick: 'local']
!

----- Method: PriorityVat class>>newWithNick: (in category 'instance creation') -----
newWithNick: nick

^ self new
vatNick: nick;
yourself!

----- Method: PriorityVat class>>stateMap (in category 'class initialization') -----
stateMap
"(((PriorityVat stateMap compile)))"

| desc |
desc := ProtocolStateCompiler initialState: #running.
(desc newState: #running -> (nil -> #stopped))
add: #stopping -> (nil -> #stopping).
(desc newState: #stopping -> (nil -> #stopped))
add: #stopping -> (nil -> #stopping);
addInteger: #stopped -> (nil -> #stopped).
(desc newState: #stopped -> (nil -> #stopped)).
^desc.
!

----- Method: PriorityVat>>initialize (in category 'private') -----
initialize

self vatNick: '<new>'.
self start.
currentState := self class stateMap compile.!

----- Method: PriorityVat>>isRunning (in category 'action') -----
isRunning

^ currentState
ifNil: [false]
ifNotNil: [:state | state isStateNamed: #running].!

----- Method: PriorityVat>>nextPriorityMsg (in category 'private') -----
nextPriorityMsg

readSynch wait.
accessProtect
critical: [
flashOverrideQ isEmpty ifFalse: [ ^ flashOverrideQ next ].
flashQ isEmpty ifFalse: [ ^ flashQ next ].
immediateQ isEmpty ifFalse: [ ^ immediateQ next ].
normalQ isEmpty ifFalse: [ ^ normalQ next ].
^ nil].!

----- Method: PriorityVat>>postCopy (in category 'private') -----
postCopy

super postCopy.
self initialize.!

----- Method: PriorityVat>>printOn: (in category 'private') -----
printOn: stream

stream nextPutAll: 'vat#'.
stream nextPutAll: self vatNick.
!

----- Method: PriorityVat>>processSends (in category 'private') -----
processSends

[[
Processor yield.
self nextPriorityMsg ifNotNil: [:msg | msg value].
self isRunning ] whileTrue]
ifCurtailed: [self isRunning ifTrue: [self restartEventLoop]].

!

----- Method: PriorityVat>>restartEventLoop (in category 'action') -----
restartEventLoop

| currentEventLoop |
eventualProcess ifNotNil: [:ea | currentEventLoop := ea].
eventualProcess := nil.
eventualProcess := EventualProcess newOnVat: self.
eventualProcess resumeAsProcess.
currentEventLoop ifNotNil: [:ea | ea terminate ].!

----- Method: PriorityVat>>schedule: (in category 'action') -----
schedule: msg

self schedule: msg priority: #Normal.
!

----- Method: PriorityVat>>schedule:priority: (in category 'action') -----
schedule: msg priority: priority

self isRunning ifFalse: [^ self].
accessProtect critical: [
(priority == 3 or: [priority == #FlashOverride]) ifTrue: [flashOverrideQ nextPut: msg].
(priority == 2 or: [priority == #Flash]) ifTrue: [flashQ nextPut: msg].
(priority == 1 or: [priority == #Immediate]) ifTrue: [immediateQ nextPut: msg].
(priority == 0 or: [priority == #Normal]) ifTrue: [normalQ nextPut: msg]].
readSynch signal.
!

----- Method: PriorityVat>>start (in category 'action') -----
start

self isRunning ifTrue: [^ self].
normalQ := SharedQueue new.
immediateQ := SharedQueue new.
flashQ := SharedQueue new.
flashOverrideQ := SharedQueue new.
accessProtect := Semaphore forMutualExclusion.
readSynch := Semaphore new.
eventualProcess := EventualProcess newOnVat: self.
eventualProcess resumeAsProcess.
!

----- Method: PriorityVat>>stop (in category 'action') -----
stop

self transitionEvent: #stopping.
self schedule: [#cycle].
(Delay forMilliseconds: 1) wait.
eventualProcess ifNotNil: [:p | eventualProcess terminate].
eventualProcess := nil.
normalQ := nil.
immediateQ := nil.
flashQ := nil.
flashOverrideQ := nil.
accessProtect := nil.
readSynch := nil.
!

----- Method: PriorityVat>>stopped (in category 'action') -----
stopped

self transitionEvent: #stopped.
!

----- Method: PriorityVat>>transitionEvent: (in category 'events') -----
transitionEvent: event

| newState |
newState := currentState transitionEvent: event value: event client: self.
(newState ~= currentState)
ifTrue: [ currentState := newState. ^ true]
ifFalse: [^ false]!

----- Method: PriorityVat>>vatNick (in category 'accessing') -----
vatNick

^ vatNick!

----- Method: PriorityVat>>vatNick: (in category 'accessing') -----
vatNick: nick

vatNick := nick.
!

Object subclass: #PromiseWaiter
instanceVariableNames: 'promise value state'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: PromiseWaiter class>>newOnPromise: (in category 'as yet unclassified') -----
newOnPromise: promise
"Wait unconditionally for this promise to become fulfilled or rejected."

^ self new
initializeOnPromise: promise;
yourself.
!

----- Method: PromiseWaiter class>>waitOnPromise: (in category 'as yet unclassified') -----
waitOnPromise: promise
"Wait unconditionally for this promise to become fulfilled or rejected."

| waiter |
waiter := PromiseWaiter newOnPromise: promise.
^ waiter wait.
!

----- Method: PromiseWaiter class>>waitTimeoutMSecs:onPromise: (in category 'as yet unclassified') -----
waitTimeoutMSecs: msecs onPromise: promise

| waiter |
waiter := PromiseWaiter newOnPromise: promise.
^ waiter waitTimeoutMSecs: msecs.
!

----- Method: PromiseWaiter class>>waitTimeoutSeconds:onPromise: (in category 'as yet unclassified') -----
waitTimeoutSeconds: secs onPromise: promise

^ self waitTimeoutMSecs: (secs * 1000) onPromise: promise!

----- Method: PromiseWaiter>>initializeOnPromise: (in category 'initialize-release') -----
initializeOnPromise: prom

state := #pending.
promise := prom.
promise whenResolved: [:v | self result: v].
promise whenRejected: [:v | self result: v].
(promise isResolved or: [promise isRejected])
ifTrue: [self result: promise].
!

----- Method: PromiseWaiter>>result: (in category 'accessing') -----
result: anObject
"Set the value of result"

(state == #fulfilled) ifTrue: [^self].
state := #fulfilled.
!

----- Method: PromiseWaiter>>wait (in category 'control') -----
wait
"Wait unconditionally for this promise to become fulfilled or rejected."

| sema |
(state == #fulfilled) ifTrue: [
promise removeActionsWithReceiver: self.
^ promise value].
sema := Semaphore new.
promise whenResolved: [sema signal].
[[sema wait] on: TestFailure do: [:e | ]] ensure: [promise removeActionsWithReceiver: self].
^ promise value.
!

----- Method: PromiseWaiter>>waitTimeoutMSecs: (in category 'control') -----
waitTimeoutMSecs: timeout

| sema delay |
(state == #fulfilled) ifTrue: [
promise removeActionsWithReceiver: self.
^ promise resolution].
sema := Semaphore new.
promise whenResolved: [sema signal].
delay := Delay timeoutSemaphore: sema afterMSecs: timeout.
[sema wait] ensure: [
delay unschedule.
promise removeActionsWithReceiver: self].
^ promise resolution.
!

----- Method: PromiseWaiter>>waitTimeoutSeconds: (in category 'control') -----
waitTimeoutSeconds: seconds

^self waitTimeoutMSecs: seconds * 1000
!

Object subclass: #Reactor
instanceVariableNames: 'ref resolver closure'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: Reactor class>>onClosure:ref:resolver: (in category 'instance creation') -----
onClosure: closure ref: ref resolver: resolver

^ self new
initOnClosure: closure ref: ref resolver: resolver;
yourself.
!

----- Method: Reactor>>initOnClosure:ref:resolver: (in category 'initialize-release') -----
initOnClosure: aClosure ref: aRef resolver: aResolver

closure := aClosure.
ref := aRef.
resolver := aResolver.
!

----- Method: Reactor>>isRejector (in category 'testing') -----
isRejector

^ false!

----- Method: Reactor>>isResolver (in category 'testing') -----
isResolver

^ false!

----- Method: Reactor>>reactToLostClient: (in category 'reacting') -----
reactToLostClient: anException

self value: anException.
^ nil!

----- Method: Reactor>>value: (in category 'reacting') -----
value: ignored

closure isNil ifTrue:[^ nil].
^ closure cull: ref value.
!

Reactor subclass: #WhenBrokenReactor
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: WhenBrokenReactor class>>isPassByConstruction (in category 'serialization') -----
isPassByConstruction

^ true!

----- Method: WhenBrokenReactor>>isRejector (in category 'testing') -----
isRejector

^ true!

----- Method: WhenBrokenReactor>>value: (in category 'as yet unclassified') -----
value: ignored

| aRef aResolver aClosure result |
closure isNil ifTrue:[^ nil].
(ref isBroken)
ifTrue: [
aRef := ref.
aResolver := resolver.
aClosure := closure.
ref := nil.
resolver := nil.
closure := nil.
[result := aClosure cull: aRef value]
on: Error
do: [:ex | result := ex].
aResolver notNil ifTrue: [
aResolver resolve: result].
^ nil].
(ref isNear)
ifTrue: [
ref := nil.
resolver := nil.
closure := nil.
^ nil].
(ref isResolved)
ifTrue: [^ nil]
ifFalse: [ref whenMoreResolved: self.
^ nil].
!

Reactor subclass: #WhenResolvedReactor
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: WhenResolvedReactor class>>isPassByConstruction (in category 'serialization') -----
isPassByConstruction

^ true!

----- Method: WhenResolvedReactor>>isResolver (in category 'testing') -----
isResolver

^ true!

----- Method: WhenResolvedReactor>>value: (in category 'as yet unclassified') -----
value: ignored

| aRef aResolver aClosure result |
closure isNil ifTrue:[^ nil].
(ref isResolved)
ifTrue: [
aRef := ref.
aResolver := resolver.
aClosure := closure.
ref := nil.
resolver := nil.
closure := nil.
[result := aClosure cull: aRef value]
on: Error
do: [:ex | result := ex].
aResolver isNil
ifFalse: [aResolver resolve: result].
^ nil]
ifFalse: [
ref whenMoreResolved: self.
^ nil].
!

Object subclass: #Resolver
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

Resolver subclass: #LocalResolver
instanceVariableNames: 'ref buf'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: LocalResolver class>>onRef:buffer: (in category 'instance creation') -----
onRef: ref buffer: buf

^ self new
initializeOnRef: ref buffer: buf;
yourself
!

----- Method: LocalResolver>>initializeOnRef:buffer: (in category 'initialize-release') -----
initializeOnRef: aRef buffer: aBuf

ref := aRef.
buf := aBuf.
!

----- Method: LocalResolver>>isDone (in category 'resolving') -----
isDone

^ ref isNil
!

----- Method: LocalResolver>>resolve: (in category 'resolving') -----
resolve: resolutionValue

| tmp1 |
self isDone ifTrue: [ ^ PromiseAlreadyResolved new signal ].
tmp1 := AbstractEventual toReferenceContext: resolutionValue.
ref becomeContext: tmp1.
self sendMsgsToNewRef: ref.
ref := nil.
^ nil
!

----- Method: LocalResolver>>sendMsgsToNewRef: (in category 'resolving') -----
sendMsgsToNewRef: newRef

| pendingMessages msg |
buf isNil ifTrue: [^nil].
pendingMessages := buf readStream.
buf := nil.
[pendingMessages atEnd]
whileFalse: [
msg := pendingMessages next.
newRef redirectEventualMessage: msg].
!

----- Method: LocalResolver>>smash: (in category 'resolving') -----
smash: exception

self isDone ifTrue: [ ^ PromiseAlreadyResolved new signal ].
^ (AbstractEventual isReference: exception)
ifTrue: [self resolve: exception]
ifFalse: [
(exception class includesBehavior: Exception)
ifTrue: [self resolve: exception]
ifFalse: [self resolve: (BrokenEventual new
exception: (BrokenPromiseValue value: exception);
yourself)]].
!

----- Method: Resolver>>isDone (in category 'resolving') -----
isDone

self subclassResponsibility !

----- Method: Resolver>>resolve: (in category 'resolving') -----
resolve: value

self subclassResponsibility !

----- Method: Resolver>>smash: (in category 'resolving') -----
smash: exception

self subclassResponsibility !

----- Method: Resolver>>smashString: (in category 'resolving') -----
smashString: exceptionTxt

^ self smash: (Error new messageText: exceptionTxt)!

ServiceProvider subclass: #PromisesLocalServiceProvider
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: PromisesLocalServiceProvider class>>initialize (in category 'initialization') -----
initialize
ServiceRegistry current buildProvider: self new!

MessageSend subclass: #EventualMessageSend
instanceVariableNames: 'resolver'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: EventualMessageSend class>>message: (in category 'instance creation') -----
message: aMessage

^ self new
selector: aMessage selector;
arguments: aMessage arguments;
resolver: nil;
yourself!

----- Method: EventualMessageSend class>>message:resolver: (in category 'instance creation') -----
message: aMessage resolver: aResolver

^ self new
selector: aMessage selector;
arguments: aMessage arguments;
resolver: aResolver;
yourself!

----- Method: EventualMessageSend class>>receiver:resolver:selector: (in category 'instance creation') -----
receiver: anObject resolver: aResolver selector: aSymbol
^ (super receiver: anObject selector: aSymbol)
resolver: aResolver;
yourself!

----- Method: EventualMessageSend class>>receiver:resolver:selector:arguments: (in category 'instance creation') -----
receiver: anObject resolver: aResolver selector: aSymbol arguments: anArray
^ (super receiver: anObject selector: aSymbol arguments: anArray)
resolver: aResolver;
yourself!

----- Method: EventualMessageSend class>>selector: (in category 'as yet unclassified') -----
selector: aSymbol
^ (super receiver: nil selector: aSymbol)
resolver: nil;
yourself!

----- Method: EventualMessageSend class>>selector:arguments: (in category 'as yet unclassified') -----
selector: aSymbol arguments: anArray
^ (super receiver: nil selector: aSymbol arguments: anArray)
resolver: nil;
yourself!

----- Method: EventualMessageSend class>>selector:arguments:resolver: (in category 'as yet unclassified') -----
selector: aSymbol arguments: anArray resolver: aResolver
^ (super receiver: nil selector: aSymbol arguments: anArray)
resolver: aResolver;
yourself!

----- Method: EventualMessageSend class>>selector:resolver: (in category 'as yet unclassified') -----
selector: aSymbol resolver: aResolver
^ (super receiver: nil selector: aSymbol)
resolver: aResolver;
yourself!

----- Method: EventualMessageSend>>isOneWay (in category 'testing') -----
isOneWay

^ self resolver isNil!

----- Method: EventualMessageSend>>isRejector (in category 'testing') -----
isRejector

^ (self selector == #whenMoreResolved:)
and: [self arguments first isRejector]!

----- Method: EventualMessageSend>>printOn: (in category 'private') -----
printOn: t1
| t2 |
t1 nextPutAll: 'EventualSend ('.
receiver printOn: t1.
t1 nextPutAll: ' '.
(selector isUnary
or: [selector isInfix])
ifTrue: [selector printOn: t1.
t1 nextPutAll: ' '.
self arguments
do: [:t3 | t1 print: t3]
separatedBy: [t1 nextPutAll: ' ']]
ifFalse: [t2 := (self selector subStrings: ':')
collect: [:t3 | t3 asSymbol asSimpleSetter asString].
t2
with: self arguments
do: [:t3 :t4 |
t1 nextPutAll: ' ';
nextPutAll: t3;
nextPutAll: ' '.
t4 printOn: t1]].
t1 nextPutAll: ') -> ['.
resolver printOn: t1.
t1 nextPutAll: ']'!

----- Method: EventualMessageSend>>resolve: (in category 'api') -----
resolve: ref

self resolver ifNotNil: [self resolver resolve: ref].!

----- Method: EventualMessageSend>>resolver (in category 'accessing') -----
resolver

^ resolver!

----- Method: EventualMessageSend>>resolver: (in category 'accessing') -----
resolver: aResolver

resolver := aResolver!

----- Method: EventualMessageSend>>smash: (in category 'api') -----
smash: exception

self resolver ifNotNil: [self resolver smash: exception].!

----- Method: EventualMessageSend>>value (in category 'api') -----
value

| value |
[
value := receiver
perform: selector
withArguments: (self collectArguments: arguments)
inSuperclass: receiver class.
self resolver notNil ifTrue: [ self resolver resolve: value ]
]
on: Exception
do: [:ex |
self resolver ifNotNil: [:r | r smash: ex].
(ex isKindOf: Halt)
ifTrue: [ex pass]
ifFalse: [ELib debugEventualException: ex]].

!

Process subclass: #EventualProcess
instanceVariableNames: 'eventualName vat'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

----- Method: EventualProcess class>>forContext:priority:onVat: (in category 'instance creation') -----
forContext: aContext priority: anInteger onVat: aVat
"Answer an instance of me that has suspended aContext at priority
anInteger."

| newProcess |
newProcess := self newOnVat: aVat.
newProcess suspendedContext: aContext.
newProcess priority: anInteger.
^newProcess!

----- Method: EventualProcess class>>newOnVat: (in category 'instance creation') -----
newOnVat: vat
^ super new
priority: Processor userBackgroundPriority;
eventualName: 'vat thread';
vat: vat;
setupContext;
yourself!

----- Method: EventualProcess>>eventualName (in category 'accessing') -----
eventualName

^ eventualName!

----- Method: EventualProcess>>eventualName: (in category 'accessing') -----
eventualName: aName

eventualName := aName.
!

----- Method: EventualProcess>>printOn: (in category 'accessing') -----
printOn: aStream

aStream nextPutAll: '{squeake'.
self eventualName notNil
ifTrue: [
aStream nextPutAll: '-'.
aStream nextPutAll: self eventualName asString].
aStream nextPutAll: '} '.
super printOn: aStream.
!

----- Method: EventualProcess>>resume (in category 'changing process state') -----
resume

(Processor activeProcess == self)
ifTrue: [self resumeAsProcess]
ifFalse: [self resumeInVat].
!

----- Method: EventualProcess>>resumeAsProcess (in category 'changing process state') -----
resumeAsProcess

super resume.!

----- Method: EventualProcess>>resumeInVat (in category 'changing process state') -----
resumeInVat

self vat schedule: self suspendedContext.!

----- Method: EventualProcess>>setupContext (in category 'initialize-release') -----
setupContext

self suspendedContext: [
self vat processSends.
Processor terminateActive] asContext.!

----- Method: EventualProcess>>vat (in category 'accessing') -----
vat

^ vat!

----- Method: EventualProcess>>vat: (in category 'accessing') -----
vat: aVat

vat := aVat!

----- Method: Process>>vat (in category '*promiseslocal') -----
vat

^ PriorityVat localVat.!

----- Method: BlockClosure>>eventual (in category '*promiseslocal') -----
eventual

| pair eMsg |
pair := AbstractEventual promiseInVat: self vat.
eMsg := EventualMessageSend receiver: self resolver: pair value selector: #value.
self vat schedule: eMsg.
^ pair key

!

----- Method: ProtoObject>>basicEquivalence: (in category '*promiseslocal') -----
basicEquivalence: anObject
"Primitive. Answer whether the receiver and the argument are the same
object (have the same object pointer). Do not redefine the message == in
any other class!! Essential. No Lookup. Do not override in any subclass.
See Object documentation whatIsAPrimitive."

<primitive: 110>
self primitiveFailed!

----- Method: ProtoObject>>defaultLabelForInspector (in category '*promiseslocal') -----
defaultLabelForInspector
"Answer the default label to be used for an Inspector window on the receiver."

^ self class name!

----- Method: ProtoObject>>inspect (in category '*promiseslocal') -----
inspect
"Create and schedule an Inspector in which the user can examine the receiver's variables."

Inspector openOn: self withEvalPane: true!

----- Method: ProtoObject>>isBroken (in category '*promiseslocal') -----
isBroken

^ false!

----- Method: ProtoObject>>isEventual (in category '*promiseslocal') -----
isEventual

^ false
!

----- Method: ProtoObject>>isFulfilled (in category '*promiseslocal') -----
isFulfilled

^ self isNear
!

----- Method: ProtoObject>>isNear (in category '*promiseslocal') -----
isNear

^ true!

----- Method: ProtoObject>>isPromise (in category '*promiseslocal') -----
isPromise

^ false
!

----- Method: ProtoObject>>isProxy (in category '*promiseslocal') -----
isProxy

^ false
!

----- Method: ProtoObject>>isResolved (in category '*promiseslocal') -----
isResolved

^ self isPromise not
!

----- Method: ProtoObject>>redirectEventualMessage: (in category '*promiseslocal') -----
redirectEventualMessage: anEventualMessage

anEventualMessage receiver: self.
self vat schedule: anEventualMessage.
!

----- Method: ProtoObject>>resolution (in category '*promiseslocal') -----
resolution

^ self!

----- Method: ProtoObject>>vat (in category '*promiseslocal') -----
vat

^ Processor activeProcess vat
!

TestCase subclass: #PriorityVatTest
instanceVariableNames: 'eventReceived'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal-Testing'!

----- Method: PriorityVatTest>>tearDown (in category 'initialize-release') -----
tearDown

(PriorityVat clearLocalVat; localVat) restartEventLoop.
!

----- Method: PriorityVatTest>>testPriorityVat (in category 'testing') -----
testPriorityVat

| vat |
vat := PriorityVat newWithNick: 'testVat'.
eventReceived := false.
vat schedule: [eventReceived := true].
(Delay forMilliseconds: 1) wait.
self assert: eventReceived.
vat stop.!

TestCase subclass: #RefsTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal-Testing'!

----- Method: RefsTest>>tearDown (in category 'initialize-release') -----
tearDown

(PriorityVat clearLocalVat; localVat) restartEventLoop.
!

----- Method: RefsTest>>testArithmeticPrimitivesWithPromiseReceiver (in category 'testing') -----
testArithmeticPrimitivesWithPromiseReceiver
| t1 t2 |
t1 := 42 eventual.
t2 := 10.
t1 * t2
whenResolved: [:t3 |
self assert: t3 resolution == 420]!

----- Method: RefsTest>>testBasicPromiseResolution (in category 'testing') -----
testBasicPromiseResolution

| pair |
pair := AbstractEventual promise.
self assert: pair key isEventual.
pair value resolve: 'rob'.
self assert: pair key isNear.
self assert: pair key = 'rob'.
!

----- Method: RefsTest>>testBasicPromiseSmashing (in category 'testing') -----
testBasicPromiseSmashing
| pair |
pair := AbstractEventual promise.
self assert: pair key isEventual.
pair value smashString: 'test promise smashing'.
self assert: pair key isBroken.
self
should: [pair key immediate]
raise: Error!

----- Method: RefsTest>>testBasicPromiseToBooleanResolution (in category 'testing') -----
testBasicPromiseToBooleanResolution
| tmp1 |
tmp1 := AbstractEventual promise.
self assert: tmp1 key isEventual.
tmp1 value resolve: true.
self
assert: tmp1 key isNear;
assert: tmp1 key = true!

----- Method: RefsTest>>testBlockClosure (in category 'testing') -----
testBlockClosure

| result |
[42 * 10] eventual whenResolved: [:r | result := r resolution].
(Delay forMilliseconds: 100) wait.
self assert: result = 420.!

----- Method: RefsTest>>testFailureArithmeticPrimitivesWithPromiseArgument (in category 'testing') -----
testFailureArithmeticPrimitivesWithPromiseArgument

| num1 num2 |
num1 := 10.
num2 := 42 eventual.
[num1 * num2
whenResolved: [:result | self assert: result == 420].
self assert: false]
on: Exception do: [:ex | ^ self assert: true].
self assert: false!

----- Method: RefsTest>>testLocalResolve (in category 'testing') -----
testLocalResolve

| pair |
pair := AbstractEventual promise.
pair value resolve: 'rob'.
self assert: (pair key = 'rob').
self should: [pair value smashString: 'test smash'] raise: Error.
!

----- Method: RefsTest>>testLocalSmash (in category 'testing') -----
testLocalSmash
| pair |
pair := AbstractEventual promise.
pair value smashString: 'smash promise test'.
self
should: [pair key foobar]
raise: Error.
self
should: [pair value smashString: 'smash promise test']
raise: Error!

----- Method: RefsTest>>testNearRefs (in category 'testing') -----
testNearRefs
| obj |
obj := Object new.
self assert: (obj eventual = obj eventual).
!

----- Method: RefsTest>>testUsedLocalResolver (in category 'testing') -----
testUsedLocalResolver

| resolver |
resolver := LocalResolver onRef: nil buffer: nil.
self assert: resolver isDone.
self should: [resolver resolve: 2] raise: Error.
self should: [resolver smashString: 'test smash'] raise: Error.
!

----- Method: RefsTest>>testWhenBroken (in category 'testing') -----
testWhenBroken

| result oldForkDebugger |
oldForkDebugger := ELib forkDebugger.
ELib forkDebugger: false.
42 eventual / 0
whenBroken: [:t3 |
result := t3 resolution.
self assert: result isError].
(Delay forMilliseconds: 100) wait.
self assert: (result class == ZeroDivide).
ELib forkDebugger: oldForkDebugger.
!

----- Method: RefsTest>>testWhenResolved (in category 'testing') -----
testWhenResolved

| result t1 t2 |
t1 := 42 eventual.
t2 := 10.
t1 * t2
whenResolved: [:t3 |
result := t3 resolution.
self assert: result == 420].
(Delay forMilliseconds: 100) wait.
self assert: result == 420.!

Error subclass: #BrokenPromise
instanceVariableNames: 'exception'
classVariableNames: ''
poolDictionaries: ''
category: 'PromisesLocal'!

!BrokenPromise commentStamp: 'tonyg 2/17/2017 13:53' prior: 0!
I am signalled when, during a Promise>>wait, the promise is rejected.
promise: the promise itself.
!

----- Method: BrokenPromise>>defaultAction (in category 'as yet unclassified') -----
defaultAction
self messageText: 'Promise was rejected'.
^super defaultAction!

----- Method: BrokenPromise>>exception (in category 'as yet unclassified') -----
exception
^ exception!

----- Method: BrokenPromise>>exception: (in category 'as yet unclassified') -----
exception: aX
exception := aX!

----- Method: BrokenPromise>>isResumable (in category 'as yet unclassified') -----
isResumable
^ true!

----- Method: BrokenPromise>>promise (in category 'as yet unclassified') -----
promise
^ self exception!

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

----- 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: 'PromisesLocal'!