[Pkg] The Trunk: KernelTests-fbs.252.mcz

[commits at source.squeak.org]

Frank Shearar uploaded a new version of KernelTests to project The Trunk:
http://source.squeak.org/trunk/KernelTests-fbs.252.mcz

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

Name: KernelTests-fbs.252
Author: fbs
Time: 30 May 2013, 11:08:47.493 pm
UUID: 8b9b74b0-07df-4001-a33a-046e1f0e348e
Ancestors: KernelTests-fbs.251

Turn Promise into a fully chainable object with decent error handling.

(This implements the Smalltalk equivalent of JavaScript's Promises/A+ specification.)

=============== Diff against KernelTests-fbs.251 ===============

Item was added:
+ Object subclass: #NullMutex
+ 	instanceVariableNames: 'semaphore owner'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'KernelTests-Processes'!
+ 
+ !NullMutex commentStamp: 'fbs 5/17/2013 20:30' prior: 0!
+ A Mutex is a light-weight MUTual EXclusion object being used when two or more processes need to access a shared resource concurrently. A Mutex grants ownership to a single process and will suspend any other process trying to aquire the mutex while in use. Waiting processes are granted access to the mutex in the order the access was requested.
+ 
+ This Mutex DOES NOT mutually exclude anything. It just implements the same protocol.!

Item was added:
+ ----- Method: NullMutex>>critical: (in category 'mutual exclusion') -----
+ critical: aBlock
+ 	^ aBlock value.!

Item was added:
+ ----- Method: Promise>>unsynchronized (in category '*KernelTests-Processes') -----
+ unsynchronized
+ 	"This is useful for tests, because it's quite easy otherwise to deadlock your image. It is a DISASTER to use this in production code!!"
+ 	mutex := NullMutex new.!

Item was added:
+ ----- Method: PromiseTest>>testAnErrorInThenRejectsPromise (in category 'testing - monad') -----
+ testAnErrorInThenRejectsPromise
+ 	| p q |
+ 	p := Promise new.
+ 	q := p then: [:v | KeyNotFound signal].
+ 	p resolveWith: 1.
+ 	self deny: p isRejected description: 'Original Promise rejected'.
+ 	self assert: q isRejected description: 'Broken Promise not rejected'.!

Item was added:
+ ----- Method: PromiseTest>>testCanRejectPromise (in category 'testing - monad') -----
+ testCanRejectPromise
+ 	| p |
+ 	p := Promise new.
+ 	p rejectWith: Error new.!

Item was added:
+ ----- Method: PromiseTest>>testCannotRejectFulfilledPromise (in category 'testing - monad') -----
+ testCannotRejectFulfilledPromise
+ 	| p |
+ 	p := Promise unit: 1.
+ 	self should: [p rejectWith: Error new] raise: Error.!

Item was added:
+ ----- Method: PromiseTest>>testCannotResolveaRejectedPromise (in category 'testing - monad') -----
+ testCannotResolveaRejectedPromise
+ 	| p |
+ 	p := Promise new.
+ 	p rejectWith: Error new.
+ 	self should: [p resolveWith: 1] raise: Error.!

Item was added:
+ ----- Method: PromiseTest>>testRejectWithInvokesErrorHandlers (in category 'testing - monad') -----
+ testRejectWithInvokesErrorHandlers
+ 	| p error returnedError |
+ 	returnedError := nil.
+ 	error := KeyNotFound new.
+ 	p := Promise ifRejected: [:e | returnedError := e].
+ 	p rejectWith: error.
+ 	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'.!

Item was changed:
  ----- Method: PromiseTest>>testSingleResolver (in category 'testing') -----
  testSingleResolver
  	| promise sum |
  	sum := 0.
  	promise := Promise new.
  	promise whenResolved: [:val | sum := sum + val].
  	promise resolveWith: 5.
+ 	self assert: 5 equals: sum.
- 	self should: [sum = 5].
  	!

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

Item was added:
+ ----- Method: PromiseTest>>testThenReturnsaPromise (in category 'testing - monad') -----
+ testThenReturnsaPromise
+ 	| p |
+ 	p := Promise new then: [:v | v * 2].
+ 	self assert: Promise equals: p class.!

Item was added:
+ ----- Method: PromiseTest>>testUnitReturnsaPromise (in category 'testing - monad') -----
+ testUnitReturnsaPromise
+ 	| p |
+ 	p := Promise unit: 1.
+ 	self assert: Promise equals: p class.
+ 	self assert: p isResolved.!

Item was added:
+ ----- Method: PromiseTest>>testifRejectedDoesNotRunBlockIfPromiseResolves (in category 'testing - monad') -----
+ testifRejectedDoesNotRunBlockIfPromiseResolves
+ 	| p q error |
+ 	error := nil.
+ 	p := Promise new.
+ 	q := p ifRejected: [:e | error := e].
+ 	p resolveWith: 1.
+ 	self deny: q isRejected.
+ 	self assert: nil equals: error.!

Item was added:
+ ----- Method: PromiseTest>>testifRejectedRunsBlockIfPromiseFails (in category 'testing - monad') -----
+ testifRejectedRunsBlockIfPromiseFails
+ 	| p q error |
+ 	error := nil.
+ 	p := Promise new.
+ 	q := p ifRejected: [:e | error := e].
+ 	p rejectWith: KeyNotFound new.
+ 	self assert: q isRejected.
+ 	self assert: KeyNotFound equals: error class.!