The Inbox: PromisesTests-rww.10.mcz

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

Hello Tony, all,

I made some changes to the trunk Promise and the PromiseTest. Mainly, to
the tests I added short waits and delays. This allows the PromisesLocal
to be tested by the Promises/A* tests that you have written, Tony. I
changed the Promise as well, in some small ways.

Due to the chart and description, here on ERights.org [1], a resolved
promise can either a fulfilled promise to a value or a broken promise
for rejection. I added isFulfilled and changed isResolved.

I also changed the return value of the #waitTimeoutMSecs: to match #wait
and return the value or signal the exception.

There is a difference between trunk Promise and PromisesLocal when a
resolveReactor is chained onto a promise that with be rejected. In
PromisesLocal, the ResolvedReactor is run with a resolved
rejection/broken. In trunk Promise the #then: block is NOT run, but the
error propagates. I separated the tests into these two scenarios.

It is possible to load PromisesLocal on top of this update and pass green.

Kindly,
rabbit

[1] ERight's Reference Mechanics -
http://erights.org/elib/concurrency/refmech.html

On 10/4/20 12:18 PM, [hidden email] wrote: